如何显示带有栅格图层的并排地图？

Question

我尝试在一个闪亮的应用程序中显示地图，该应用程序与传单

addSidebyside()

功能并排显示两个 spatRaster。原则上这是有效的。但是，如果我想使用其他提供程序（例如正电子）更改背景地图，则不再显示光栅图像。如何获得具有两个并排重叠栅格的正电子底图？

这是一个表示（如果“addProviderTiles”行未注释，它将不起作用）。

library(shiny)
library(leaflet)
library(terra)
library(leaflet.extras)
library(leaflet.extras2)

ui <- fluidPage(
  leafletOutput("leafmap")
)
server <- function(input, output){

  nrow <- 499
  ncol <- 469
  nlyr <- 1
  resolution_x <- 0.002245788
  resolution_y <- 0.002245788
  xmin <- 16.93303
  xmax <- 17.9863
  ymin <- 47.75883
  ymax <- 48.87948
  
  # Create a SpatRaster object with the specified parameters
  r1 <- rast(nrows = nrow, ncols = ncol, nlyrs = nlyr,
            resolution = c(resolution_x, resolution_y),
            ext = ext(xmin, xmax, ymin, ymax),
            crs = "EPSG:4326")
  
  values(r1)<-matrix(runif(nrow * ncol, min = 0, max = 1), 
                     nrow = nrow, ncol = ncol)
  
  r2 <- rast(nrows = nrow, ncols = ncol, nlyrs = nlyr,
             resolution = c(resolution_x, resolution_y),
             ext = ext(xmin, xmax, ymin, ymax),
             crs = "EPSG:4326")
  values(r2)<-matrix(runif(nrow * ncol, min = 0, max = 1), 
                     nrow = nrow, ncol = ncol)

  
  bins <- c(0.25, 0.35, 0.5, 0.75, 1)
  colors <- c("#0000FF", "#00FFFF", "#FFFFFF", "#FF7F7F", "#FF0000")
  bins_cv<-c(0.25,0.5,0.75,1)
  colors_cv <- c("#00b344",
                 "#6ecc66", # Standard orange
                 "#a7e58c", # Light orange
                 "#d9ffb7"
  )
  
  
  labels <- c("","Low", "Moderate", "High", "Very High")
  labels_cv <- c("High","Intermediate","Moderate", "Low")
  color_palette <- colorBin(palette = colors, domain = values(r1), bins = bins, na.color = "transparent")
  color_palette_cv <- colorBin(palette = colors_cv, domain = values(r1), bins = bins_cv, na.color = "transparent")
  
  

  
  output$leafmap<-renderLeaflet(
    leaflet() %>% 
      #addProviderTiles(providers$CartoDB.Positron,group = "Positron")%>%
      addMapPane("right", zIndex = 1) %>% 
      addMapPane("left",  zIndex = 1) %>% 
      
      addTiles(group = "base", layerId = "baseid1", options = pathOptions(pane = "right")) %>%
      
      addTiles(group = "base", layerId = "baseid2", options = pathOptions(pane = "left")) %>% 

      addRasterImage(x = r1,colors = color_palette_cv, opacity = 0.8, options = leafletOptions(pane = "right"), group = "Random raster 1") %>% 
      addRasterImage(x = r2, colors = color_palette, opacity = 0.6, options = leafletOptions(pane = "left"), group = "Random raster 2") %>% 
 
      addSidebyside(layerId = "sidecontrols",
                    rightId = "baseid1",
                    leftId  = "baseid2")%>%
      addLegend(colors = colors_cv,bins = bins,labels = labels_cv, values = values(r1), title = "R1",
                position = "bottomright", group = "Raster 1") %>%
      addLegend(colors = colors, bins = bins, labels = labels, values = values(r2), title = "R2",
                position = "bottomleft", group = "Raster 2")
    
  )
  
 
  
}
shinyApp(ui = ui, server = server)

