计算R Shiny中传单地图上点击点的距离

Question

我正在尝试计算从传单地图上单击的点到数据框中其他点的距离。我需要获得的最终输出是从单击的点到样本点数据框中每个经纬度对的距离。我能够获得点击点的反应性经纬度值，但不能获得距离测量值。请参阅下面的app.R代码。

library(shiny)
library(shinydashboard)
library(dplyr)
library(leaflet)
library(geodist)

# Sample points
sample_lat <- c(40.1, 40.2, 40.3, 40.4, 40.5)
sample_long <- c(-89.1, -89.2, -89.3, -88.9, -88.8)
sample_points <-
  data.frame(Latitude = sample_lat, Longitude = sample_long)

ui <- dashboardPage(dashboardHeader(),
                    
                    dashboardSidebar(),
                    
                    dashboardBody(fluidRow(
                      box(width = NULL,
                          leafletOutput("map", height = 500)),
                      box(width = NULL,
                          tableOutput("location")),
                      box(width = NULL,
                          renderDataTable("distance"))
                    )))

server <- function(input, output) {
  # Map output
  output$map <- renderLeaflet({
    leaflet() %>%
      addTiles() %>%
      setView(-89.0, 40.5, zoom = 9)
  })
  
  click_values <- reactiveValues(clat = NULL,
                                 clng = NULL)
  # Click event
  observeEvent(input$map_click, {
    click <- input$map_click
    click_values$clat <- click$lat
    click_values$clng <- click$lng
    leafletProxy('map') %>%
      clearMarkers() %>%
      addMarkers(lng = click_values$clng,
                 lat = click_values$clat)
  })
  
  clicked_point <-
    reactive({
      df = data.frame(Long = click_values$clng,
                      Lat = click_values$clat)
    })
  
  output$location <- renderTable({
    clicked_point()
  })
  
  # Calculated distance from the clicked point
  
  output$distance <- renderDataTable({
    sample_points %>%
      mutate(
        dist = geodist::geodist_vec(
          x1 = sample_points$Longitude,
          y1 = sample_points$Latitude,
          x2 = clicked_point$Long,
          y2 = clicked_point$Lat,
          paired = TRUE,
          measure = "haversine"
        )
      ) %>%
      mutate(dist_mi = dist / 1609) %>%
      select(-dist)
  })
  
}

shinyApp(ui, server)

Answer 1

在

ui

中，您应该使用

dataTableOutput("distance")

，而不是

renderDataTable()

。这就是为什么

output$distance <- renderDataTable({...})

没有被执行。

然后在

output$distance

中你忘记调用

clicked_point

作为反应。例如，它应该是

clicked_point()$Long

。为了避免在首次加载时显示错误，您需要检查

clicked_point

是否已经具有有效值。

output$distance <- renderDataTable({
if(nrow(clicked_point()) == 0)
  return()
sample_points %>%
...
})

我之前建议使用

req()

检查

clicked_point()

是否包含有效值，但

req()

和

isTruthy()

对于空 data.frames 返回 TRUE。