I'm building a Leaflet app in Shiny, and the idea is that the user logs in to see an overview of specific cities that can be clicked on. Clicking on those cities will zoom in to that particular city. The code as shown below works in making this happen.
What I can't figure out, is that I also want to provide a button (that appears after a city is selected) called "Return to see other cities" that, when clicked, will "reset" the map back to its original state.
However, when I click on the button, I get the following error:
Warning: Error in UseMethod: no applicable method for 'metaData' applied to an object of class "NULL"
Here I'm using input$map_marker_click to determine which city the app should zoom in on, and I think a part of the problem is that I can't set that back to its initial state of NULL after it's been clicked. Is there another way I'm missing?
library(shiny)
library(leaflet)
library(leaflet.extras)
library(dplyr)
cities <- data.frame(cities = c("London", "Chicago", "New York", "Philadelphia", "Los Angeles"),
lng = c(-0.118092, -87.6298, -74.0060, -75.1642, -118.2477),
lat = c(51.509865, 41.848, 40.7128, 39.9586, 34.0522),
zoom = c(11, 11, 12, 12, 10))
ui <- bootstrapPage(
tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
leafletOutput("map", width = "100%", height = "100%"),
conditionalPanel("isNaN(input.map_marker_click)", uiOutput("controls"))
)
server <- function(input, output, session) {
output$map <- renderLeaflet({
leaflet(cities, width = "100%", height = "100%") %>%
addProviderTiles("CartoDB.DarkMatter") %>%
setView(lng = -56, lat = 49.2402, zoom = 4) %>%
addPulseMarkers(lng = ~lng, lat = ~lat,
label = ~cities,
icon = makePulseIcon())
})
output$controls <- renderUI({
req(input$map_marker_click)
absolutePanel(id = "controls", top = 100, left = 50,
right = "auto", bottom = "auto", width = "auto", height = "auto",
actionButton(inputId = "reset", label = "Return to see other cities", class = "btn-primary")
)
})
observeEvent(input$map_marker_click, {
city_selected <- filter(cities, lat == input$map_marker_click$lat[1])
leafletProxy("map") %>%
clearMarkers() %>%
clearControls() %>%
setView(lng = city_selected$lng[1], lat = city_selected$lat[1], zoom = city_selected$zoom[1])
})
#I know the below is wrong, but I don't know what I'm supposed to do to "reset" the map.
observeEvent(input$reset, {
leafletProxy("map") %>%
setView(lng = -56, lat = 49.2402, zoom = 4) %>%
addPulseMarkers(lng = ~lng, lat = ~lat,
label = ~cities,
icon = makePulseIcon())
})
}
shinyApp(ui, server)
An alternative reactive based output
Enclosing map creation inside a function so that resetting becomes easier by just a function call without code repetition:
library(shiny)
library(leaflet)
library(leaflet.extras)
library(dplyr)
library(shinyjs) #for hide function
cities <- data.frame(cities = c("London", "Chicago", "New York", "Philadelphia", "Los Angeles"),
lng = c(-0.118092, -87.6298, -74.0060, -75.1642, -118.2477),
lat = c(51.509865, 41.848, 40.7128, 39.9586, 34.0522),
zoom = c(11, 11, 12, 12, 10))
ui <- bootstrapPage(
useShinyjs(),
tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
leafletOutput("map", width = "100%", height = "100%"),
conditionalPanel("isNaN(input.map_marker_click)", uiOutput("controls"))
)
server <- function(input, output, session) {
#creating the first map within a function so that reset becomes easy
base_map <- function(){
leaflet(cities, width = "100%", height = "100%") %>%
addProviderTiles("CartoDB.DarkMatter") %>%
setView(lng = -56, lat = 49.2402, zoom = 4) %>%
addPulseMarkers(lng = ~lng, lat = ~lat,
label = ~cities,
icon = makePulseIcon())
}
# reactiveVal for the map object, and corresponding output object.
react_map <- reactiveVal(base_map())
output$map <- renderLeaflet({
react_map()
})
output$controls <- renderUI({
req(input$map_marker_click)
absolutePanel(id = "controls", top = 100, left = 50,
right = "auto", bottom = "auto", width = "auto", height = "auto",
actionButton(inputId = "reset", label = "Return to see other cities", class = "btn-primary")
)
})
observeEvent(input$map_marker_click, {
city_selected <- filter(cities, lat == input$map_marker_click$lat[1])
show('controls')
leafletProxy("map") %>%
clearMarkers() %>%
clearControls() %>%
setView(lng = city_selected$lng[1], lat = city_selected$lat[1], zoom = city_selected$zoom[1])
})
# Making the entire map creation inside reactive function makes it easier to reset
observeEvent(input$reset, {
#hiding the control button
hide('controls')
# resetting the map
react_map(base_map())
})
}
shinyApp(ui, server)
I needed to add data = cities in the last addPulseMarkers() call.
observeEvent(input$reset, {
leafletProxy("map") %>%
setView(lng = -56, lat = 49.2402, zoom = 4) %>%
addPulseMarkers(data = cities, lng = ~lng, lat = ~lat,
label = ~cities,
icon = makePulseIcon())
})
Related
I have a map which has a series of lines with associated values, which is rendered based on a reactive dataframe, filtered by a sliderInput.
When a line is clicked, the map view is updated with new lng, lat and zoom values, based on that line. What I would like is that the view does not reset when the slider is updated. I understand that it's resetting to the values in the initial setView() because the map is rerendering when the slider is changed, but I'm unsure how I can prevent this behaviour.
In short, when a user clicks on the line, I want it to stay at that lng/lat/zoom even as the slider changes. How can I accomplish this?
Below is a simplified reproducible example, with only one line:
library(shiny)
library(leaflet)
library(tidyverse)
library(RColorBrewer)
# Example data frame
line1 <- data.frame(
lng = rep(c(13.35011, 13.21514), 4),
lat = rep(c(52.51449, 52.48042), 4),
id = rep("10351A", 8),
period = rep(c(1, 2, 3, 4), each = 2),
value = rep(c(1200, 2300, 3140, 1111), each = 2)
)
ui <- fluidPage(
sidebarPanel(
sliderInput(
inputId = "period_picker",
label = "Period",
min = 1,
max = 4,
value = 1
),
uiOutput("clicked_info")
),
mainPanel(
leafletOutput("map")
)
)
server <- function(input, output) {
# Reactive dataframe based on period_picker
dat <- reactive({
filtered <- line1 %>%
filter(period == input$period_picker)
return(filtered)
})
# Render map
output$map <- renderLeaflet({
# Create color palette based on reactive frame
pal <- colorNumeric(palette = "Purples", domain = c(0, max(line1$value)))
# Render leaflet map
leaflet(data = dat()) %>%
addTiles() %>%
setView(lng = 13.38049, lat = 52.51873, zoom = 13) %>%
addPolylines(
lng = ~lng,
lat = ~lat,
layerId = ~id,
color = ~pal(dat()$value),
opacity = 1
)
})
# Zoom in and readjust view if shape matching id is clicked - this is the
# lng/lat/zoom value I want to keep when the sliderInput is changed
observeEvent(input$map_shape_click, {
x <- input$map_shape_click
if(x$id == "10351A") {
leafletProxy(
mapId = "map",
) %>%
flyTo(
lng = 13.282625,
lat = 52.497455,
zoom = 12
)
}
# Render dataset in the UI
output$clicked_info <- renderUI({
div(
tags$span("Line ID:", dat()$id[1]),
br(),
tags$span("Period:", dat()$period[1]),
br(),
tags$span("Value:", dat()$value[1])
)
})
})
}
shinyApp(ui = ui, server = server)
You need to put the addPolylines not in the map rendering, but in another observeEvent with leafletProxy. Replace your output$map block of code by the following lines :
# Render map
output$map <- renderLeaflet({
leaflet() %>%
addTiles() %>%
setView(lng = 13.38049, lat = 52.51873, zoom = 13)
})
observeEvent(dat(), {
req(dat())
pal <- colorNumeric(palette = "Purples", domain = c(0, max(line1$value)))
leafletProxy("map") %>%
addPolylines(
data = dat(),
lng = ~lng,
lat = ~lat,
layerId = ~id,
color = ~pal(dat()$value),
opacity = 1
)
})
I have a basic shiny app with a leaflet map.The circles should stay as they are until a user zooms to zoom-level 8, at which point the weight should be 2. When the zoom becomes 9 or higher, the weight should become 3.
Here is my attempt. The app breaks down when I go to zoom level 9 with Error in resolveFormula: Unexpected two-sided formula: (input$map_zoom > 8) ~ 3
## app.R ##
library(leaflet)
library(shinydashboard)
library(shinydashboardPlus)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(),
dashboardBody(
leafletOutput("map", width = "100%", height = "500px")
)
)
server <- function(input, output,session) {
df <- data.frame("Lat"=c(32.921821,32.910853,32.793803,32.995084,32.683745,32.759999,32.800652,32.958861,32.835963,32.762578,32.649651,32.862843,32.862217,32.936876,32.963381),
"Long"=c(-96.840609,-96.738831,-96.689232,-96.857858,-96.825345,-96.684475,-96.794144,-96.816111,-96.676371,-96.897331,-96.944426,-96.754719,-96.856976,-96.752718,-96.770249))
observeEvent(
eventExpr = input$map_zoom, {
print(input$map_zoom) # Display zoom level in the console
leafletProxy(
mapId = "map",
session = session
)%>%
addCircles(data=df,lng = ~Long, lat = ~Lat, weight = if(input$map_zoom <=8) ~2
else(input$map_zoom >8) ~3,
opacity = 1, fill = TRUE, fillOpacity = 1 )
}
)
output$map <- renderLeaflet({
leaflet() %>%
addTiles(urlTemplate = "//{s}.tiles.mapbox.com/v3/jcheng.map-5ebohr46/{z}/{x}/{y}.png",
attribution = 'Maps by Mapbox') %>%
setView(lng = -96.84, lat = 32.92, zoom = 6)
})
}
shinyApp(ui, server)
Try case_when as
weight = case_when(input$map_zoom <=8 ~2, input$map_zoom >8 ~3)
This works fine for me:
observeEvent(eventExpr = input$mymap_zoom, {
print(input$mymap_zoom) # Display zoom level in the console
mywt <- case_when(input$mymap_zoom <=8 ~1, input$mymap_zoom >8 ~6)
print(mywt)
leafletProxy(
mapId = "mymap" , session = session
)%>%
clearShapes() %>%
addCircles(data=df,lng = ~Long, lat = ~Lat,
weight = mywt ,
opacity = 1, fill = TRUE, fillOpacity = 1 )
}
)
You just need clearShapes()
I'm creating a Shiny app with a Leaflet map. It has thousands of small circles plotted on it, and the colors of the circles tells a story. When zoomed out, the circles are kept small (weight=1) so they overlap less. However, when the user zooms in, the small circles become hard to see. I would like the circles to increase in size depending on the zoom level. I understand that there is a input$MAPID_zoom feature that returns a zoom level as an integer.
Below is some reproducible code that plots 15 random points in Dallas, TX onto a leaflet map with the zoom set to 6. How would I go about changing the weight of the circles from 1 to 2 when the zoom level increases to 8, and from 2 to 3 when the zoom increases to 10?
I've seen some discussion online but nothing that has worked for me. See code below. Thanks in advance.
## app.R ##
library(leaflet)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(),
dashboardBody(
leafletOutput("Map", width = "100%", height = "500px")
)
)
server <- function(input, output) {
df <- data.frame("Lat"=c(32.921821,32.910853,32.793803,32.995084,32.683745,32.759999,32.800652,32.958861,32.835963,32.762578,32.649651,32.862843,32.862217,32.936876,32.963381),
"Long"=c(-96.840609,-96.738831,-96.689232,-96.857858,-96.825345,-96.684475,-96.794144,-96.816111,-96.676371,-96.897331,-96.944426,-96.754719,-96.856976,-96.752718,-96.770249))
output$Map <- renderLeaflet({
leaflet(df) %>%
addTiles(urlTemplate = "//{s}.tiles.mapbox.com/v3/jcheng.map-5ebohr46/{z}/{x}/{y}.png",
attribution = 'Maps by Mapbox') %>%
setView(lng = -96.84, lat = 32.92, zoom = 6) %>%
addCircles(lng = ~Long, lat = ~Lat, weight = 1,
opacity = 1, fill = TRUE, fillOpacity = 1 )
})
}
shinyApp(ui, server)
Alright, this ended up being more involved than I thought but I finally got it to work. There is an observer that is the key. I also had to learn what leafletProxy() is (research it if you don't know). Finally, clearing the shapes with clearShapes() in the observer was key to getting this working when zooming both in and out. See code below.
## app.R ##
library(leaflet)
library(shinydashboard)
library(shinydashboardPlus)
library(dplyr)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(),
dashboardBody(
leafletOutput("map", width = "100%", height = "500px")
)
)
server <- function(input, output,session) {
df <- data.frame("Lat"=c(32.921821,32.910853,32.793803,32.995084,32.683745,32.759999,32.800652,32.958861,32.835963,32.762578,32.649651,32.862843,32.862217,32.936876,32.963381),
"Long"=c(-96.840609,-96.738831,-96.689232,-96.857858,-96.825345,-96.684475,-96.794144,-96.816111,-96.676371,-96.897331,-96.944426,-96.754719,-96.856976,-96.752718,-96.770249))
observeEvent(
eventExpr = input$map_zoom, {
print(input$map_zoom) # Display zoom level in the console
leafletProxy(
mapId = "map",
session = session
)%>% clearShapes() %>%
addCircles(data=df,lng = ~Long, lat = ~Lat,
weight = case_when(input$map_zoom <=4 ~1,
input$map_zoom ==5 ~2,
input$map_zoom ==6 ~3,
input$map_zoom ==7 ~5,
input$map_zoom ==8 ~7,
input$map_zoom ==9 ~9,
input$map_zoom >9 ~11),
opacity = 1, fill = TRUE, fillOpacity = 1 )
}
)
output$map <- renderLeaflet({
leaflet() %>%
addTiles(urlTemplate = "//{s}.tiles.mapbox.com/v3/jcheng.map-5ebohr46/{z}/{x}/{y}.png",
attribution = 'Maps by Mapbox') %>%
setView(lng = -96.84, lat = 32.92, zoom = 6)
})
}
shinyApp(ui, server)
Try this
output$Map <- renderLeaflet({
new_zoom <- 6
wt <- 2
if(!is.null(input$Map_zoom)) new_zoom <- input$Map_zoom
leaflet(df) %>%
addTiles(urlTemplate = "//{s}.tiles.mapbox.com/v3/jcheng.map-5ebohr46/{z}/{x}/{y}.png",
attribution = 'Maps by Mapbox') %>%
setView(lng = -96.84, lat = 32.92, zoom=new_zoom ) %>%
addCircles(lng = ~Long, lat = ~Lat, weight = wt, # radius=radius,
opacity = 1, fill = TRUE, fillOpacity = 1 )
})
I'm trying to select a place from a list and then go to it a map provided by the leaflet package.
I tried this:
First, create the variables on the ui
vars <- c(
"LAS CRUZADAS" = "lc",
"PUENTE SAN ISIDRO" = "psi",
"FUNDO EL PROGRESO" = "fep",
"CALLE SANTA MARÍA" = "csm",
"ASENTAMIENTO NOGALES" = "an"
)
And then set up the panel
navbarPage("PLATAFORMA NAUTILUS", id="nav",
absolutePanel(id = "controls", class = "panel panel-default", fixed = TRUE,
draggable = TRUE, top = 60, left = "auto", right = 20, bottom = "auto",
width = 330, height = "auto",
h2(""),
selectInput("color", "Seleccionar Estación", vars)
),
)
in the server, add a marker in the respective places
output$mymap <- renderLeaflet({
leaflet() %>% addTiles() %>%
#h v
addCircleMarkers(lng=-71.294563, lat=-32.933843, color="blue" ,popup="LAS CRUZADAS") %>%
addCircleMarkers(lng=-71.240000, lat=-32.900000, color="blue" ,popup="PUENTE SAN ISIDRO") %>%
addCircleMarkers(lng=-71.226667, lat=-32.832778, color="blue" ,popup="CALLE SANTA MARÍA") %>%
addCircleMarkers(lng=-71.183889, lat=-32.733333, color="blue" ,popup="ASENTAMIENTO NOGALES") %>%
addCircleMarkers(lng=-71.221667, lat=-32.866111, color="blue" ,popup="FUNDO EL PROGRESO") %>%
setView(lng=-71.294563, lat=-32.933843, zoom=11)
})
Use a data.frame to store the lat/lon for each location, then use an observeEvent and to update leaflet when the selection changes.
To update leaflet in shiny you should use leafletProxy to update the map
Here's a working example
library(shiny)
library(leaflet)
df_vars <- data.frame(location = c("LAS CRUZADAS","ASENTAMIENTO NOGALES"),
lat = c(-32.9338, -32.8661),
lon = c(-71.2945, -71.2216)
)
ui <- fluidPage(
selectInput(inputId = "myLocations", label = "Locations",
choices = df_vars$location),
leafletOutput(outputId = "mymap")
)
server <- function(input, output){
output$mymap <- renderLeaflet({
leaflet() %>%
addTiles() %>%
addCircleMarkers(lng=-71.294563, lat=-32.933843, color="blue" ,popup="LAS CRUZADAS") %>%
addCircleMarkers(lng=-71.221667, lat=-32.866111, color="blue" ,popup="FUNDO EL PROGRESO")
})
observeEvent({
input$myLocations
},{
selectedLocation <- df_vars[df_vars$location == input$myLocations, c("lat","lon")]
leafletProxy(mapId = "mymap") %>%
setView(lng = selectedLocation$lon, lat = selectedLocation$lat, zoom = 11)
})
}
shinyApp(ui, server)
I am trying to add two different markers for two different inputs. I got the first one working but not for the second one. Here is my code
ui.R
library(shiny)
library(leaflet)
shinyUI(fluidPage(
# Application title
titlePanel("Aspen GBS Population Structure results on map"),
# Side bar layout
sidebarLayout(
sidebarPanel(
selectInput("structure", label = "Select K for display", choices = c("2", "3", "4", "5", "6"), selected = "2"),
checkboxInput("origin", label = "Flood path")),
mainPanel(
leafletOutput("map")
)
)
)
)
server.R
leafIcons <- icons(
iconUrl = ifelse(data_K2$FP_Icon == "greenleafIcon",
"http://leafletjs.com/docs/images/leaf-green.png",
"http://leafletjs.com/docs/images/leaf-red.png"
),
iconWidth = 38, iconHeight = 95,
iconAnchorX = 22, iconAnchorY = 94,
shadowUrl = "http://leafletjs.com/docs/images/leaf-shadow.png",
shadowWidth = 50, shadowHeight = 64,
shadowAnchorX = 4, shadowAnchorY = 62
)
library(shiny)
shinyServer(function(input, output, session) {
dt <- reactive(
switch(input$structure,
"2" = data_K2$Structure.2,
"3" = data_K2$Structure.3))
output$map <- renderLeaflet(
leaflet(data = data_K2) %>% addTiles() %>% setView(lng = -106.1039361,lat = 50.543981, zoom = 4) %>%
addCircleMarkers(lat = ~Lat, lng = ~Long, popup = ~Location_discription, radius=2, color = ~dt(), fill = TRUE) %>%
addMarkers(lat = ~Lat, lng = ~Long, popup = ~Location_discription, icon = leafIcons)
)
})
I want the addMarkers to get activated when i use the checkboxInput button only. But right now it is selected by default.
I've found the easiest way is to label the markers with groups, then just show/hide them on input. That way you save some computation, and leaflet is designed to do this with leafletProxy (it's well documented on the Rstudio guide). You would need to add an observer as well that would update the map, as in this example,
library(shiny)
library(leaflet)
ui <- shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(
checkboxInput("show", "Show/Hide")
),
mainPanel(
leafletOutput("map")
)
)
))
dat <- data.frame(lng = rnorm(3, -106.1039361, 0.5) ,
lat = rnorm(3, 50.543981, 0.5))
server <- shinyServer(function(input, output, session) {
## Your map, give the markers groups
output$map <- renderLeaflet(
leaflet(data = dat) %>%
addTiles() %>% setView(lng = -106.1039361,lat = 50.543981, zoom = 4) %>%
addCircleMarkers(group="circles",
popup = ~paste(lat), radius=2, fill = TRUE) %>%
addMarkers(group="markers")
)
## Observer to update map on input
observeEvent(input$show, {
proxy <- leafletProxy('map')
if (input$show) proxy %>% showGroup('markers')
else proxy %>% hideGroup('markers')
})
})
shinyApp(ui, server)