I'm working on a Shiny app that needs to have two maps showing the same area under 2 different scenarios (similar to facets in ggplot). The app has an animation, displaying the data over time, and leafletProxy is used. Ideally, the maps would be synced like with leafsync or similar. The issue is that seemingly leafsync doesn't play nice with leafletProxy. Similar questions were asked here and here (where in answer 2 one map is "synced" to the other, but not the other way around). Any suggestions are welcome!
EDIT: just discovered syncWith() from leaflet.minicharts here, trying to figure out if that will work with leafletProxy.
Using the toy example from the first link:
options("rgdal_show_exportToProj4_warnings"="none") # mute warnings from rgdal because I'm using proj strings
library(shiny)
library(shinyWidgets)
library(leaflet)
library(raster)
library(leafsync)
library(shinydashboard)
set.seed(1)
frog <- data.frame(x=sample(seq(from=-105, to=-95,by=.4), 300, replace = T),
y = sample(seq(from=35, to=45,by=.4), 300, replace=T),
sample1.2000 = runif(300,min=40, max = 250),
sample2.2000 = runif(300,min=40, max = 250),
sample1.2001 = runif(300,min=10, max = 220),
sample2.2001 = runif(300,min=10, max = 220),
sample1.2002 = runif(300,min=0, max = 200),
sample2.2002 = runif(300,min=0, max = 200)
)
toad <- data.frame(x=sample(seq(from=-105, to=-95,by=.4), 500, replace = T),
y = sample(seq(from=35, to=45,by=.4), 500, replace=T),
sample1.2000 = runif(500,min=100, max = 750),
sample2.2000 = runif(500,min=100, max = 750),
sample1.2001 = runif(500,min=500, max = 900),
sample2.2001 = runif(500,min=100, max = 600),
sample1.2002 = runif(500,min=300, max = 900),
sample2.2002 = runif(500,min=50, max = 600)
)
ui <-
fluidPage(
fluidRow(
box(width = 12,
box(width=6,
radioGroupButtons(
inputId = "species",
label = "Target Species",
choiceNames = list("Frog",
"Toad"),
choiceValues = list("frog","toad"),
selected = "frog",
justified = TRUE,
status="primary"
),
),
box(width=6,
sliderInput("year",
label = "Year", min = 2000,
max = 2002, value = 2000,
sep="")
),
),
),
fluidRow(
uiOutput('map', height = "150vh")
)
)
server <- function(input, output) {
# set limits for scales, dependent on species
spp_lim <- eventReactive(input$species, {
switch(input$species,
"frog" = c(0:250), # highest frog density is 250
"toad" = c(0:1000), # highest toad density is 1000
)
})
# create a color palette for the map
map_pal <- reactiveValues()
observe({
map_pal$pal <- colorNumeric(palette = "plasma",
spp_lim(),
na.color = "transparent",
reverse=F)
})
output$map <- renderUI({
# add blank leaflet map
sync(
leaflet( options = leafletOptions(minZoom = 3, maxZoom = 7, zoomControl = TRUE)) %>%
addProviderTiles("CartoDB.VoyagerNoLabels") %>%
setView(lng = -100, lat = 40, zoom = 5),
leaflet( options = leafletOptions(minZoom = 3, maxZoom = 7, zoomControl = TRUE)) %>%
addProviderTiles("CartoDB.VoyagerNoLabels") %>%
setView(lng = -100, lat = 40, zoom = 5)
)
}) # end render map
# observe term for adding rasters
observe({
# get data
map_dat <- get(input$species) %>%
dplyr::select(x,y,
paste0("sample1.",input$year),
paste0("sample2.",input$year))
# rasterize
raster_1 <- rasterFromXYZ(map_dat[,c(1,2,3)],
crs = "+init=epsg:4326 +proj=longlat +ellps=WGS84 " )
raster_2 <- rasterFromXYZ(map_dat[,c(1,2,4)],
crs = "+init=epsg:4326 +proj=longlat +ellps=WGS84 ")
# set palette and data for raster object
pal <- map_pal$pal
# NOTE: this next line needs a name specified, but I don't know how to specify
# because "map" is the entire sync object, not the individual maps that are being synced,
# so I am not accurately telling Shiny which map to add which raster image to.
leafletProxy("map") %>%
clearImages() %>%
addRasterImage(raster_1, colors = pal, opacity = 0.7,
project=TRUE)
leafletProxy("map") %>%
clearImages() %>%
addRasterImage(raster_2, colors = pal, opacity = 0.7,
project=TRUE)
})
}
shinyApp(ui = ui, server = server)
There is now leaflet.extras2::addLeafletsync() which can do this. It isn't very well documented, but there are some examples here: https://github.com/trafficonese/leaflet.extras2/tree/master/inst/examples/leafletsync
Here's an even simpler example:
library(shiny)
library(leaflet)
library(leaflet.extras2)
ui <- fluidPage(
tags$head(
tags$style(HTML("
.map-container {
display: flex;
height: 400px;
gap: 10px;
}
.map-box {
flex: 1;
border: 1px solid #ccc;
border-radius: 4px;
}
"))
),
div(class = "map-container",
div(class = "map-box",
leafletOutput("map1")
),
div(class = "map-box",
leafletOutput("map2")
)
),
actionButton("add_markers", "Add markers")
)
server <- function(input, output, session){
output$map1 <- renderLeaflet({
leaflet() |>
addTiles() |>
setView(lng = 0, lat = 52, zoom = 6)
})
output$map2 <- renderLeaflet({
leaflet() |>
addTiles() |>
setView(lng = 0, lat = 52, zoom = 6)
})
leafletProxy("map1") |>
addLeafletsync(c("map1","map2"))
observeEvent(input$add_markers, {
for (m in c("map1","map2")){
lat <- runif(1, 51, 52)
lng <- runif(1, -1, 1)
leafletProxy(m) |>
addMarkers(lng = lng, lat = lat)
}
})
}
shinyApp(ui = ui, server = server)