awesome - r leaflet weight

La imagen de trama va por debajo de la capa base, mientras que los marcadores permanecen arriba: xIndex se ignora

Question

Estoy construyendo una aplicación sencilla Shiny + Leaflet R para navegar por un mapa sobre el cual se traza un raster (desde el raster del paquete) con la útil función addRasterImage() . El código se basa en gran medida en los propios ejemplos de Leaflet. Sin embargo, estoy encontrando algunos problemas con la estratificación: la imagen ráster se muestra de alguna manera debajo de los mosaicos cada vez que recargo las teselas, incluso si configuro un zIndex negativo. Esto no sucede con los marcadores. Ver el código adjunto. Ejemplo de archivo de entrada aquí , 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

Yo también tengo este problema, pero tu pregunta es la única referencia que puedo encontrar.

La única solución alternativa que pude encontrar fue redibujar las teselas en el observador de la trama, por ejemplo

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