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

Question

我只是从 R/Shiny 开始。在本练习中，我试图计算从传单地图上的点击点到数据框中其他点的距离。我需要得到的最终输出是从单击点到 sample_points 数据框中每个经纬度对的距离。我能够获得点击点的反应经纬度值，但不能获得距离测量值。请参阅下面的 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。