Here's what I tried
server <- function(input, output) {
observe({
output$mymap <- renderLeaflet({
leaflet() %>%
addTiles() %>%
fitBounds(-124.7666, 49.4000, -67.0583, 25.0666)%>%
setView(-95.91245, 37.2333, zoom = 3)
})
click = input$mymap_click
if(is.null(click))
return()
leafletProxy('mymap')%>%addMarkers(lng = click$lng,
lat = click$lat)%>%
setView(lng = click$lng,
lat = click$lat, zoom =7)
output$text <- renderText(paste(click$lng,click$lat))
})
}
ui <- fluidPage(textOutput("text"),
leafletOutput("mymap"))
shinyApp(ui = ui, server = server)
But instead of a reactive output text, I want something which is dynamic i.e., map should change with change in lat, lon value and vice versa
Here's a sample representation from https://psl.noaa.gov/eddi/
If what you want is for the map to center on the clicked marker, move the lines from click = ... to setView in its own observeEvent(). Also, you do not need to wrap everything in an observe().
server <- function {
output$mapmap <- renderLeaflet(...)
observeEvent(input$mymap_click) {
click = ...
...
leafletProxy(...) %>%
setView(...)
}
output$text <- renderText(...)
}
Related
I'm using addFlows() to add some flow data to a leaflet map in Shiny.
What I need it to do is emit the layerId when the appropriate line is clicked, so that I can display some information to the user in a sidebar. How can I trigger a click event?
I know that with polylines or polygons I can use observeEvent(input$map_shape_click, {}), but I'm not sure of the addFlows variant of this. I can't use addPolylines() instead because I need the arrow heads as representative of direction.
Reproducible code (with non-working click event):
library(shiny)
library(leaflet)
library(leaflet.minicharts)
library(tidyverse)
dat <- data.frame(
Line_no = c("line1", "line2"),
Origin_lat = c(40.15212, 40.65027),
Origin_lng = c(-74.79037, -74.91990),
Dest_lat = c(40.78749, 40.78749),
Dest_lng = c(-73.96188, -73.96188),
flow = c(237, 84)
)
ui <- fluidPage(
leafletOutput("map", height=800)
)
server <- function(input, output, session) {
output$map <- renderLeaflet({
leaflet() %>%
addProviderTiles(provider = providers$Esri.WorldImagery) %>%
setView(lat = 40.39650, lng = -74.39541, zoom = 9)
})
observe({
leafletProxy("map") %>%
addFlows(
layerId = dat$Line_no,
lng0 = dat$Origin_lng,
lat0 = dat$Origin_lat,
lng1 = dat$Dest_lng,
lat1 = dat$Dest_lat,
flow = dat$flow
)
})
observeEvent(input$map_shape_click, {
glimpse("Clicked!")
})
}
shinyApp(ui, server)
I would like to automatically detect which polygon is at the center of the map. And it should update dynamically when the user is moving through the map.
For the moment I could not find a way to reverse find on which polygon are some coordinates.
I think I could simulate a input$map_shape_click with shinyjs or javascript and so get input$map_shape_click$id, but before I go to this solution, I would like to make sure there is no other way.
Here is a minimal example
library(leaflet)
library(shiny)
# data source : https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_FRA_2_sp.rds
cities <- readRDS(file = "../gadm36_FRA_2_sf.rds")
ui <- fluidPage(leafletOutput("map"))
server <- function(input, output, session) {
rv <- reactiveValues()
output$map <- renderLeaflet({
leaflet() %>%
addProviderTiles(provider = providers$CartoDB.Positron) %>%
setView(lng = 1, lat = 45, zoom = 8) %>%
addPolygons(data = cities,layerId = ~NAME_2,label = ~NAME_2)
})
observeEvent(input$map_bounds,{
rv$center <- c(mean(input$map_bounds$north, input$map_bounds$south), mean(input$map_bounds$east, input$map_bounds$west))
# how can I detect on which polygon the center is ?
})
}
shinyApp(ui = ui, server = server)
library(leaflet)
library(shiny)
library(sf)
cities <- readRDS(file = "gadm36_FRA_2_sp.rds") %>%
st_as_sf()
ui <- fluidPage(leafletOutput("map"))
server <- function(input, output, session) {
rv <- reactiveValues()
output$map <- renderLeaflet({
leaflet() %>%
addProviderTiles(provider = providers$CartoDB.Positron) %>%
setView(lng = 1, lat = 45, zoom = 8) %>%
addPolygons(data = cities, layerId = ~NAME_2, label = ~NAME_2)
})
observeEvent(input$map_bounds, {
rv$center <- c(mean(input$map_bounds$north, input$map_bounds$south), mean(input$map_bounds$east,
input$map_bounds$west))
pnt <- st_point(c(rv$center[2], rv$center[1]))
rslt <- cities[which(st_intersects(pnt, cities, sparse = FALSE)),]$NAME_1
print(rslt)
})
}
shinyApp(ui = ui, server = server)
So I found a way to do it with the function sf::st_intersects
observeEvent(input$map_bounds,{
rv$center <- data.frame(x = mean(c(input$map_bounds$north, input$map_bounds$south)),
y = mean(c(input$map_bounds$east, input$map_bounds$west)))
res <- sf::st_as_sf(rv$center, coords=c("y","x"), crs=st_crs(cities$geometry))
intersection <- as.integer(st_intersects(res, cities$geometry))
print(if_else(is.na(intersection), '', cities$NAME_2[intersection]))
})
Using a Easybutton, I created a button in a Shiny-Leaflet environment, which zooms and pans the map to the user's geolocated position. An working example:
library(shiny)
library(leaflet)
ui <- fluidPage(leafletOutput("map"))
server <- function(input, output, session) {
output$map <- renderLeaflet({
leaflet() %>%
addProviderTiles(providers$Stamen.TonerLite,
options = providerTileOptions(noWrap = TRUE)) %>%
addEasyButton(
easyButton(
position = "topleft",
icon = "fa-crosshairs",
title = "Locate Me",
onClick = JS(
c(
"function(btn, map){map.locate({setView:true,enableHighAccuracy: true })}"
)
)
)
)
})
}
shinyApp(ui,server)
This works fine. However, I want to capture the lat/long of the user's geolocated position into a input variable. This functionality exists for a mouse click on the map, in which case the lat/long of the clicked position is stored in 'input$map_click'. Does anyone have an idea?
As a starting point you could observe the map bounds changing, and return the centre of the bounds
library(shiny)
library(leaflet)
ui <- fluidPage(leafletOutput("map"))
server <- function(input, output, session) {
output$map <- renderLeaflet({
leaflet() %>%
addProviderTiles(providers$Stamen.TonerLite,
options = providerTileOptions(noWrap = TRUE)) %>%
addEasyButton(
easyButton(
position = "topleft",
icon = "fa-crosshairs",
title = "Locate Me",
onClick = JS(
c(
"function(btn, map){map.locate({setView:true,enableHighAccuracy: true })}"
)
)
)
)
})
observeEvent(input$map_bounds, {
event <- input$map_bounds
lat <- mean(event$north, event$south)
lon <- mean(event$west, event$east)
print(paste0("map center - lat: ", lat, ", lon: ", lon))
})
}
shinyApp(ui,server)
However, you'll get the coordinates everytime the map is panned. You could maybe work this into being observed only when the button is pressed, although at the moment I'm not sure how to do that.
I found another opportunity myself, by following these procedures and adding JavaScript logic.
http://www.r-graph-gallery.com/2017/03/14/4-tricks-for-working-with-r-leaflet-and-shiny/
Inserting popups in addCirclemarkers caused lengthy calculation time for data of thousands of points to be mapped. I am assuming all popups have to be calculated before showing the map.
I searched online for a way to only add/create the popup if a point/circle/marker is clicked. Currently, I am at the below code. If you run this code, you will see that the popup is created, but the string to extract from the data is not shown. What am I doing wrong?
library(shiny)
library(leaflet)
library(htmltools)
library(sp)
data <- data.frame(
"name"=c("Place 1","Place 2","Place 3"),
"lat"=c(50,51,52),
"lng"=c(3,4,5), stringsAsFactors = FALSE)
ui = fluidPage(
fluidRow(column(8, offset = 2, leafletOutput("map", width = "100%", height = "650px")))
)
server = function(input, output, session) {
pts <- reactive({
pts <- data
coordinates(pts) <- ~lng+lat
pts
})
output$map <- renderLeaflet({
leaflet(pts()) %>%
addTiles(group="OSM") %>%
addCircleMarkers()
})
observeEvent(input$map_marker_click, {
leafletProxy("map") %>% clearPopups()
event <- input$map_marker_click
if (is.null(event))
return()
isolate({
pts2 <- pts()
sgh <- pts2[row.names(pts2) == event$id,]
# sgh <- pts2[pts2$name == event$id,]
content <- htmlEscape(paste("This place is",as.character(sgh$name)))
leafletProxy("map") %>% addPopups(event$lng, event$lat, content, layerId = event$id)
})
})
}
shinyApp(ui = ui, server = server, options = list(launch.browser=TRUE))
With you code event$id is NULL, so the sgh <- pts2[row.names(pts2) == event$id,] line return NULL as well.
You have to add the layerId to the CircleMarkers (and is not necessary to add it to the Popup.
This also let access it wothout needing to 'merge' it with the original data:
output$map <- renderLeaflet({
leaflet(pts()) %>%
addTiles(group="OSM") %>%
addCircleMarkers(layerId = ~name)
})
observeEvent(input$map_marker_click, {
leafletProxy("map") %>%
clearPopups()
event <- input$map_marker_click
if (is.null(event))
return()
isolate({
content <- htmlEscape(paste("This place is", event$id))
leafletProxy("map") %>%
addPopups(event$lng, event$lat, content)
})
})
I have a shiny app, where I want to plot CircleMarkers on a leaflet map. Additionally a marker should be plotted, controlled over an overlayGroup. When the zoom level is greater than 7 the marker should be plotted otherwise not. This is done by sending code to the server and getting the index of the marker. See also here: Show layer in leaflet map in Shiny only when zoom level > 8 with LayersControl?
It works fine, but when I add the addSearchOSM plugin from leaflet.extras the CircleMarkers will not be plotted anymore when the app starts. So the observe statement will not be rendered until I change an input.
This is the code:
library(leaflet)
library(leaflet.extras)
library(shiny)
data <- data.frame(longitude = c(11.43, 11.55), latitude = c(48, 48.5), label = c("a", "b"))
getInputwithJS <- '
Shiny.addCustomMessageHandler("findInput",
function(message) {
var inputs = document.getElementsByTagName("input");
console.log(inputs);
Shiny.onInputChange("marker1", inputs[1].checked);
}
);
'
ui <- fluidPage(
sidebarPanel(
selectInput("label", "label", selected = "a", choices = data$label)
),
mainPanel(
leafletOutput("map", width = "100%", height = "700"),
tags$head(tags$script(HTML(getInputwithJS)))
)
)
server <- function(input, output, session){
# subset data according to label input
data_subset <- reactive({
data[data$label %in% input$label, ]
})
output$map <- renderLeaflet({
leaflet() %>% addTiles() %>% setView(11, 48.5, 7) %>%
addLayersControl(overlayGroups = c("marker1"),
options = layersControlOptions(collapsed = FALSE)) %>%
addSearchOSM()
})
# does not show points when app starts
observe({
leafletProxy("map") %>% clearGroup("points") %>%
addCircleMarkers(data_subset()$longitude, data_subset()$latitude, group = "points")
})
global <- reactiveValues(DOMRdy = FALSE)
autoInvalidate <- reactiveTimer(1000)
observe({
autoInvalidate()
if(global$DOMRdy){
session$sendCustomMessage(type = "findInput", message = "")
}
})
session$onFlushed(function() {
global$DOMRdy <- TRUE
})
# add marker if marker is clicked in layerscontrol and zoom level of map > 7
observe({
if (!is.null(input$marker1)){
if (input$marker1 == TRUE){
if (input$map_zoom > 7) {
leafletProxy("map") %>% addMarkers(lng = 11.2, lat = 48, group = "marker1")
}else{
leafletProxy("map") %>% clearGroup(group = "marker1")
}
}
}
})
}
shinyApp(ui, server)