Problems generating route between two coordinates in a shiny app

Question

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)

score 1 · Accepted Answer · answered Mar 28 '22 at 01:50

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)

Hi @langtang, please, can you take a look at this question?https://stackoverflow.com/questions/73111014/adjust-the-way-to-calculate-the-distance-between-two-points-in-shiny-code — Antonio, Jul 25 '22 at 16:25

Problems generating route between two coordinates in a shiny app

1 Answers1

Linked