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)
Related
What I would like to do is that if a user clicks on a line, it displays the line name in the box to the right of the map, and if a user clicks somewhere else on the map, it 'deselects' that line:
The problem is that when a user clicks the polyline, leaflet fires both a map_shape_click (the polyline) and map_click (the map) event. Even more annoyingly, it fires the map_shape_click event before the map_click event.
How can I distinguish whether the user has clicked a line, or just the base map, so that my select/deselect works? Reproducible example:
library(shiny)
library(tidyverse)
library(leaflet)
ui <- fluidPage(
fluidRow(
column(
width = 8,
leafletOutput("map")
),
column(
width = 4,
uiOutput("info")
)
)
)
server <- function(input, output) {
output$map <- renderLeaflet({
leaflet() %>%
addTiles() %>%
setView(lng = -71.03165, lat = 42.37595, zoom = 13) %>%
addPolylines(lng = c(-71.05884, -71.02), lat = c(42.360081, 42.359),
layerId = "line1") %>%
addPolylines(lng = c(-71.05884, -71.05), lat = c(42.360081, 42.4),
layerId = "line2")
})
observeEvent(input$map_shape_click, {
x <- input$map_shape_click
output$info <- renderUI({
div(
"Line: ", x$id
)
})
})
observeEvent(input$map_click, {
output$info <- renderUI({
div(
"Nothing selected"
)
})
})
}
shinyApp(ui = ui, server = server)
library(shiny)
library(tidyverse)
library(leaflet)
ui <- fluidPage(
fluidRow(
column(
width = 8,
leafletOutput("map")
),
column(
width = 4,
uiOutput("info")
)
)
)
server <- function(input, output) {
output$map <- renderLeaflet({
leaflet() %>%
addTiles() %>%
setView(lng = -71.03165, lat = 42.37595, zoom = 13) %>%
addPolylines(lng = c(-71.05884, -71.02), lat = c(42.360081, 42.359),
layerId = "line1") %>%
addPolylines(lng = c(-71.05884, -71.05), lat = c(42.360081, 42.4),
layerId = "line2")
})
clicked <- reactiveVal()
observeEvent(input$map_shape_click, {
freezeReactiveValue(input, 'map_click')
clicked(input$map_shape_click)
})
observeEvent(input$map_click, {
clicked(input$map_click)
})
output$info <- renderUI({
req(clicked())
if(is.null(clicked()[['id']])) return(div("Nothing selected"))
div("Line: ", clicked()$id)
})
}
shinyApp(ui = ui, server = server)
Things are a little tricky here. we use freezeReactiveValue to freeze the map click, meaning if there is any shape click event, we do not update the value of map_click. This is a little advanced shiny. I recommend you read the help file and read this chapter: https://mastering-shiny.org/action-dynamic.html#freezing-reactive-inputs
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(...)
}
I want to display my marker labels based on zoom level.
Based on (https://rstudio.github.io/leaflet/shiny.html) I tried to use "input$MAPID_zoom". In my example, labels stored in location_name should be displayed when zoom level (mapscale) is lower to 6.
What I tried :
library(shiny)
library(leaflet)
# my data
df <- data.frame(
location_name = c('S1', 'S2'),
lng = c(-1.554136, -2.10401),
lat = c(47.218637, 47.218637),
stringsAsFactors = FALSE)
# UI
ui <- shinyUI(fluidPage(
leafletOutput('map')
))
# server
server <- shinyServer(function(input, output, session) {
mapscale <- observe({
input$map_zoom # get zoom level
})
output$map <- renderLeaflet({
leaflet() %>%
addTiles() %>%
addMarkers(data=df, lng = ~lng, lat = ~lat,
label =~if(mapscale<6, location_name))
})
})
shinyApp(ui = ui, server = server)
A few remarks on your code if you like.
If you wrap the zoom in a reactive function, reference it like mapscale(). Use the normal if statement in R and the ~ in front of the variable. Then you should be fine.
Reproducible example:
library(shiny)
library(leaflet)
df <- data.frame(
location_name = c('S1', 'S2'),
lng = c(-1.554136, -2.10401),
lat = c(47.218637, 47.218637),
stringsAsFactors = FALSE
)
ui <- shinyUI(
fluidPage(
leafletOutput(outputId = 'map')
)
)
server <- shinyServer(function(input, output, session) {
output$map <- renderLeaflet({
leaflet() %>%
addTiles()
})
observeEvent(
eventExpr = input$map_zoom, {
print(input$map_zoom) # Display zoom level in the console
leafletProxy(
mapId = "map",
session = session
) %>%
clearMarkers() %>%
addMarkers(
data = df,
lng = ~lng,
lat = ~lat,
label = if(input$map_zoom < 6) ~location_name
)
}
)
})
shinyApp(
ui = ui,
server = server
)
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/
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)