栅格图像位于基本层下方，而标记位于上方:xIndex被忽略 [英] Raster image goes below base layer, while markers stay above: xIndex is ignored

问题描述

我正在构建一个简单的Shiny + Leaflet R应用程序，以浏览地图，并在地图上使用有用的addRasterImage()函数绘制raster(来自包raster).该代码很大程度上基于Leaflet自己的示例.但是，我在分层时遇到了一些问题:即使重新设置了zIndex，每次重新加载图块时，栅格图像都会以某种方式渲染到图块下方.标记不会发生这种情况.请参阅随附的代码.输入文件示例此处，366KB.

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)

推荐答案

我也有这个问题，但是您的问题是我可以找到的唯一参考.

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

这篇关于栅格图像位于基本层下方，而标记位于上方:xIndex被忽略的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！