Problems generating route between two coordinates in a shiny app
I will present 3 codes, the first two working properly, and the third is a junction of the first with the second, which is what I want to adjust. I'll explain in detail so it's easier to understand.
The first code involves generating maps using the leaflet package. Notice that in the first map I can see all the properties and their respective cluster together. I inserted a figure to you see below. Note also that for each cluster, there is an image of a house, which in this case is the location of a probable house that will be built for the corresponding cluster.
In the second map, I can filter a certain cluster and choose one of the properties of that cluster to see on the map. So I can see the property and also the house image of the corresponding cluster on the map. This code is working fine as you can see.
Code 1
library(shiny)
library(rdist)
library(dplyr)
library(geosphere)
library(shinythemes)
library(leaflet)
function.cl<-function(df,k,Filter1,Filter2){
#database df
df<-structure(list(Properties = c(1,2,3,4,5,6,7),
Latitude = c(-23.8, -23.8, -23.9, -23.9, -23.9,-23.4,-23.5),
Longitude = c(-49.6, -49.3, -49.4, -49.8, -49.6,-49.4,-49.2),
Waste = c(526, 350, 526, 469, 285, 433, 456)), class = "data.frame", row.names = c(NA, -7L))
#clusters
coordinates<-df[c("Latitude","Longitude")]
d<-as.dist(distm(coordinates[,2:1]))
fit.average<-hclust(d,method="average")
clusters<-cutree(fit.average, k)
nclusters<-matrix(table(clusters))
df$cluster <- clusters
#database df1
df1<-matrix(nrow=k,ncol=2)
for(i in 1:k){
df1[i,]<-c(weighted.mean(subset(df,cluster==i)$Latitude),
weighted.mean(subset(df,cluster==i)$Longitude))}
df1<-cbind(df1,matrix(c(1:k),ncol=1)) %>%
data.frame()
colnames(df1)<-c("Latitude","Longitude","cluster")
#specific cluster and specific propertie
df_spec_clust <- df1[df1$cluster == Filter1,]
df_spec_prop<-df[df$Properties==Filter2,]
#Table to join df and df1
data_table <- df[order(df$cluster, as.numeric(df$Properties)),]
data_table_1 <- aggregate(. ~ cluster, df[,c("cluster","Properties")], toString)
# Create Icon
leafIcons <- icons(
iconUrl = ifelse(df1$cluster,
"https://cdn-icons-png.flaticon.com/512/25/25694.png"
),
iconWidth = 30, iconHeight = 40,
iconAnchorX = 25, iconAnchorY = 12)
html_legend <- "<img src='https://cdn-icons-png.flaticon.com/512/25/25694.png'>"
#Color and Icon for map
ai_colors <-c("red","gray","blue","orange","green")
clust_colors <- ai_colors[df$cluster]
icons <- awesomeIcons(
icon = 'ios-close',
iconColor = 'black',
library = 'ion',
markerColor = clust_colors)
# Map for all clusters:
m1<-leaflet(df1) %>% addTiles() %>%
addMarkers(~Longitude, ~Latitude,icon = leafIcons) %>%
addAwesomeMarkers(lat=~df$Latitude, lng = ~df$Longitude, icon=icons, label=~as.character(df$cluster)) %>%
addLegend( position = "topright", title="Cluster", colors = ai_colors[1:max(df$cluster)],labels = unique(df$cluster))
plot1<-m1
# Map for specific cluster and propertie
m2<-leaflet(df_spec_clust) %>% addTiles() %>%
addMarkers(~Longitude, ~Latitude,icon = leafIcons) %>%
addAwesomeMarkers(leaflet(df_spec_prop) %>% addTiles(), lat=~df_spec_prop$Latitude, lng = ~df_spec_prop$Longitude, icon= icons)
plot2<-m2
return(list(
"Plot1" = plot1,
"Plot2" = plot2,
"Data" = data_table_1,
"Data1" = data_table
))
}
ui <- bootstrapPage(
navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
"Cl",
tabPanel("Solution",
sidebarLayout(
sidebarPanel(
tags$b(h3("Choose the cluster number?")),
sliderInput("Slider", h5(""),
min = 2, max = 5, value = 3),
),
mainPanel(
tabsetPanel(
tabPanel("Solution", (leafletOutput("Leaf1",width = "95%", height = "600")))))
))),
tabPanel("",
sidebarLayout(
sidebarPanel(
selectInput("Filter1", label = h4("Select just one cluster to show"),""),
selectInput("Filter2",label=h4("Select the cluster property designated above"),""),
),
mainPanel(
tabsetPanel(
tabPanel("Map", (leafletOutput("Leaf2",width = "95%", height = "600")))))))
)
server <- function(input, output, session) {
Modelcl<-reactive({
function.cl(df,input$Slider,input$Filter1,input$Filter2)
})
output$Leaf1 <- renderLeaflet({
Modelcl()[[1]]
})
output$Leaf2 <- renderLeaflet({
Modelcl()[[2]]
})
observeEvent(input$Slider, {
abc <- req(Modelcl()$Data)
updateSelectInput(session,'Filter1',
choices=sort(unique(abc$cluster)))
})
observeEvent(c(input$Slider,input$Filter1),{
abc <- req(Modelcl()$Data1) %>% filter(cluster == as.numeric(input$Filter1))
updateSelectInput(session,'Filter2',
choices=sort(unique(abc$Properties)))})
}
shinyApp(ui = ui, server = server)
The second code involves the creation of a map, however, this time the map from Google Maps, with the objective of making the route between the coordinate of a property that the user chooses from a certain cluster and the house coordinate of the corresponding cluster. The idea is to route between these two coordinates. I am using the googleway package for this. The code to do this is:
Code 2
library(googleway)
set_key( "API KEY")
#database df
df<-structure(list(Properties = c(1,2,3,4,5,6,7),
Latitude = c(-23.8, -23.8, -23.9, -23.9, -23.9,-23.4,-23.5),
Longitude = c(-49.6, -49.3, -49.4, -49.8, -49.6,-49.4,-49.2),
Waste = c(526, 350, 526, 469, 285, 433, 456)), class = "data.frame", row.names = c(NA, -7L))
#To exemplify: k= 2 clusters
k=2
#clusters
coordinates<-df[c("Latitude","Longitude")]
d<-as.dist(distm(coordinates[,2:1]))
fit.average<-hclust(d,method="average")
clusters<-cutree(fit.average, k)
nclusters<-matrix(table(clusters))
df$cluster <- clusters
#database df1
df1<-matrix(nrow=k,ncol=2)
for(i in 1:k){
df1[i,]<-c(weighted.mean(subset(df,cluster==i)$Latitude),
weighted.mean(subset(df,cluster==i)$Longitude))}
df1<-cbind(df1,matrix(c(1:k),ncol=1)) %>%
data.frame()
colnames(df1)<-c("Latitude","Longitude","cluster")
#To exemplify (Filter=1 and Filter2=1)
Filter1=1
Filter2=1
#specific cluster and specific propertie
df_spec_clust <- df1[df1$cluster == Filter1,]
df_spec_prop<-df[df$Properties==Filter2,]
#Generate route
df2<-google_directions(origin = df_spec_clust[,1:2], destination = df_spec_prop[,2:3],
mode = "driving")
df_routes <- data.frame(polyline = direction_polyline(df2))
m3<-google_map() %>%
add_polylines(data = df_routes, polyline = "polyline")
m3
These codes above work fine, now I wanted to combine both. The idea is to generate three graphs, the first two are working fine, however I am not able to generate the route properly. Note that in google_directions, I did origin = df_spec_prop[,2:3] and destination = df_spec_prop[,2:3], however, I did this just to show that the map is generated. However, in my opinion, the right thing would be to do origin = df_spec_clust[,1:2], as done in Code 2 above. When I did that I got the following error: Error in [[: no such index at level 2. I do not know why. Every help is welcome:
If you need more information, feel free to ask.
Code 3
library(shiny)
library(rdist)
library(dplyr)
library(geosphere)
library(shinythemes)
library(leaflet)
library(googleway)
set_key("API KEY")
function.cl<-function(df,k,Filter1,Filter2){
#database df
df<-structure(list(Properties = c(1,2,3,4,5,6,7),
Latitude = c(-23.8, -23.8, -23.9, -23.9, -23.9,-23.4,-23.5),
Longitude = c(-49.6, -49.3, -49.4, -49.8, -49.6,-49.4,-49.2),
Waste = c(526, 350, 526, 469, 285, 433, 456)), class = "data.frame", row.names = c(NA, -7L))
#clusters
coordinates<-df[c("Latitude","Longitude")]
d<-as.dist(distm(coordinates[,2:1]))
fit.average<-hclust(d,method="average")
clusters<-cutree(fit.average, k)
nclusters<-matrix(table(clusters))
df$cluster <- clusters
#database df1
df1<-matrix(nrow=k,ncol=2)
for(i in 1:k){
df1[i,]<-c(weighted.mean(subset(df,cluster==i)$Latitude),
weighted.mean(subset(df,cluster==i)$Longitude))}
df1<-cbind(df1,matrix(c(1:k),ncol=1)) %>%
data.frame()
colnames(df1)<-c("Latitude","Longitude","cluster")
#specific cluster and specific propertie
df_spec_clust <- df1[df1$cluster == Filter1,]
df_spec_prop<-df[df$Properties==Filter2,]
#Table to join df and df1
data_table <- df[order(df$cluster, as.numeric(df$Properties)),]
data_table_1 <- aggregate(. ~ cluster, df[,c("cluster","Properties")], toString)
# Create icon:
leafIcons <- icons(
iconUrl = ifelse(df1$cluster,
"https://cdn-icons-png.flaticon.com/512/25/25694.png"
),
iconWidth = 30, iconHeight = 40,
iconAnchorX = 25, iconAnchorY = 12)
html_legend <- "<img src='https://cdn-icons-png.flaticon.com/512/25/25694.png'>"
#Color and Icon for map
ai_colors <-c("red","gray","blue","orange","green")
clust_colors <- ai_colors[df$cluster]
icons <- awesomeIcons(
icon = 'ios-close',
iconColor = 'black',
library = 'ion',
markerColor = clust_colors)
# Map for all clusters:
m1<-leaflet(df1) %>% addTiles() %>%
addMarkers(~Longitude, ~Latitude,icon = leafIcons) %>%
addAwesomeMarkers(lat=~df$Latitude, lng = ~df$Longitude, icon=icons, label=~as.character(df$cluster)) %>%
addLegend( position = "topright", title="Cluster", colors = ai_colors[1:max(df$cluster)],labels = unique(df$cluster))
plot1<-m1
# Map for specific cluster and propertie
m2<-leaflet(df_spec_clust) %>% addTiles() %>%
addMarkers(~Longitude, ~Latitude,icon = leafIcons) %>%
addAwesomeMarkers(leaflet(df_spec_prop) %>% addTiles(), lat=~df_spec_prop$Latitude, lng = ~df_spec_prop$Longitude, icon= icons)
plot2<-m2
# Map for route
df2<-google_directions(origin = df_spec_prop[,2:3], destination = df_spec_prop[,2:3],
mode = "driving")
df_routes <- data.frame(polyline = direction_polyline(df2))
m3<-google_map() %>%
add_polylines(data = df_routes, polyline = "polyline")
plot3<-m3
return(list(
"Plot1" = plot1,
"Plot2" = plot2,
"Plot3" = plot3,
"Data" = data_table_1,
"Data1" = data_table
))
}
ui <- bootstrapPage(
navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
"Cl",
tabPanel("Solution",
sidebarLayout(
sidebarPanel(
tags$b(h3("Choose the cluster number?")),
sliderInput("Slider", h5(""),
min = 2, max = 5, value = 3),
),
mainPanel(
tabsetPanel(
tabPanel("Solution", (leafletOutput("Leaf1",width = "95%", height = "600")))))
))),
tabPanel("",
sidebarLayout(
sidebarPanel(
selectInput("Filter1", label = h4("Select just one cluster to show"),""),
selectInput("Filter2",label=h4("Select the cluster property designated above"),""),
),
mainPanel(
tabsetPanel(
tabPanel("Map", (leafletOutput("Leaf2",width = "95%", height = "600")),(google_mapOutput("Gmaps",width = "95%", height = "600")))))
)))
server <- function(input, output, session) {
Modelcl<-reactive({
function.cl(df,input$Slider,input$Filter1,input$Filter2)
})
output$Leaf1 <- renderLeaflet({
Modelcl()[[1]]
})
output$Leaf2 <- renderLeaflet({
Modelcl()[[2]]
})
output$Gmaps <- renderGoogle_map({
Modelcl()[[3]]
})
observeEvent(input$Slider, {
abc <- req(Modelcl()$Data)
updateSelectInput(session,'Filter1',
choices=sort(unique(abc$cluster)))
})
observeEvent(c(input$Slider,input$Filter1),{
abc <- req(Modelcl()$Data1) %>% filter(cluster == as.numeric(input$Filter1))
updateSelectInput(session,'Filter2',
choices=sort(unique(abc$Properties)))})
}
shinyApp(ui = ui, server = server)
Solution
I separated Leaf2 and Gmaps into separate tabPanels; When the app initially loads, there is not value for Filter1 or Filter2; I wrapped the generation of m3 in an if statement to check for the availability of rows in df_spec_clust and df_spec_prop:
library(shiny)
library(rdist)
library(dplyr)
library(geosphere)
library(shinythemes)
library(leaflet)
library(googleway)
#set_key("API KEY")
function.cl<-function(df,k,Filter1,Filter2){
#database df
df<-structure(list(Properties = c(1,2,3,4,5,6,7),
Latitude = c(-23.8, -23.8, -23.9, -23.9, -23.9,-23.4,-23.5),
Longitude = c(-49.6, -49.3, -49.4, -49.8, -49.6,-49.4,-49.2),
Waste = c(526, 350, 526, 469, 285, 433, 456)), class = "data.frame", row.names = c(NA, -7L))
#clusters
coordinates<-df[c("Latitude","Longitude")]
d<-as.dist(distm(coordinates[,2:1]))
fit.average<-hclust(d,method="average")
clusters<-cutree(fit.average, k)
nclusters<-matrix(table(clusters))
df$cluster <- clusters
#database df1
df1<-matrix(nrow=k,ncol=2)
for(i in 1:k){
df1[i,]<-c(weighted.mean(subset(df,cluster==i)$Latitude),
weighted.mean(subset(df,cluster==i)$Longitude))}
df1<-cbind(df1,matrix(c(1:k),ncol=1)) %>%
data.frame()
colnames(df1)<-c("Latitude","Longitude","cluster")
#specific cluster and specific propertie
print(Filter1)
print(Filter2)
df_spec_clust <- df1[df1$cluster == Filter1,]
df_spec_prop<-df[df$Properties==Filter2,]
#Table to join df and df1
data_table <- df[order(df$cluster, as.numeric(df$Properties)),]
data_table_1 <- aggregate(. ~ cluster, df[,c("cluster","Properties")], toString)
# Create icon:
leafIcons <- icons(
iconUrl = ifelse(df1$cluster,
"https://cdn-icons-png.flaticon.com/512/25/25694.png"
),
iconWidth = 30, iconHeight = 40,
iconAnchorX = 25, iconAnchorY = 12)
html_legend <- "<img src='https://cdn-icons-png.flaticon.com/512/25/25694.png'>"
#Color and Icon for map
ai_colors <-c("red","gray","blue","orange","green")
clust_colors <- ai_colors[df$cluster]
icons <- awesomeIcons(
icon = 'ios-close',
iconColor = 'black',
library = 'ion',
markerColor = clust_colors)
# Map for all clusters:
m1<-leaflet(df1) %>% addTiles() %>%
addMarkers(~Longitude, ~Latitude,icon = leafIcons) %>%
addAwesomeMarkers(lat=~df$Latitude, lng = ~df$Longitude, icon=icons, label=~as.character(df$cluster)) %>%
addLegend( position = "topright", title="Cluster", colors = ai_colors[1:max(df$cluster)],labels = unique(df$cluster))
plot1<-m1
# Map for specific cluster and propertie
m2<-leaflet(df_spec_clust) %>% addTiles() %>%
addMarkers(~Longitude, ~Latitude,icon = leafIcons) %>%
addAwesomeMarkers(leaflet(df_spec_prop) %>% addTiles(), lat=~df_spec_prop$Latitude, lng = ~df_spec_prop$Longitude, icon= icons)
plot2<-m2
# Map for route
if(nrow(df_spec_clust>0) & nrow(df_spec_prop>0)) {
print("updating map")
print(df_spec_clust[,1:2])
print(df_spec_prop[,2:3])
df2<-google_directions(origin = df_spec_clust[,1:2], destination = df_spec_prop[,2:3],
mode = "driving")
df_routes <- data.frame(polyline = direction_polyline(df2))
m3<-google_map() %>%
add_polylines(data = df_routes, polyline = "polyline")
plot3<-m3
} else {
plot3 <- NULL
}
return(list(
"Plot1" = plot1,
"Plot2" = plot2,
"Plot3" = plot3,
"Data" = data_table_1,
"Data1" = data_table
))
}
ui <- bootstrapPage(
navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
"Cl",
tabPanel("Solution",
sidebarLayout(
sidebarPanel(
tags$b(h3("Choose the cluster number?")),
sliderInput("Slider", h5(""),
min = 2, max = 5, value = 3),
),
mainPanel(
tabsetPanel(
tabPanel("Solution", (leafletOutput("Leaf1",width = "95%", height = "600")))))
))),
tabPanel("",
sidebarLayout(
sidebarPanel(
selectInput("Filter1", label = h4("Select just one cluster to show"),""),
selectInput("Filter2",label=h4("Select the cluster property designated above"),""),
),
mainPanel(
tabsetPanel(
tabPanel("Leaf2", (leafletOutput("Leaf2",width = "95%", height = "600"))),
tabPanel("Gmaps", (google_mapOutput("Gmaps",width = "95%", height = "600")))
)
)))
)
server <- function(input, output, session) {
Modelcl<-reactive({
function.cl(df,input$Slider,input$Filter1,input$Filter2)
})
output$Leaf1 <- renderLeaflet({
Modelcl()[[1]]
})
output$Leaf2 <- renderLeaflet({
Modelcl()[[2]]
})
output$Gmaps <- renderGoogle_map({
Modelcl()[[3]]
})
observeEvent(input$Slider, {
abc <- req(Modelcl()$Data)
updateSelectInput(session,'Filter1',
choices=sort(unique(abc$cluster)))
})
observeEvent(c(input$Slider,input$Filter1),{
abc <- req(Modelcl()$Data1) %>% filter(cluster == as.numeric(input$Filter1))
updateSelectInput(session,'Filter2',
choices=sort(unique(abc$Properties)))})
}
shinyApp(ui = ui, server = server)
- Retrieving expected data.frame for testthat expectation
- How to use an anonymous function with pipe operator?
- R passing RSelenium driver environment as function argument
- Keep file names merging list with lapply?
- replace strings that contains one another
- Stop parsing out zeros after decimals in ggplot2's annotate
- Plot data.tree coloring and labelling by level
- Extracting the date and time out of a date and time format
- How to reshape a dataframe into wide format with specified column pairs
- Show partial segments removed after limit scales for `geom_pointrange`
- Control ggplot2 legend look without affecting the plot
- Concatenate strings over all rows in a single column of a data frame
- Is there some way to keep variable names from.SD+.SDcols together with non .SD variable names in data.table?
- How to create mutually dependent checkbox columns in a DT table?
- A problem with an stacked, grouped and faceted graph y gg plot
- Installing R on Linux: configure: error: libcurl >= 7.28.0 library and headers are required with support for https
- Create a column conditional on multiple other character and numerical columns
- data.frame to array (2 columns)
- Changing options() in a function environment without changing options() in global environment in R?
- pivot(), group_by() and summarise() with nested data
- Why legend is not showing up in plot layout using patchwork in R?
- in dplyr::mutate, dplyr::starts_with works for .before but not .after?
- Finding optimal cut-off points for dividing a variable into equal groups considering ties in which quantiles do not work
- How to add a legend to hline?
- R Shiny Suppress slider handle for sliderInput until click
- brmultinom brglm2 vifs and dredge dont work
- R, how to get current time miliseconds, without extra information ? (Sys.time(), format("%X"))
- Installing multiple versions of R
- Command to see 'R' path that RStudio is using
- Fast pairwise longest common substring from start