Answer 1

将您提供商的

urlTemplate

直接传递给

addTiles

，对于

CartoDB.Positron

，您可以使用

urlTemplate = "https://{s}.basemaps.cartocdn.com/light_all/{z}/{x}/{y}{r}.png"

。可以找到链接，例如这里。

library(shiny)
library(leaflet)
library(terra)
library(leaflet.extras)
library(leaflet.extras2)

ui <- fluidPage(
  leafletOutput("leafmap")
)

server <- function(input, output){
  
  nrow <- 499
  ncol <- 469
  nlyr <- 1
  resolution_x <- 0.002245788
  resolution_y <- 0.002245788
  xmin <- 16.93303
  xmax <- 17.9863
  ymin <- 47.75883
  ymax <- 48.87948
  
  # Create a SpatRaster object with the specified parameters
  r1 <- rast(nrows = nrow, ncols = ncol, nlyrs = nlyr,
             resolution = c(resolution_x, resolution_y),
             ext = ext(xmin, xmax, ymin, ymax),
             crs = "EPSG:4326")
  
  values(r1)<-matrix(runif(nrow * ncol, min = 0, max = 1), 
                     nrow = nrow, ncol = ncol)
  
  r2 <- rast(nrows = nrow, ncols = ncol, nlyrs = nlyr,
             resolution = c(resolution_x, resolution_y),
             ext = ext(xmin, xmax, ymin, ymax),
             crs = "EPSG:4326")
  values(r2)<-matrix(runif(nrow * ncol, min = 0, max = 1), 
                     nrow = nrow, ncol = ncol)
  
  
  bins <- c(0.25, 0.35, 0.5, 0.75, 1)
  colors <- c("#0000FF", "#00FFFF", "#FFFFFF", "#FF7F7F", "#FF0000")
  bins_cv<-c(0.25,0.5,0.75,1)
  colors_cv <- c("#00b344",
                 "#6ecc66", # Standard orange
                 "#a7e58c", # Light orange
                 "#d9ffb7"
  )
  
  
  labels <- c("","Low", "Moderate", "High", "Very High")
  labels_cv <- c("High","Intermediate","Moderate", "Low")
  color_palette <- colorBin(palette = colors, domain = values(r1), bins = bins, na.color = "transparent")
  color_palette_cv <- colorBin(palette = colors_cv, domain = values(r1), bins = bins_cv, na.color = "transparent")
  
  
  
  
  output$leafmap<-renderLeaflet(
    leaflet() %>% 
      addMapPane("right", zIndex = 1) %>% 
      addMapPane("left",  zIndex = 1) %>% 
      
      addTiles(urlTemplate = "https://{s}.basemaps.cartocdn.com/light_all/{z}/{x}/{y}{r}.png",
               group = "base", layerId = "baseid1", options = pathOptions(pane = "right")) %>%
      
      addTiles(urlTemplate = "https://{s}.basemaps.cartocdn.com/light_all/{z}/{x}/{y}{r}.png",
               group = "base", layerId = "baseid2", options = pathOptions(pane = "left")) %>% 
      
      addRasterImage(x = r1,colors = color_palette_cv, opacity = 0.8, options = leafletOptions(pane = "right"), group = "Random raster 1") %>% 
      addRasterImage(x = r2, colors = color_palette, opacity = 0.6, options = leafletOptions(pane = "left"), group = "Random raster 2") %>% 
      
      addSidebyside(layerId = "sidecontrols",
                    rightId = "baseid1",
                    leftId  = "baseid2")%>%
      addLegend(colors = colors_cv,bins = bins,labels = labels_cv, values = values(r1), title = "R1",
                position = "bottomright", group = "Raster 1") %>%
      addLegend(colors = colors, bins = bins, labels = labels, values = values(r2), title = "R2",
                position = "bottomleft", group = "Raster 2")
    
  )
  
}
shinyApp(ui = ui, server = server)