如何解决在闪亮的地图上一起使用 Leafsync 和 LeafletProxy
我正在尝试在 shiny 应用上显示两个同步地图，该应用显示基于输入物种和年份的两个不同样本中的物种密度。我使用 leafsync 让它工作，但没有设置为使用传单代理，所以每次我更改输入时，地图都会完全重置（即失去定位和缩放）。我希望能够改变物种和年份而不会失去我在地图上的位置。
我知道我需要使用 leafletProxy 在传单地图顶部添加光栅图像而无需重置，但我不确定如何使用 leafsync（否则，这可能是一项工作mapview 或 tmap），因为两个同步的地图共享一个名称。这是我尝试过的：
不使用 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,replace=T),sample1.2000 = runif(300,min=40,max = 250),sample2.2000 = runif(300,sample1.2001 = runif(300,min=10,max = 220),sample2.2001 = runif(300,sample1.2002 = runif(300,min=0,max = 200),sample2.2002 = runif(300,max = 200)
)
toad <- data.frame(x=sample(seq(from=-105,500,sample1.2000 = runif(500,min=100,max = 750),sample2.2000 = runif(500,sample1.2001 = runif(500,min=500,max = 900),sample2.2001 = runif(500,max = 600),sample1.2002 = runif(500,min=300,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"
),),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[,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,zoomControl = TRUE)) %>%
addProviderTiles("CartoDB.VoyagerNoLabels") %>%
addRasterImage(raster_2,opacity = 1
) %>%
addControl("<b>Sample 2</b>",position = "topright")
)
}) # end render map
}
shinyApp(ui = ui,server = server)
和非工作版本设置为使用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,max = 200)
)
toad <- data.frame(x=sample(seq(from=-105,max = 600)
)
ui <-
fluidPage(
fluidRow(
box(width = 12,radioGroupButtons(
inputId = "species",status="primary"
),sep="")
),fluidRow(
uiOutput('map',height = "150vh")
)
)
server <- function(input,output) {
# set limits for scales,# highest toad density is 1000
)
})
# create a color palette for the map
map_pal <- reactiveValues()
observe({
map_pal$pal <- colorNumeric(palette = "plasma",reverse=F)
})
output$map <- renderUI({
# add blank leaflet map
sync(
leaflet( options = leafletOptions(minZoom = 3,zoomControl = TRUE)) %>%
addProviderTiles("CartoDB.VoyagerNoLabels") %>%
setView(lng = -100,lat = 40,zoom = 5),leaflet( options = leafletOptions(minZoom = 3,zoom = 5)
)
}) # end render map
# observe term for adding rasters
observe({
# get data
map_dat <- get(input$species) %>%
dplyr::select(x,input$year))
# rasterize
raster_1 <- rasterFromXYZ(map_dat[,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,project=TRUE)
leafletProxy("map") %>%
clearImages() %>%
addRasterImage(raster_2,project=TRUE)
})
}
shinyApp(ui = ui,server = server)
谢谢！
版权声明：本文内容由互联网用户自发贡献，该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容， 请发送邮件至 dio@foxmail.com 举报，一经查实，本站将立刻删除。
