I am rendering a map in R/shiny in this output widget leafletOutput("map")
in UI.
In server, I am creating the map object using tmap
and then in renderLeaflet()
I use tmap_leaflet(tmap_object)
to display the map.
I would like to click on a feature on the map, capture the coordinates where I clicked so I can select the feature I clicked. I would use this information to display a table in another widget. I have provided a reproducible example at the end of this post. The challenge is the following:
- When I click once on the map, only the popup appears and my table doesn't get updated.
- When I double-click on the map, my table gets updated but the map zooms in at the same time.
Can I, at least, prevent 1 or 2 (i.e. skip the popup and register the single-click as a proper mouse-click event that will update my table; or prevent the double-click from zooming in my map).
REPREX:
I have uploaded the 3 input files in this Google Drive folder.
# install required packages in they are not already installed
if(!"remotes" %in% installed.packages()){
install.packages("remotes")
}
cran_pkgs = c("magrittr", "dplyr", "shiny", "shinyjs", "bslib", "leaflet", "sf", "tmap", "viridis")
remotes::install_cran(cran_pkgs)
# load required packages
libraries <- c("magrittr", "dplyr", "shiny", "shinyjs", "bslib", "leaflet", "sf", "tmap", "viridis")
lapply(libraries, require, character.only = T)
# Load data
district <- readRDS("district.RDS")
sectors <- readRDS("sectors.RDS")
locations <- readRDS("locations.RDS")
# Create the map with shiny
#=========================
ui <- fluidPage(
useShinyjs(), # Initialize shinyjs
titlePanel("My test map title"),
fluidRow(
column(4,
shinyjs::hidden(
card(
id = "detailsCard",
style = "height: 60vh;",
full_screen = FALSE,
card_header("Details at click point"),
card_body(
tableOutput("details")
)
)
)
),
column(8,
card(
id = "mapCard",
style = "height: 100vh;",
full_screen = TRUE,
card_header("Map"),
card_body(
leafletOutput("map")
)
)
)
)
)
server <- function(input, output, session) {
output$map <- renderLeaflet({
# create the tmap object
tmap_object <- tm_shape(district) +
tm_borders(col = "#A76948", alpha = .6, lwd = 3) +
tm_shape(sectors) +
tm_borders() +
tm_fill(col = "number_of_clients",
title = "number of clients",
style = "jenks",
palette = cividis(6),
id = "sector", # to specify which column to use for tooltips
alpha = .6) +
tm_view(bbox = st_bbox(district)) # Set the initial extent to fit the AoI layer
# convert the tmap object to a leaflet map
tmap_leaflet(tmap_object)
})
# Create a reactive value to store the clicked coordinates
clicked_coords <- reactiveValues(lon = NA, lat = NA)
# Observe the map click event
observeEvent(input$map_click, {
clicked_coords$lon <- input$map_click$lng
clicked_coords$lat <- input$map_click$lat
# Show the details card when a sector is clicked
shinyjs::toggle("detailsCard")
})
# filter my data and display only the records relevant for the clicked spot
output$details <- renderTable({
# Filter the data given the sector clicked and display as a table
longitude <- as.numeric(clicked_coords$lon)
latitude <- as.numeric(clicked_coords$lat)
clicked_spot <- st_sfc(st_point(c(longitude, latitude)), crs=4326) # Create an sf point
clicked_spot <- st_transform(clicked_spot, crs = st_crs(district)) # Re-project the point appropriately
clicked_sector <- sectors %>% st_filter(clicked_spot, .predicate = st_intersects)
my_clients <- locations %>% st_filter(clicked_sector, .predicate = st_intersects) %>% st_drop_geometry()
})
}
shinyApp(ui, server)
Shiny applications not supported in static R Markdown documents
Created on 2023-12-14 with reprex v2.0.2
Session infosessioninfo::session_info()
#> ─ Session info ───────────────────────────────────────────────────────────────
#> setting value
#> version R version 4.3.1 (2023-06-16 ucrt)
#> os Windows 11 x64 (build 22631)
#> system x86_64, mingw32
#> ui RTerm
#> language (EN)
#> collate English_United States.utf8
#> ctype English_United States.utf8
#> tz Africa/Johannesburg
#> date 2023-12-14
#> pandoc 3.1.1 @ C:/Program Files/RStudio/resources/app/bin/quarto/bin/tools/ (via rmarkdown)
#>
#> ─ Packages ───────────────────────────────────────────────────────────────────
#> package * version date (UTC) lib source
#> abind 1.4-5 2016-07-21 [1] CRAN (R 4.3.0)
#> base64enc 0.1-3 2015-07-28 [1] CRAN (R 4.3.0)
#> bslib * 0.6.1 2023-11-28 [1] CRAN (R 4.3.1)
#> cachem 1.0.8 2023-05-01 [1] CRAN (R 4.3.1)
#> class 7.3-22 2023-05-03 [2] CRAN (R 4.3.1)
#> classInt 0.4-9 2023-02-28 [1] CRAN (R 4.3.1)
#> cli 3.6.1 2023-03-23 [1] CRAN (R 4.3.1)
#> codetools 0.2-19 2023-02-01 [2] CRAN (R 4.3.1)
#> colorspace 2.1-0 2023-01-23 [1] CRAN (R 4.3.1)
#> crosstalk 1.2.0 2021-11-04 [1] CRAN (R 4.3.1)
#> DBI 1.1.3 2022-06-18 [1] CRAN (R 4.3.1)
#> dichromat 2.0-0.1 2022-05-02 [1] CRAN (R 4.3.0)
#> digest 0.6.33 2023-07-07 [1] CRAN (R 4.3.1)
#> dplyr * 1.1.4 2023-11-17 [1] CRAN (R 4.3.2)
#> e1071 1.7-13 2023-02-01 [1] CRAN (R 4.3.1)
#> ellipsis 0.3.2 2021-04-29 [1] CRAN (R 4.3.1)
#> evaluate 0.21 2023-05-05 [1] CRAN (R 4.3.1)
#> fansi 1.0.4 2023-01-22 [1] CRAN (R 4.3.1)
#> fastmap 1.1.1 2023-02-24 [1] CRAN (R 4.3.1)
#> fs 1.6.3 2023-07-20 [1] CRAN (R 4.3.1)
#> generics 0.1.3 2022-07-05 [1] CRAN (R 4.3.1)
#> ggplot2 3.4.3 2023-08-14 [1] CRAN (R 4.3.1)
#> glue 1.6.2 2022-02-24 [1] CRAN (R 4.3.1)
#> gridExtra 2.3 2017-09-09 [1] CRAN (R 4.3.1)
#> gtable 0.3.3 2023-03-21 [1] CRAN (R 4.3.1)
#> htmltools 0.5.7 2023-11-03 [1] CRAN (R 4.3.2)
#> htmlwidgets 1.6.2 2023-03-17 [1] CRAN (R 4.3.1)
#> httpuv 1.6.11 2023-05-11 [1] CRAN (R 4.3.1)
#> jquerylib 0.1.4 2021-04-26 [1] CRAN (R 4.3.1)
#> jsonlite 1.8.7 2023-06-29 [1] CRAN (R 4.3.1)
#> KernSmooth 2.23-21 2023-05-03 [2] CRAN (R 4.3.1)
#> knitr 1.43 2023-05-25 [1] CRAN (R 4.3.1)
#> later 1.3.1 2023-05-02 [1] CRAN (R 4.3.1)
#> lattice 0.21-8 2023-04-05 [2] CRAN (R 4.3.1)
#> leafem 0.2.0.9021 2023-08-14 [1] Github (r-spatial/leafem@09c65e6)
#> leaflet * 2.2.1 2023-11-13 [1] CRAN (R 4.3.2)
#> leaflet.providers 2.0.0 2023-10-17 [1] CRAN (R 4.3.2)
#> leafsync 0.1.0 2019-03-05 [1] CRAN (R 4.3.1)
#> lifecycle 1.0.3 2022-10-07 [1] CRAN (R 4.3.1)
#> lwgeom 0.2-13 2023-05-22 [1] CRAN (R 4.3.1)
#> magrittr * 2.0.3 2022-03-30 [1] CRAN (R 4.3.2)
#> memoise 2.0.1 2021-11-26 [1] CRAN (R 4.3.1)
#> mime 0.12 2021-09-28 [1] CRAN (R 4.3.0)
#> munsell 0.5.0 2018-06-12 [1] CRAN (R 4.3.1)
#> pillar 1.9.0 2023-03-22 [1] CRAN (R 4.3.1)
#> pkgconfig 2.0.3 2019-09-22 [1] CRAN (R 4.3.1)
#> png 0.1-8 2022-11-29 [1] CRAN (R 4.3.0)
#> promises 1.2.1 2023-08-10 [1] CRAN (R 4.3.1)
#> proxy 0.4-27 2022-06-09 [1] CRAN (R 4.3.1)
#> purrr 1.0.2 2023-08-10 [1] CRAN (R 4.3.1)
#> R.cache 0.16.0 2022-07-21 [1] CRAN (R 4.3.1)
#> R.methodsS3 1.8.2 2022-06-13 [1] CRAN (R 4.3.0)
#> R.oo 1.25.0 2022-06-12 [1] CRAN (R 4.3.0)
#> R.utils 2.12.2 2022-11-11 [1] CRAN (R 4.3.1)
#> R6 2.5.1 2021-08-19 [1] CRAN (R 4.3.1)
#> raster 3.6-23 2023-07-04 [1] CRAN (R 4.3.1)
#> RColorBrewer 1.1-3 2022-04-03 [1] CRAN (R 4.3.0)
#> Rcpp 1.0.11 2023-07-06 [1] CRAN (R 4.3.1)
#> remotes 2.4.2.1 2023-07-18 [1] CRAN (R 4.3.2)
#> reprex 2.0.2 2022-08-17 [1] CRAN (R 4.3.2)
#> rlang 1.1.1 2023-04-28 [1] CRAN (R 4.3.1)
#> rmarkdown 2.23 2023-07-01 [1] CRAN (R 4.3.1)
#> rstudioapi 0.15.0 2023-07-07 [1] CRAN (R 4.3.1)
#> sass 0.4.7 2023-07-15 [1] CRAN (R 4.3.1)
#> scales 1.2.1 2022-08-20 [1] CRAN (R 4.3.1)
#> sessioninfo 1.2.2 2021-12-06 [1] CRAN (R 4.3.1)
#> sf * 1.0-14 2023-07-11 [1] CRAN (R 4.3.2)
#> shiny * 1.8.0 2023-11-17 [1] CRAN (R 4.3.2)
#> shinyjs * 2.1.0 2021-12-23 [1] CRAN (R 4.3.2)
#> sp 2.0-0 2023-06-22 [1] CRAN (R 4.3.1)
#> stars 0.6-3 2023-08-11 [1] CRAN (R 4.3.1)
#> styler 1.10.2 2023-08-29 [1] CRAN (R 4.3.1)
#> terra 1.7-39 2023-06-23 [1] CRAN (R 4.3.1)
#> tibble 3.2.1 2023-03-20 [1] CRAN (R 4.3.1)
#> tidyselect 1.2.0 2022-10-10 [1] CRAN (R 4.3.1)
#> tmap * 3.3-4 2023-09-12 [1] CRAN (R 4.3.2)
#> tmaptools 3.1-1 2021-01-19 [1] CRAN (R 4.3.1)
#> units 0.8-3 2023-08-10 [1] CRAN (R 4.3.1)
#> utf8 1.2.3 2023-01-31 [1] CRAN (R 4.3.1)
#> vctrs 0.6.4 2023-10-12 [1] CRAN (R 4.3.2)
#> viridis * 0.6.4 2023-07-22 [1] CRAN (R 4.3.1)
#> viridisLite * 0.4.2 2023-05-02 [1] CRAN (R 4.3.1)
#> webshot 0.5.5 2023-06-26 [1] CRAN (R 4.3.1)
#> withr 2.5.0 2022-03-03 [1] CRAN (R 4.3.1)
#> xfun 0.40 2023-08-09 [1] CRAN (R 4.3.1)
#> XML 3.99-0.14 2023-03-19 [1] CRAN (R 4.3.0)
#> xtable 1.8-4 2019-04-21 [1] CRAN (R 4.3.1)
#> yaml 2.3.7 2023-01-23 [1] CRAN (R 4.3.0)
#> ──────────────────────────────────────────────────────────────────────────────
I'm not entirely sure if this is what you're after, but this works for me with just one click. I think there's better ways to do achieve this (
reactive()
s and theNULL
checks) but it works and makes sense in my head.I would also suggest that using
shinyjs::toggle()
is probably not what you want since it will toggle the table on each click regardless of whether it the click intersected with data or not. I.E., I could click the same place twice and it would show the table and then hide it which I'm not sure is what the user would expect. You could maybe use a show/hide button instead?This code also adds a marker where the user clicks which I found to be useful. Anyway, hope this helps!