光栅图像低于基础层，而标记保持高于 : xIndex is ignored

Question

我正在构建一个简单的 Shiny + Leaflet R 应用程序来导航 map ，在该 map 上有 raster (来自包 raster )与有用的 addRasterImage() 一起绘制功能。该代码主要基于 Leaflet 自己的示例。但是，我在分层时遇到了一些问题:每次重新加载图块时，光栅图像都会以某种方式呈现在图块下方，即使我设置了负值 zIndex .标记不会发生这种情况。请参阅随附的代码。示例输入文件 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 1

我也有这个问题，但你的问题是我能找到的唯一引用。

我能找到的唯一解决方法是在光栅观察器中重绘瓷砖，例如

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")
})