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)
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.