I am plotting a large lat-lon NetCDF raster over an R leaflet map using shinydashboard. When I click on the map, a popup comes out and shows row, column, lat-lon position and value of the clicked raster point. (See reproducible code below)
The problem is that I am experiencing a shift in the raster if the raster is large enough. For example, here I clicked on a point which should have a value, but the result is that the identified point is the one above.
I believe this has to do with the fact that the raster used by leaflet is projected, while the raw data I use to identify the points is Lat-Lon, since the clicked point is returned as Lat-Lon by leaflet. I cannot use the projected file (depth) since its units are in meters, not degrees!
Even if I tried to reproject those meters to degrees, I got a shift.
Here is a basic runnable example of the code:
#Libraries
library(leaflet)
library(raster)
library(shinydashboard)
library(shiny)
#Input data
download.file("https://www.dropbox.com/s/y9ekjod2pt09rvv/test.nc?dl=0", destfile="test.nc")
inputFile = "test.nc"
inputVarName = "Depth"
lldepth <- raster(inputFile, varname=inputVarName)
lldepth[Which(lldepth<=0, cells=T)] <- NA #Set all cells <=0 to NA
ext <- extent(lldepth)
resol <- res(lldepth)
projection(lldepth) <- "+proj=longlat +datum=WGS84 +ellps=WGS84 +towgs84=0,0,0"
#Project for leaflet
depth <- projectRasterForLeaflet(lldepth)
#Prepare UI
sbwidth=200
sidebar <- dashboardSidebar(width=sbwidth)
body <- dashboardBody(
box( #https://stackoverflow.com/questions/31278938/how-can-i-make-my-shiny-leafletoutput-have-height-100-while-inside-a-navbarpa
div(class="outer",width = NULL, solidHeader = TRUE, tags$style(type = "text/css", paste0(".outer {position: fixed; top: 50px; left: ", sbwidth, "px; right: 0; bottom: 0px; overflow: hidden; padding: 0}")),
leafletOutput("map", width = "100%", height = "100%")
)
)
)
ui <- dashboardPage(
dashboardHeader(title = "A title"),
sidebar,
body
)
#
#Server instance
server <- function(input, output, session) {
output$map <- renderLeaflet({#Set extent
leaflet() %>%
fitBounds(ext[1], ext[3], ext[2], ext[4])
})
observe({#Observer to show Popups on click
click <- input$map_click
if (!is.null(click)) {
showpos(x=click$lng, y=click$lat)
}
})
showpos <- function(x=NULL, y=NULL) {#Show popup on clicks
#Translate Lat-Lon to cell number using the unprojected raster
#This is because the projected raster is not in degrees, we cannot use it!
cell <- cellFromXY(lldepth, c(x, y))
if (!is.na(cell)) {#If the click is inside the raster...
xy <- xyFromCell(lldepth, cell) #Get the center of the cell
x <- xy[1]
y <- xy[2]
#Get row and column, to print later
rc <- rowColFromCell(lldepth, cell)
#Get value of the given cell
val = depth[cell]
content <- paste0("X=",rc[2],
"; Y=",rc[1],
"; Lon=", round(x, 5),
"; Lat=", round(y, 5),
"; Depth=", round(val, 1), " m")
proxy <- leafletProxy("map")
#add Popup
proxy %>% clearPopups() %>% addPopups(x, y, popup = content)
#add rectangles for testing
proxy %>% clearShapes() %>% addRectangles(x-resol[1]/2, y-resol[2]/2, x+resol[1]/2, y+resol[2]/2)
}
}
#Plot the raster
leafletProxy("map") %>%
addRasterImage(depth, opacity=0.8, project=FALSE, group="Example", layerId="Example", colors=colorNumeric(terrain.colors(10), values(depth), na.color = "black"))
}
print(shinyApp(ui, server))
How can I correctly identify the points, if the raster is large?
EDIT:
I also wanted to provide some additional links to (possibly) related documentation or questions:
Raster image seems to be shifted using leaflet for R
R for leaflet redirect when clicking on raster image
https://gis.stackexchange.com/questions/183918/is-it-possible-to-use-a-rasterclick-event-within-an-interactive-leaflet-map
marker mouse click event in R leaflet for shiny
I have found that I can reproject back the X-Y (lon-lat) position given by input$map_click.
In this case I assumed the input projection to be Lon-Lat, but I think it doesn't necessarily have to be. It just needs to have Lat-Lon units.
#Set projections
inputProj <- "+proj=longlat +datum=WGS84 +ellps=WGS84 +towgs84=0,0,0"
leafletProj <- "+proj=merc +lon_0=0 +k=1 +x_0=0 +y_0=0 +a=6378137 +b=6378137 +towgs84=0,0,0,0,0,0,0 +units=m +nadgrids=#null +wktext +no_defs"
#Note that for some reason "+nadgrids=#null +wktext" is very important
#as hinted to by other questions and answers linked in my question.
xy <- SpatialPoints(data.frame(x,y))
proj4string(xy) <- inputProj
xy <- as.data.frame(spTransform(xy, leafletProj))
#Get the cell number from the newly transformed metric X and Y.
cell <- cellFromXY(depth, c(xy$x, xy$y))
#At this point, you can also retrace back the center of the cell in
#leaflet coordinates, starting from the cell number!
xy <- SpatialPoints(xyFromCell(depth, cell))
proj4string(xy) <- leafletProj
xy <- as.data.frame(spTransform(xy, inputProj))
#Here XY will again be in lat-lon, if you projection says so,
#indicating the center of the clicked cell
Related
Some context: I want to use the layerId (as row index) from the marker a click on the leaflet map to extract another value from a data frame. The data frame is "def_veh" and has columns named "ID_Fahrzeug" and "Postleitzahl".
So I set the layerId of my markers equal to ID_Fahrzeug, so that when I observe a click on a marker the event$id returns me the value of "ID_Fahrzeug" for this marker as a character.
In the showPopup function, I would like to use this returned value to extract the value from the data frame "def_veh" that is located in the column "Postleitzahl" in the same row as the event$id value in the column "ID_Fahrzeug".
I want then to store this extracted value in the variable "codepost" to use it as input for a following function used to plot a chart.
Here is a code sample of what I tried to explain in words:
#map function
output$map <- renderLeaflet({
leaflet(def_veh) %>% #creates a map based on the coordinates of damages
addTiles() %>%
addMarkers(lng= ~Laengengrad, lat = ~Breitengrad, clusterOptions = markerClusterOptions(), layerId= ~ID_Fahrzeug) %>% #creates cluster markers to groups the points on the map where a damage occurred
setView(lng = 11.107353, lat = 50 , zoom = 7) #fits the map's boundaries on Germany (more or less)
})
# When map is clicked, show a popup with city info
showPopup <- function(id_veh, Breitengrad_OEM, Laengengrad_OEM) {
codeposte <- def_veh[def_veh$ID_Fahrzeug==id_veh,"Postleitzahl"]
Plot <- Plot_Bar_Cart(codeposte)
svg(filename= paste(folder,"plot.svg", sep = "/"),
width = 500 * 0.005, height = 300 * 0.005)
print(Plot)
dev.off()
content <- paste(popup_content,readLines(paste(folder,"plot.svg",sep="/")), collapse = "")
leafletProxy("map") %>% addPopups(Laengengrad_OEM, Breitengrad_OEM, content, layerId = ID_Fahrzeug)
}
observe({
leafletProxy("map") %>% clearPopups()
event <- input$map_marker_click
if (is.null(event))
return()
isolate({
showPopup(event$id, event$lat, event$lng)
})
})
The problem is now, that when I run my shinyApp and click on a marker on the map, the windows closes by itself... This is the error message that appears: "Error in base::try(showPopup, silent = TRUE) :
object 'showPopup' not found"
Can someone help me to locate the problem? :)
I have a global database of grid ID, lat and long at 100-km resolution and associated
data for each 100-km grid. Something like this
grid_ID Lat Lon data1 data2 data3 ... data4
I want to develop a shiny app that allows the user to:
click anywhere on the map
return corresponding lat and lon
based on the returned lat and lon, find which 100-km grid does it fall into
show the data associated with that 100-km grid as a pop-up window or as a table (either will do)
library(shiny)
library(leaflet)
library(shinythemes)
ui <- fluidPage(theme = shinytheme('superhero'),
leafletOutput("map"),
verbatimTextOutput("out")
)
server <- function(input, output, session) {
output$map <- renderLeaflet({
leaflet() %>% addProviderTiles('Esri.WorldImagery')
})
output$out <- renderPrint({
validate(need(input$map_click, FALSE))
str(input$map_click)
})
}
shinyApp(ui, server)
This is now returning lat and long of the location that I clicked on which is my
step 1 and 2. How do I go about doing step 3 and 4. For step 3, usually if it was not an shiny app, I would do
coordinates(dat) <- ~ Longitude + Latitude
proj4string(dat) <- "+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0"
GRID <- over(dat, grid_shp)
where grid_shp is my global 100-km grid shapefile and dat has the returned lat lon from the click.
Probably not the most elegant solution and also not sure if it's in leaflet for R, but you could define each grid rectangle as a polygon, loop through the polygons and do if(Polygon.getBounds().contains(LatLng) == true); then you know which grid square you're in. Then return the feature properties of the grid square aka polygon object.
I assume your dataset is called "data". You have to find the grid which intersects with the coordinates of the click.
library(shiny)
library(leaflet)
library(shinythemes)
ui <- fluidPage(theme = shinytheme('superhero'),
leafletOutput("map"),
verbatimTextOutput("out"))
server <- function(input, output, session) {
output$map <- renderLeaflet({
leaflet() %>% addProviderTiles('Esri.WorldImagery')
})
output$out <- renderPrint({
validate(need(input$map_click, FALSE))
str(input$map_click)
# create a dataframe from the clicked point
xy <-
data.frame(longitude = input$map_click$lng,
latitude = input$map_click$lat)
# transform this dataframe to spatialpointsdataframe
spdf <-
SpatialPointsDataFrame(
coords = xy,
data = xy,
proj4string = CRS("+proj=longlat +datum=WGS84 +no_defs")
)
# find the grid that intersects with the point
selected_raster <- spdf %over% data
# here you will see the information you need
as.data.frame(selected_raster)
})
}
shinyApp(ui, server)
I have a map that I generate using Leaflet in an R/Shiny app, and am able to listen to event clicks on points on the map using code like this
observeEvent(input$map_marker_click, {
p = input$map_marker_click
p1 = filteredData()[filteredData()$Longitude == p$lng & filteredData()$Latitude == p$lat),]
if(p$id != 'Selected') {
//do stuff
}
output$ggplot = renderPlot({
//change plot based on selected point
})
}
But I'm wondering if it's possible to allow a user to select multiple points at once -- perhaps by shift-select or some other way. Would I need to somehow add a listener to see if they are holding down SHIFT, and then pass along a vector of clicked points?
EDIT:
I found an example that shows how to use MapEdit with selectFeatures to multi-select points on a leaflet map and then "do something" with the selection.
Here's the code sample along (taken from: https://gis.stackexchange.com/questions/253483/leaflet-tool-for-multiple-marker-selection-and-computation-of-summary)...:
# devtools::install_github("r-spatial/mapedit")
library(sf) # for spatial data type representation
library(mapview) # for the raster data and quick viewing
library(mapedit) # for the interaction (selection of the data)
# create the base map with a raster layer
m = mapview(poppendorf[[5]])
# create some mock data points in the vicinity of the raster layer
set.seed(42) # to be reproducible
dframe = data.frame(a = 1:50,
b = rnorm(50, 2, 1),
x = runif(50, 11.15, 11.25),
y = runif(50, 49.7, 49.75))
# convert data.frame to sf object as we need
# geo-spatial data type for this kind of objective
# epsg 4326 is geographic longlat 'projection'
dframe_sf = st_as_sf(dframe, coords = c("x", "y"), crs = 4326)
# inspect data on base map
mapview(dframe_sf, map = m)
# select features via polygon/rectangle/line/point or the like
# by using the draw tools of the draw toolbar on the left
# and press "Done" when finished.
# multiple selections are also possible.
# (line/point selection will not work as points have no dimension!)
# mode = "click" will enable selection via clicking on features.
selected = selectFeatures(dframe_sf, map = m, mode = "draw")
# check the selection (selected will be diplayed in blue)
mapview(dframe_sf, map = m, col.regions = "red") + selected
# given that selected is a sf object (and hence a data.frame)
# claculating summaries works just as expected with a normal data.frame
summary(selected)
mean(selected$a)
mean(selected$b)
sd(selected$b)
# we can also set other selection criteria. e.g. invert selection via st_disjoint
diff_selected = selectFeatures(dframe_sf, map = m, mode = "draw", op = st_disjoint)
# check the selection (selected will be diplayed in blue)
mapview(dframe_sf, map = m, col.regions = "red") + diff_selected
I understand that the following line is responsible for taking the SF dataframe and allowing us to select points on the map:
selected = selectFeatures(dframe_sf, map = m, mode = "draw")
My question is this -- how do I get it to render that same view but in Shiny, as opposed to my R console?
In Shiny, we have to wrap the leaflet map in the renderLeaflet function...
If I were doing it without Shiny, I could just do something like this:
m = leaflet(data = df) %>%
addCircleMarkers() %>%
addLegend...
selected = selectFeatures(dframe_benthic_sf, map = m, mode = "click")
Good afternoon everyone, I think a screenshot will tell better than words:
I would like a real marker instead of what is actually printed...
Here is the corresponding server.R part of the code (where fixed_points is a nrow(fixed_points) x 2 matrix with lat/lon coordinates
library(shiny); library(rCharts); library(leaflet)
output$baseMap <- renderMap({
baseMap <- Leaflet$new()
baseMap$setView(c(lng = 2.812500, lat = 46.732331), zoom = 6)
baseMap$tileLayer(provider = "Stamen.TonerLite")
for (i in 1:nrow(fixed_points)) {baseMap$marker(c(fixed_points[i, "lat"], fixed_points[i, "lon"]))}
baseMap$fullScreen(TRUE)
baseMap
})
and the ui.R
showOutput("baseMap", "leaflet") // or chartOuput(...), it works the same
Thanks in advance!
I am making an R Shiny app where users will enter their city, state, and zip code, press a button, and then their location (Lat, Lon) will become the new center of the map. The inputs are collected via this section of code in the server.R:
output$ntextCounter <- eventReactive(input$goButton, {
citySelected <- as.character(input$city)
stateSelected <- as.character(input$state)
zipCodeSelected <- as.character(input$zipCode)
location2 <- stri_detect(paste(as.character(input$city),
as.character(input$state), as.character(input$zipCode), sep=", "), fixed = locationData$Location, opts_regex=stri_opts_regex(case_insensitive=TRUE))
counter <<- counter + 1
lat1 <- as.numeric(locationData[which(location2),]$latitude)
lon1 <- as.numeric(locationData[which(location2),]$longitude)
return(c(lat1, lon1))
})
I am able to easily view the new latitude/longitude values in the UI using:
verbatimTextOutput("ntextCounter")
But I need to be able to pass these values, "return(c(lat1, lon1))", to the center = c(Lat, Lon) in the leaflet map in the ui.r:
leafletMap("map", "100%", 365,
initialTileLayer = "http://{s}.tile.openstreetmap.org/{z}/{x}/{y}.png",
initialTileLayerAttribution = HTML('© OpenStreetMap contributors, CC-BY-SA'),
options=list(center = c(38.25, -93.85), zoom = 4, maxBounds = list(list(1, -180), list(78, 180))
)),
I have an initial map center at c(38.25, -93.85), but ultimately I want to be able to pass it changing values from ntextCounter. I'm not sure if this is a scoping issue or what but I need help getting the new lat/lon values into the leaflet map center.
Any assistance would be greatly appreciated. Thanks in advance.
It seems you are creating your leaflet on the ui-side. If you want it to be responsive to inputs you've got to do that on the server side with renderLeaflet.
Your coordinates could be stored in a reactiveValues and you'd update them with a observeEvent:
location <- reactiveValues(lat = 38.25, lon = -93.85)
observeEvent(input$goButton, {
city <- as.character(input$city)
state <- as.character(input$state)
zipCode <- as.character(input$zipCode)
newloc <- stri_detect(paste(city, state, zipCode, sep=", "),
fixed = locationData$Location,
opts_regex=stri_opts_regex(case_insensitive=TRUE))
location$lat <- as.numeric(locationData[which(newloc),]$latitude)
location$lon <- as.numeric(locationData[which(newloc),]$longitude)
})