I'm trying to show two synced maps on a shiny app that show densities of species in two different samples based on inputs species and year. I have it working using leafsync, but not set up to use leaflet proxies, so every time I change an input, the maps completely reset (i.e. lose positioning and zoom). I want to be able to change species and year without losing my place on the map.
I know that I need to use leafletProxy to add raster images on top of leaflet maps without resetting, but I am unsure how to do this using leafsync (or otherwise, this may be a job for mapview or tmap), since the two synced maps share one name. Here's what I've tried:
working version NOT using leafletProxy:
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 color scale, 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)
})
# make map using renderUI and leafsync
output$map <- renderUI({
# pull correct columns for correct species
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 ")
# start leafsync
sync(
# map 1 -------------
leaflet( options = leafletOptions(minZoom = 3, maxZoom = 7, zoomControl = TRUE)) %>%
addProviderTiles("CartoDB.VoyagerNoLabels") %>%
addRasterImage(raster_1, opacity = 0.7, colors = map_pal$pal,
project=TRUE) %>%
addLegend(position = "bottomright",
pal = map_pal$pal,
values = spp_lim(),
title = paste0(stringr::str_to_title(input$species)," density"),
opacity = 1
) %>%
addControl("<b>Sample 1</b>", position = "topright"),
# map 2 ------------
leaflet( options = leafletOptions(minZoom = 3, maxZoom = 7, zoomControl = TRUE)) %>%
addProviderTiles("CartoDB.VoyagerNoLabels") %>%
addRasterImage(raster_2, opacity = 0.7, colors = map_pal$pal,
project=TRUE) %>%
addLegend(position = "bottomright",
pal = map_pal$pal,
values = spp_lim(),
title = paste0(stringr::str_to_title(input$species)," density"),
opacity = 1
) %>%
addControl("<b>Sample 2</b>", position = "topright")
)
}) # end render map
}
shinyApp(ui = ui, server = server)
And non working version set up to use leafletProxy:
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)
Thanks!
