调整Shiny代码中点间距离计算：改用Googleway实际路径距离

关键修改点 #

• 移除geosphere::distm的欧氏距离计算逻辑，改用googleway调用Google Directions API获取实际驾车路线，再提取各路段距离求和。
• 添加API调用失败的容错处理，避免程序崩溃。
• 确保API密钥已正确配置且具备Directions API权限。

修改后的完整代码 #

library(shiny)
library(dplyr)
library(shinythemes)
library(googleway)
library(purrr)  # 显式加载purrr包

set_key("YOUR_API_KEY")  # 替换为你的有效Google Maps API密钥

k=3

# 定义计算驾车距离的辅助函数
calc_driving_distance <- function(lat_origin, lon_origin, lat_dest, lon_dest) {
  route <- google_directions(
    origin = c(lat_origin, lon_origin),
    destination = c(lat_dest, lon_dest),
    mode = "driving"
  )
  
  # 检查API响应是否成功
  if (route$status == "OK") {
    sum(as.numeric(direction_steps(route)$distance$value))
  } else {
    warning(paste("路线获取失败，状态码：", route$status))
    NA
  }
}

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))
  
 
  # 指定集群和属性
  df_spec_clust <- df1[df1$cluster == Filter1,]
  df_spec_prop<-df[df$Properties==Filter2,]
  
  # 整理表格数据
  data_table <- df[order(df$cluster, as.numeric(df$Properties)),]
  data_table_1 <- aggregate(. ~ cluster, df[,c("cluster","Properties")], toString)
  

  # 生成路线地图
  if(nrow(df_spec_clust)>0 & nrow(df_spec_prop)>0) {  # 修正原代码的括号位置错误
  df2<-google_directions(origin = df_spec_clust[,c("Latitude","Longitude")], 
   destination = df_spec_prop[,c("Latitude","Longitude")], 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$Latitude_df,
      DISTANCE$Longitude_df,
      DISTANCE$Latitude_df1,
      DISTANCE$Longitude_df1
    ),
    .f = ~calc_driving_distance(..1, ..2, ..3, ..4)
  )
  

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

ui <- bootstrapPage(
  navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
             "集群路线工具", 
             tabPanel("解决方案",
                      sidebarLayout(
                        sidebarPanel(
                          
                          selectInput("Filter1", label = h4("选择要显示的集群"),""),
                          selectInput("Filter2",label=h4("选择上述集群中的属性"),""),
                          h4("实际驾车距离："),
                          textOutput("dist"),
                        ),
                        mainPanel(
                          tabsetPanel(      
                            tabPanel("地图", (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]])
    selected_dist <- DIST$distance[DIST$cluster == input$Filter1 & DIST$Properties == input$Filter2]
    if (!is.na(selected_dist)) {
      paste(selected_dist, "米")  # 添加单位说明
    } else {
      "无法获取路线距离"
    }
  })
  
  
}

shinyApp(ui = ui, server = server)

额外说明 #

• 原代码中nrow(df_spec_clust>0)存在括号位置错误，已修正为nrow(df_spec_clust)>0。
• 距离结果以米为单位显示，可根据需求转换为千米（除以1000）。
• 频繁调用Google Directions API会产生费用，建议根据实际使用情况优化调用逻辑（如缓存已计算的路线）。

内容的提问来源于stack exchange，提问作者Antonio