I am experimenting with the leaflet package for some maps in Shiny. I would like to be able to have a base map that data will change and subsequently be remapped. However, I am trying to use the leafletProxy function whereby there is a base map and I just change the data points that are added. All of this works however the map doesn't zoom to the datapoints location. It remains at the farthest zoom.
The code to reproduce the problem:
library(shiny)
library(leaflet)
r_colors <- rgb(t(col2rgb(colors()) / 255))
names(r_colors) <- colors()
ui <- fluidPage(
leafletOutput("mymap"),
p(),
actionButton("goButton", "New Points")
)
server <- function(input, output, session) {
output$mymap <- renderLeaflet({
leaflet() %>%
addProviderTiles("Stamen.TonerLite",
options = providerTileOptions(noWrap = TRUE)
)
})
observeEvent(input$goButton, {
points <- cbind(rnorm(40) * 2 + 13, rnorm(40) + 48)
leafletProxy('mymap', session) %>%
clearMarkers() %>%
addMarkers(data = points)
})
}
shinyApp(ui, server)
I would like the map to automatically zoom in once new points have been added.
try to add argument "fitBounds" in leafletProxy()
leafletProxy('mymap', session) %>%
clearMarkers() %>%
addMarkers(data = points) %>%
fitBounds(lng1 = max(points$long),lat1 = max(points$lat),
lng2 = min(points$long),lat2 = min(points$lat))
I revised G. Cocca's answer (mostly by adding a dataframe of "points") to get this:
library(shiny)
library(leaflet)
r_colors <- rgb(t(col2rgb(colors()) / 255))
names(r_colors) <- colors()
ui <- fluidPage(
leafletOutput("mymap"),
p(),
actionButton("goButton", "New Points")
)
server <- function(input, output, session) {
output$mymap <- renderLeaflet({
leaflet() %>%
addProviderTiles("Stamen.TonerLite",
options = providerTileOptions(noWrap = TRUE)
)
})
observeEvent(input$goButton, {
points <- data.frame("long" = rnorm(40) * 2 + 13,
"lat" = rnorm(40) + 48)
leafletProxy('mymap', session) %>%
clearMarkers() %>%
addMarkers(data = points) %>%
fitBounds(lng1 = max(points$long),lat1 = max(points$lat),
lng2 = min(points$long),lat2 = min(points$lat))
})
}
shinyApp(ui, server)
Related
I am building a map using Shiny and want to capture the latitude and longitude of the centre of the map in the variables 'lt' and 'ln'. I am using the below code, however, when it is run, I get NULL values for both 'lt' and 'ln'.
library(shiny)
library(leaflet)
library(leaflet.extras)
server <- function(input, output, session){
output$map <- renderLeaflet({
leaflet() %>%
addProviderTiles(providers$OpenStreetMap) %>%
setView(lng = 147.842393, lat = -24.000942, zoom = 6) %>%
addSearchOSM(options = searchOptions(collapsed = TRUE))
})
observeEvent(input$MAPID_center, {
lt <- input$MAPID_center$lat
ln <- input$MAPID_center$lng
})
})
Your MAPID is wrong.
You've defined your map output as output$map. So map is your ID in this case
When you want to "observe" this map, you need to observe input$map_... objects
Here's a working example
library(shiny)
library(leaflet)
library(leaflet.extras)
ui <- fluidPage(
leaflet::leafletOutput(
outputId = "map"
)
)
server <- function(input, output, session){
output$map <- renderLeaflet({
leaflet() %>%
addProviderTiles(providers$OpenStreetMap) %>%
setView(lng = 147.842393, lat = -24.000942, zoom = 6) %>%
addSearchOSM(options = searchOptions(collapsed = TRUE))
})
observeEvent(input$map_center, {
lt <- input$map_center$lat
ln <- input$map_center$lng
print(lt); print(ln)
})
}
shinyApp(ui, server)
If you want those variables in the global environment you may use <<- operator.
library(shiny)
library(leaflet)
library(leaflet.extras)
server <- function(input, output, session){
output$map <- renderLeaflet({
leaflet() %>%
addProviderTiles(providers$OpenStreetMap) %>%
setView(lng = 147.842393, lat = -24.000942, zoom = 6) %>%
addSearchOSM(options = searchOptions(collapsed = TRUE))
})
observeEvent(input$MAPID_center, {
lt <<- input$MAPID_center$lat
ln <<- input$MAPID_center$lng
})
}
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]))
})
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
)
In the code below, the leaflet addCircles get drawn twice after a change in zoom. I think this double plotting occurs because the reactive to create a dataframe always updates with a change in zoom. However, I only want the reactive dataframe (race.dots.all.r) to update when a zoom threshold is crossed. Any ideas?
EDIT: I removed even more code to simplify and made it reproducible by adding a dropbox link to the data.
library(shiny)
library(leaflet)
library(dplyr)
load(url("https://www.dropbox.com/s/umhqvoqvbhlkrc6/shiny_app_seg_gap_stackoverflow.RData?dl=1"))
ui <- shinyUI(fluidPage(
leafletOutput("map"),
checkboxInput("togglewhite", "White", value = TRUE)
))
server <- shinyServer(function(input, output, session) {
per.person <- eventReactive(input$map_zoom,{
new_zoom <- 12
if (!is.null(input$map_zoom)) {
new_zoom <- input$map_zoom}
if ( new_zoom < 13 ) {
per.person <- "1000"
} else {
per.person <- "250"
}
return(per.person)
})
race.dots.all.r <- eventReactive(per.person(),{
race.dots.all <- race.dots.all[[per.person()]]
return(race.dots.all)
})
values <- reactiveValues(school = NULL)
output$map <- renderLeaflet({
leaflet(options = leafletOptions(preferCanvas = TRUE)) %>%
addProviderTiles("CartoDB") %>%
setView(lat=40.73771, lng=-74.18958, zoom = 8)
})
observeEvent(c(input$togglewhite, race.dots.all.r()), {
proxy <- leafletProxy('map')
proxy %>% clearGroup(group = "White")
if (input$togglewhite){
race.dots.all.selected.race <- dplyr::filter( race.dots.all.r(), group == "White")
proxy %>% addCircles(group = race.dots.all.selected.race$group,
race.dots.all.selected.race$lng,
race.dots.all.selected.race$lat)
}
},ignoreInit = TRUE)
}) # close server
shinyApp(ui, server)
If I understand your requirement correctly then here's one way to do it. I have set the zoom threshold at 0 for this example just so that it is easy to demo. You can change it to 4 for your app.
library(shiny)
library(leaflet)
shinyApp(
ui = fluidPage(
leafletOutput("map")
),
server = function(input, output, session) {
output$map <- renderLeaflet({
leaflet() %>%
addTiles()
})
map_proxy <- leafletProxy("map")
observeEvent(input$map_zoom, {
if(input$map_zoom > 0) {
map_proxy %>%
addCircleMarkers(lng = 74.0060, lat = 40.7128,
group = "high_zoom_in", radius = 50, color = "red")
} else {
map_proxy %>%
clearGroup("high_zoom_in")
}
})
}
)
I want to create a modal window when I click an icon in a leaflet map in shiny. Is this doable? I tried the code below, but the bsModal is not doing anything.
library(shiny)
library(leaflet)
library(shinyBS)
points <- data.frame(cbind(latitude = rnorm(40) * 2 + 13, longitude =
rnorm(40) + 48))
ui <- fluidPage(
leafletOutput("mymap"),
bsModal("modalExample", "This will open a modal", "assign_task", size =
"large",
HTML(""))
)
server <- function(input, output, session) {
output$mymap <- renderLeaflet({
leaflet(options = leafletOptions(maxZoom = 18)) %>% addTiles() %>%
addMarkers(lat = ~ latitude, lng = ~ longitude,
data = points,
popup=~ sprintf(
'<button type="button" id="assign_task">Open Modal </button>'
))
})
}
shinyApp(ui, server)
I'll post two possible solutions. The first one is the solution that I think would suit your needs best, the second one more cosely matches your current code. Hope this helps!
Solution 1:
library(shiny)
library(leaflet)
points <- data.frame(cbind(id=seq(1,40),latitude = rnorm(40) * 2 + 13, longitude =
rnorm(40) + 48))
ui <- fluidPage(
leafletOutput("mymap"),
actionButton("action1","Show modal")
)
server <- function(input, output, session) {
observeEvent(input$mymap_marker_click, {
id = input$mymap_marker_click$id
showModal(modalDialog(
title = "You selected a marker!",
paste0("ID: ", id, ", lat: ", round(points$latitude[id==id],2),", lon: ", round(points$longitude[id==id],2))
))
})
output$mymap <- renderLeaflet({
leaflet(options = leafletOptions(maxZoom = 18)) %>% addTiles() %>%
addMarkers(layerId = ~ id,lat = ~ latitude, lng = ~ longitude,
data = points
)
})
}
shinyApp(ui, server)
Solution 2:
library(shiny)
library(leaflet)
library(shinyBS)
points <- data.frame(cbind(latitude = rnorm(40) * 2 + 13, longitude =
rnorm(40) + 48))
ui <- fluidPage(
leafletOutput("mymap"),
actionButton("action1","Show modal")
)
server <- function(input, output, session) {
observeEvent(input$button_click, {
showModal(modalDialog(
title = "Important message",
"This is an important message!"
))
})
output$mymap <- renderLeaflet({
leaflet(options = leafletOptions(maxZoom = 18)) %>% addTiles() %>%
addMarkers(lat = ~ latitude, lng = ~ longitude,
data = points,
popup= ~paste("<b>", latitude, longitude, "</b></br>", actionButton("showmodal", "Show modal", onclick = 'Shiny.onInputChange(\"button_click\", Math.random())')))
})
}
shinyApp(ui, server)