I'm trying to create two leaflet maps in an R shiny app that are placed in different tabpanels using the tabsetPanel() function. I would like to have a widget (e.g., sliderInput()) that controls the size of markers on both maps. I can create an app that does this but the problem is that features are not initially rendered on the map that is on the second panel on startup. Features are rendered on the second panel only after selecting the panel, then changing the input with a slider. I would like both maps to show their features on startup without having to initialize the second with a slider.
library(shiny)
library(leaflet)
pts <- data.frame(
x = rnorm(10, mean = -93.625),
y = rnorm(10, mean = 42.0285)
)
# Define UI
ui <- fluidPage(
sliderInput("radius",
"Point radius:",
min = 1,
max = 50,
value = 30),
tabsetPanel(
tabPanel('Map1',
leafletOutput('map1')
),
tabPanel('Map2',
leafletOutput('map2')
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$map1 <- renderLeaflet({
leaflet() %>%
addTiles() %>%
setView(-93.65, 42.0285, zoom = 6)
})
output$map2 <- renderLeaflet({
leaflet() %>%
addTiles() %>%
setView(-93.65, 42.0285, zoom = 6)
})
observe({
tab1 <- leafletProxy('map1', data = pts) %>%
clearMarkers() %>%
addCircleMarkers(lng = ~x, lat = ~y, radius = input$radius)
tab2 <- leafletProxy('map2', data = pts) %>%
clearMarkers() %>%
addCircleMarkers(lng = ~x, lat = ~y, radius = input$radius)
})
}
# Run the application
shinyApp(ui = ui, server = server)
As a simple fix, you could give your tabsetPanel an id, and put the corresponding input in your observer, so that the observer also invalidates when you change tabs. Working example is given below, I hope this helps!
library(shiny)
library(leaflet)
pts <- data.frame(
x = rnorm(10, mean = -93.625),
y = rnorm(10, mean = 42.0285)
)
# Define UI
ui <- fluidPage(
sliderInput("radius",
"Point radius:",
min = 1,
max = 50,
value = 30),
tabsetPanel(id='my_tabsetPanel',
tabPanel('Map1',
leafletOutput('map1')
),
tabPanel('Map2',
leafletOutput('map2')
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$map1 <- renderLeaflet({
leaflet() %>%
addTiles() %>%
setView(-93.65, 42.0285, zoom = 6)
})
output$map2 <- renderLeaflet({
leaflet() %>%
addTiles() %>%
setView(-93.65, 42.0285, zoom = 6)
})
observe({
input$my_tabsetPanel
tab1 <- leafletProxy('map1', data = pts) %>%
clearMarkers() %>%
addCircleMarkers(lng = ~x, lat = ~y, radius = input$radius)
tab2 <- leafletProxy('map2', data = pts) %>%
clearMarkers() %>%
addCircleMarkers(lng = ~x, lat = ~y, radius = input$radius)
})
}
# Run the application
shinyApp(ui = ui, server = server)
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 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
)
I am very new to shiny, and I have a question.
I have a simple dataset with observations (Number_Total) of species (Species), in a certain location (X,Y).
I would like to generate a map, that enables you to select the species in a dropdown menu. Shiny then shows you were the species occurs on the map.
I got pretty far (for my experience), but selecting species in the menu does not do anything...
ui <- (fluidPage(titlePanel("Species Checker"),
sidebarLayout(
sidebarPanel(
selectizeInput('species', 'Choose species',
choices = df$Species, multiple = TRUE)
),
mainPanel(
leafletOutput("CountryMap",
width = 1000, height = 500))
)
))
The server side
server <- function(input, output, session){
output$CountryMap <- renderLeaflet({
leaflet() %>% addTiles() %>%
setView(lng = 10, lat = 40, zoom = 5) %>%
addCircles(lng = df$Y, lat = df$X, weight = 10,
radius =sqrt(df$Number_Total)*15000, popup = df$Species)
})
observeEvent(input$species, {
if(input$species != "")
{
leafletProxy("CountryMap") %>% clearShapes()
index = which(df$Species == input$species)
leafletProxy("CountryMap")%>% addCircles(lng = df$X[index],
lat = df$Y[index],
weight = 1,
radius =sqrt(df$Number_Total[index])*30, popup = df$Species[index])
}
})
}
And finally plot it
shinyApp(ui = ui, server = server)
I know my code is probably messy, but again, I blaim my experience =)
I did not manage to get an example dataset in here right away, so here it comes as picture
This is the result of the above code (with slightly different data)
enter image description here
Here's what you need. I think you are skilled enough to understand this but comment if you have any questions.
server <- function(input, output, session) {
# map_data <- reactive({
# req(input$species)
# df[df$Species %in% input$species, ]
# })
output$CountryMap <- renderLeaflet({
leaflet() %>% addTiles() %>%
setView(lng = 10, lat = 40, zoom = 5)
})
map_proxy <- leafletProxy("CountryMap")
observe({
md <- df[df$Species %in% input$species, ]
map_proxy %>%
addCircles(lng = md$Y, lat = md$X, weight = 10,
radius = sqrt(md$Number_Total)*15000, popup = md$Species)
})
}
I am building a shiny app where I would like to get the coordinates of a polygon from a leaflet map. Specifically, the shape is drawn using the Drawtoolbar from the leaflet.extras package. A simple example app is below.
My question is, how can I get the coordinates from the shape drawn on the map by the user? Thank you in advance.
library(shiny)
library(leaflet)
library(leaflet.extras)
# Define UI
ui <- fluidPage(
leafletOutput("mymap",height=800)
)
# Define server logic
server <- function(input, output) {
output$mymap <- renderLeaflet(
leaflet() %>%
addProviderTiles("Esri.OceanBasemap",group = "Ocean Basemap") %>%
setView(lng = -166, lat = 58.0, zoom = 5) %>%
addDrawToolbar(
targetGroup='draw',
editOptions = editToolbarOptions(selectedPathOptions = selectedPathOptions())) %>%
addLayersControl(overlayGroups = c('draw'), options =
layersControlOptions(collapsed=FALSE))
)
observeEvent(input$mymap_shape_click,{
print(input$mymap_shape_click)
})
observeEvent(input$mymap_click,{
print(input$mymap_click)
})
}
# Run the application
shinyApp(ui = ui, server = server)
You need to observe the _draw_new_feature function
library(leaflet.extras)
# Define UI
ui <- fluidPage(
leafletOutput("mymap",height=800)
)
# Define server logic
server <- function(input, output) {
output$mymap <- renderLeaflet(
leaflet() %>%
addProviderTiles("Esri.OceanBasemap",group = "Ocean Basemap") %>%
setView(lng = -166, lat = 58.0, zoom = 5) %>%
addDrawToolbar(
targetGroup='draw',
editOptions = editToolbarOptions(selectedPathOptions = selectedPathOptions())) %>%
addLayersControl(overlayGroups = c('draw'), options =
layersControlOptions(collapsed=FALSE))
)
observeEvent(input$mymap_draw_new_feature,{
feature <- input$mymap_draw_new_feature
print(feature)
})
}
# Run the application
shinyApp(ui = ui, server = server)
I'm trying to build a shiny app that will only plot points on rows that have a value within the range of a slider bar. If I increase the range of the slider bar, points will be added, but points are never removed when I decrease the range of the slider bar. Below is a reproducible example of my problem.If you increase the slider bar to full range, 3 points will show up on the map. If you then decrease the range enough it will zoom in on one point, but if you zoom out you will see that there are still 3 points being plotted on a map. I thought the clearShapes or clearMarkers function in leaflet would remove these points, but it's not working. Any suggestions?
library(shiny)
library(leaflet)
library(tidyverse)
ui <- fluidPage(
titlePanel("Test"),
sidebarLayout(
sidebarPanel(
radioButtons("choice","Group:",choices = c(1,2), selected = 1),
uiOutput("value"),
verbatimTextOutput("Click_text")
),
mainPanel(
leafletOutput("Map")
)
)
)
server <- function(input, output) {
df <- data.frame(lat = c(42.34,43.65,45.26,48.63,47.65,47.52),
lng = c(-96.43,-97.45,-98.56,-92.35,-94.56,-95.62),
id = c(32,45,65,76,34,12),
grp = c(1,1,1,2,2,2),
val = c(1.75,2.12,3.2,3.32,4.76,4.85))
subsetData1 <- reactive({
df %>% filter(grp == input$choice)
})
output$value <- renderUI({
sliderInput("value",label = h3("value"),
min = min(subsetData1()$val,na.rm = TRUE),
max = max(subsetData1()$val,na.rm=TRUE),
value = c(quantile(subsetData1()$val,.25,na.rm = TRUE),quantile(subsetData1()$val,.75,na.rm=TRUE)))
})
subsetData <- reactive({
df2 <- subsetData1() %>% data.frame()
df2 %>% filter(val >= min(as.numeric(input$value)) & val <= max(as.numeric(input$value)))
})
output$Map <- renderLeaflet({
leaflet(height = 1000) %>%
addTiles() %>%
fitBounds(min(df$lng),min(df$lat),max(df$lng),max(df$lat))
})
observe({
leafletProxy("Map") %>%
clearMarkers() %>%
clearShapes() %>%
addCircleMarkers(data = subsetData(),
lng = ~lng,
lat = ~lat,
layerId = ~id,
radius = 8,
weight = 10) %>%
fitBounds(.,min(subsetData()$lng),min(subsetData()$lat),
max(subsetData()$lng),max(subsetData()$lat))
})
observe({
click<-input$Map_marker_click
if(is.null(click))
return()
text<-paste("Latitude ", click$lat, "Longtitude ", click$lng)
text2<-paste("You've selected point ", click$id)
output$Click_text<-renderText({
text2
})
})
}
# Run the application
shinyApp(ui = ui, server = server)
You can change your observe function where you clear markers to an observeEvent function.
observeEvent(input$value,{
leafletProxy("Map") %>%
clearMarkers() %>%
clearShapes() %>%
addCircleMarkers(data = subsetData(),
lng = ~lng,
lat = ~lat,
layerId = ~id,
radius = 8,
weight = 10) %>%
fitBounds(.,min(subsetData()$lng),min(subsetData()$lat),
max(subsetData()$lng),max(subsetData()$lat))
})
You also have both the uiOutput and sliderInput id's as the same (value). You should make sure every element has a unique id. Rename one of them to something unique.