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:LonLatValue
")
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("", x, "", y, "", val, "
")
}
})
}
## RUN:
shinyApp(ui, server)
See Question&Answers more detail:
os