2015-12-08 14 views
5

मैं एक नक्शा जिस पर एक raster (पैकेज raster से) उपयोगी addRasterImage() समारोह के साथ साजिश रची है नेविगेट करने के लिए एक सरल चमकदार + पत्रक आर आवेदन का निर्माण कर रहा हूँ। कोड पत्रक के अपने उदाहरणों पर भारी आधारित है। हालांकि, मुझे लेयरिंग के साथ कुछ समस्याएं आ रही हैं: जब भी मैं नकारात्मक zIndex सेट करता हूं, तब भी जब भी मैं टाइल्स को फिर से लोड करता हूं, तब भी रास्टर छवि टाइल्स के नीचे प्रदान की जाती है। यह मार्करों के लिए नहीं होता है। संलग्न कोड देखें। उदाहरण इनपुट फ़ाइल here, 366 केबी।रेखापुंज छवि, बेस लेयर नीचे चला जाता है, जबकि मार्करों ऊपर रहने: xIndex नजरअंदाज कर दिया है

#### 
###### 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) 

उत्तर

3

मुझे भी यह समस्या है, लेकिन आपका प्रश्न ही इसका एकमात्र संदर्भ है जिसे मैं पा सकता हूं।

राक्षस पर्यवेक्षक में टाइल्स को फिर से निकालने का एकमात्र कामकाज उदा।

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") 
}) 
संबंधित मुद्दे