मैं एक नक्शा जिस पर एक 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)