Adjust the way to calculate the distance between two points in shiny code

Question

. 。 Answers to this question are eligible for a +50 reputation bounty. Antonio wants to to this question. 这个问题。

The shiny code below generates the route between two points, using the googleway function. Note that in addition, the distance between the two points is calculated, but this is the Euclidean distance and not the real distance using the googleway functions. The correct way to calculate the distance is by doing the following:

test<-google_directions(origin = c(-24.872139, -50.038787), destination = c(-24.9062992895515, -50.0125745903862), mode = "driving", alternatives = TRUE)

Distance<-sum(as.numeric(direction_steps(test)$distance$value)) 
[1] 6153

However, I would like this form of calculation in the shiny code below, in order to calculate the route properly. Therefore, can you help me adjust the code in shiny?

Code in Shiny

library(shiny)
library(dplyr)
library(geosphere)
library(shinythemes)
library(googleway)

set_key( "AIzaSyBD6kgTlgcTa6iwLwoWtKrKQI6QNodEkmo")

k=3

function.cl<-function(df,k,Filter1,Filter2){
  
 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), 
  cluster = c(1L, 2L, 2L, 1L, 1L, 3L,3L)), row.names = c(NA, -7L), class = "data.frame")
  

  df1<-structure(list(Latitude = c(-23.8666666666667, -23.85, -23.45
  ), Longitude = c(-49.6666666666667, -49.35, -49.3), cluster = c(1, 
  2, 3)), class = "data.frame", row.names = c(NA, -3L))
  
 
  #specific cluster and specific propertie
  df_spec_clust <- df1[df1$cluster == Filter1,]
  df_spec_prop<-df[df$Properties==Filter2,]
  
  #Table to join
  data_table <- df[order(df$cluster, as.numeric(df$Properties)),]
  data_table_1 <- aggregate(. ~ cluster, df[,c("cluster","Properties")], toString)
  

  # Map for route
  if(nrow(df_spec_clust>0) & nrow(df_spec_prop>0)) {
  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))
            
    m1<-google_map() %>%
      add_polylines(data = df_routes, polyline = "polyline")
    
    plot1<-m1 
  } else {
    plot1 <- NULL
  }
  
  
  DISTANCE<- merge(df,df1,by = c("cluster"), suffixes = c("_df","_df1"))
  
  (DISTANCE$distance <- purrr::pmap_dbl(.l = list(DISTANCE$Longitude_df,
                                                    DISTANCE$Latitude_df,
                                                    DISTANCE$Longitude_df1,
                                                    DISTANCE$Latitude_df1),
                                          .f = ~distm(c(..1,..2),c(..3,..4))))
  
  

  return(list(
    "Plot1" = plot1,
    "DIST" = DISTANCE,
    "Data" = data_table_1,
    "Data1" = data_table
  ))
}

ui <- bootstrapPage(
  navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
             "Cl", 
             tabPanel("Solution",
                      sidebarLayout(
                        sidebarPanel(
                          
                          selectInput("Filter1", label = h4("Select just one cluster to show"),""),
                          selectInput("Filter2",label=h4("Select the cluster property designated above"),""),
                          h4("The distance is:"),
                          textOutput("dist"),
                        ),
                        mainPanel(
                          tabsetPanel(      
                            tabPanel("Gmaps", (google_mapOutput("Gmaps",width = "95%", height = "600")))
                        
                      ))))))

server <- function(input, output, session) {
  
  Modelcl<-reactive({
    function.cl(df,k,input$Filter1,input$Filter2)
  })
  

  output$Gmaps <- renderGoogle_map({
    Modelcl()[[1]]
  })
  
  observeEvent(k, {
    abc <- req(Modelcl()$Data)
    updateSelectInput(session,'Filter1',
                      choices=sort(unique(abc$cluster)))
  }) 
  
  observeEvent(c(k,input$Filter1),{
    abc <- req(Modelcl()$Data1) %>% filter(cluster == as.numeric(input$Filter1))
    updateSelectInput(session,'Filter2',
                      choices=sort(unique(abc$Properties)))})
  
  output$dist <- renderText({
    DIST <- data.frame(Modelcl()[[2]])
    DIST$distance[DIST$cluster == input$Filter1 & DIST$Properties == input$Filter2]
  })
  
  
}

shinyApp(ui = ui, server = server)

Answer 1

You could first simplify calculation of euclidian distance: purrr::map isn't needed here as the calculation is only between two points.

