我正在构建一个简单的Shiny + Leaflet R应用程序来导航一个Map，在这个Map上用有用的addRasterImage()函数绘制了一个raster（来自raster包）。代码主要基于Leaflet自己的示例。但是，我遇到了一些分层问题：每次我重新加载瓦片时，光栅图像不知何故被渲染在瓦片之下，即使我设置了一个负的zIndex。2标记不会发生这种情况。3参见所附代码。4示例输入文件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)