AF7 AF7 - 16 days ago 4
R Question

Raster image goes below base layer, while markers stay above: xIndex is ignored

I'm building a simple Shiny + Leaflet R application to navigate a map over which a

raster
(from package
raster
) is plotted with the useful
addRasterImage()
function. The code is heavily based on Leaflet's own examples. However, I'm encountering some problems with layering: the raster image is somehow rendered below the tiles every time I reload the tiles, even if I set a negative
zIndex
. This does not happen for markers. See the attached code. Example input file here, 366KB.

####
###### YOU CAN SKIP THIS, THE PROBLEM LIES BELOW ######
####

library(shiny)
library(leaflet)
library(RColorBrewer)
library(raster)

selrange <- function(r, min, max) { #Very fast way of selecting raster range, even faster than clamp.
#http://stackoverflow.com/questions/34064738/fastest-way-to-select-a-valid-range-for-raster-data
rr <- r[]
rr[rr < min | rr > max] <- NA
r[] <- rr
r
}

llflood <- raster("example_flooding_posmall.nc")
ext <- extent(llflood)
flood <- projectRasterForLeaflet(llflood)
floodmin <- cellStats(flood, min)
floodmax <- cellStats(flood, max)

tiles <- c("Hydda.Base",
"Hydda.Full",
"Esri.WorldImagery",
"Esri.WorldTopoMap"
)

ui <- bootstrapPage(
tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
leafletOutput("map", width = "100%", height = "100%"),
absolutePanel(top = 10, right = 10,
sliderInput("range", "Return Period (years)", floor(floodmin), ceiling(floodmax),
value = c(floor(floodmin), ceiling(floodmax)), step = 1
),
selectInput("colors", "Color Scheme",
rownames(subset(brewer.pal.info, category %in% c("seq", "div")))
),
selectInput("tiles", "Background",
tiles
),
checkboxInput("legend", "Show legend", TRUE))
)

server <- function(input, output, session) {

# Reactive expression for the data subsetted to what the user selected
filteredData <- reactive({
selrange(flood, input$range[1], input$range[2])
})

# This reactive expression represents the palette function,
# which changes as the user makes selections in UI.
colorpal <- reactive({
colorNumeric(input$colors, values(filteredData()), na.color = NA)
})

######
###### THE INTERESTING PART IS HERE ######
######

output$map <- renderLeaflet({
# Use leaflet() here, and only include aspects of the map that
# won't need to change dynamically (at least, not unless the
# entire map is being torn down and recreated).
leaflet() %>%
fitBounds(ext[1], ext[3], ext[2], ext[4])
})

observe({ #Observer to edit tiles
selectedTiles <- input$tiles
leafletProxy("map") %>%
clearTiles() %>%
addProviderTiles(selectedTiles, providerTileOptions(zIndex=-10, continuousWorld=FALSE), group="base")
})

observe({ #Observer to edit colors and valid range
filtdata <- filteredData()
pal <- colorpal()
leafletProxy("map") %>%
clearImages() %>%
addRasterImage(filtdata, opacity=0.7, project=FALSE, colors=pal, group="overlay") %>%
addMarkers(lng=8.380508, lat=45.18058, popup="This marker stays above, the raster sinks below every time I load a new tile set")
})

######
###### THE INTERESTING PART ENDS HERE ######
######

observe({ #Observer to show or hide the legend
inputlegend <- input$legend
proxy <- leafletProxy("map")
# Remove any existing legend, and only if the legend is
# enabled, create a new one.
proxy %>% clearControls()
if (inputlegend) {
pal <- colorpal()
proxy %>% addLegend(position = "bottomright",
pal = pal, values = values(filteredData()), opacity=1
)
}
})

cat("Clicked point:\tLon\t\tLat\t\tValue\n")
observe({ #Observe to show clicked points
x = as.double(unlist(input$map_click)[2])
if(!is.null(x)) {
y = unlist(input$map_click)[1]
val = extract(llflood, cellFromXY(llflood, c(x, y)))
if (!is.na(val)) cat("\t\t", x, "\t", y, "\t", val, "\n")
}
})

}

## RUN:
shinyApp(ui, server)

Answer

I too have this problem, but your question is the only reference to it I can find.

The only workaround I could find was to also redraw the tiles in the raster observer e.g.

observe({ #Observer to edit colors and valid range
  selectedTiles <- input$tiles
  filtdata <- filteredData()
  pal <- colorpal()
  leafletProxy("map") %>%
  clearTiles() %>%
  addProviderTiles(selectedTiles, providerTileOptions(zIndex=-10, continuousWorld=FALSE), group="base")
  clearImages() %>%
  addRasterImage(filtdata, opacity=0.7, project=FALSE, colors=pal, group="overlay") %>%
  addMarkers(lng=8.380508, lat=45.18058, popup="This marker stays above, the raster sinks below every time I load a new tile set")
})
Comments