Then, road distance calculation is straight forward with the code you provided:

library(shiny)
library(dplyr)
library(geosphere)
library(shinythemes)
library(googleway)

set_key( "AIzaSyBD6kgTlgcTa6iwLwoWtKrKQI6QNodEkmo")

k=3

function.cl<-function(Filter1,Filter2){
  
  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), 
                     cluster = c(1L, 2L, 2L, 1L, 1L, 3L,3L)), row.names = c(NA, -7L), class = "data.frame")
  
  
  df1<-structure(list(Latitude = c(-23.8666666666667, -23.85, -23.45
  ), Longitude = c(-49.6666666666667, -49.35, -49.3), cluster = c(1, 
                                                                  2, 3)), class = "data.frame", row.names = c(NA, -3L))
  
  
  #specific cluster and specific propertie
  df_spec_clust <- df1[df1$cluster == Filter1,]
  df_spec_prop<-df[df$Properties==Filter2,]
  
  #Table to join
  data_table <- df[order(df$cluster, as.numeric(df$Properties)),]
  data_table_1 <- aggregate(. ~ cluster, df[,c("cluster","Properties")], toString)
  
  
  # Map for route
  if(nrow(df_spec_clust>0) & nrow(df_spec_prop>0)) {
    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))
    
    m1<-google_map() %>%
      add_polylines(data = df_routes, polyline = "polyline")
    
    plot1<-m1 
    # Euclidian distance
    distance_road <- sum(as.numeric(direction_steps(df2)$distance$value)) 
    # Road distance
    distance_straight <- distm(df_spec_clust[,2:1],df_spec_prop[,3:2])
  } else {
    plot1 <- NULL
    distance_road <- NA
    distance_straight <- NA
  }
  

  # Not needed?
  DISTANCE<- merge(df,df1,by = c("cluster"), suffixes = c("_df","_df1"))
  
  (DISTANCE$distance <- purrr::pmap_dbl(.l = list(DISTANCE$Longitude_df,
                                                  DISTANCE$Latitude_df,
                                                  DISTANCE$Longitude_df1,
                                                  DISTANCE$Latitude_df1),
                                        .f = ~distm(c(..1,..2),c(..3,..4))))
  
  
  
  return(list(
    "Plot1" = plot1,
    "DIST" = DISTANCE,
    "distance_road" = distance_road,
    "distance_straight" = distance_straight,
    "Data" = data_table_1,
    "Data1" = data_table
  ))
}

ui <- bootstrapPage(
  navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
             "Cl", 
             tabPanel("Solution",
                      sidebarLayout(
                        sidebarPanel(
                          
                          selectInput("Filter1", label = h4("Select just one cluster to show"),""),
                          selectInput("Filter2",label=h4("Select the cluster property designated above"),""),
                          h4("The distance is:"),
                          textOutput("dist"),
                          textOutput("distance_straight"),
                          textOutput("distance_road")
                        ),
                        mainPanel(
                          tabsetPanel(      
                            tabPanel("Gmaps", (google_mapOutput("Gmaps",width = "95%", height = "600")))
                            
                          ))))))

server <- function(input, output, session) {
  
  Modelcl<-reactive({
    function.cl(input$Filter1,input$Filter2)
  })
  
  
  output$Gmaps <- renderGoogle_map({
    Modelcl()[[1]]
  })
  
  observeEvent(k, {
    abc <- req(Modelcl()$Data)
    updateSelectInput(session,'Filter1',
                      choices=sort(unique(abc$cluster)))
  }) 
  
  observeEvent(c(k,input$Filter1),{
    abc <- req(Modelcl()$Data1) %>% filter(cluster == as.numeric(input$Filter1))
    updateSelectInput(session,'Filter2',
                      choices=sort(unique(abc$Properties)))})
  
  # Original calculation
  output$dist <- renderText({
    DIST <- data.frame(Modelcl()[[2]])
    paste0("Original distance calculation: ",round(DIST$distance[DIST$cluster == input$Filter1 & DIST$Properties == input$Filter2])," meters")
  })
  
  # Simplified version
  output$distance_straight <- renderText({
    paste0("Simplified distance calculation: ",round(Modelcl()$distance_straight)," meters")
  })
  
  output$distance_road <- renderText({
    paste0("Road distance calculation: ",Modelcl()$distance_road," meters")
    })
  

  
  
}

shinyApp(ui = ui, server = server)