rshinyr-rasterr-leaflet

How to display a side-by-side map with raster layers?

I try to display a map in a shiny app that displays two spatRaster side by side with the leaflet addSidebyside() function. In principal this works. However, if I want to change the background map using another provider (e.g. positron), the raster images are not displayed anymore. How can I get a positron base map with two overlaying raster side by side?

Here is a reprex (if the "addProviderTiles" line is uncommented, it won't work).

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)
Solution

  • Pass the urlTemplate of your provider directly to addTiles, for CartoDB.Positron you can use urlTemplate = "https://{s}.basemaps.cartocdn.com/light_all/{z}/{x}/{y}{r}.png". The links can be found e.g. here.

    enter image description here

    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)