rshinyreactiver-leaflet

Calculate distance from clicked point on leaflet map in R Shiny


I am trying to calculate distance from the clicked point on a leaflet map to other points in a data frame. The final output I need to get is distance from the clicked point to each of the lat-long pairs in the sample_points data frame. I am able to get reactive lat-long values of the clicked point, but not the distance measurement. Please see the below app.R code.

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)

Solution

  • In ui, you should use dataTableOutput("distance"), not renderDataTable(). That is why output$distance <- renderDataTable({...}) is not being executed.

    Then in output$distance you forgot to call clicked_point as a reactive. It should be clicked_point()$Long for example. And to avoid having an error display on first load, you need to check if clicked_point already has valid values.

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

    I earlier suggested using req() to check if clicked_point() contained a valid value, but req(), and isTruthy() returns TRUE for empty data.frames.