I have a shiny app with a large sf of lines
I would like to view it only at zoom 15 and to load only the visible part
library(leaflet)
library(shiny)
library(dplyr)
library(sf)
#random multilinestring
polyline_test <-st_multilinestring()
ui <- fluidPage(
leafletOutput("map")
)
server <- function(input, output, session){
output$map <- renderLeaflet({
leaflet() %>%
addTiles()
})
##Only select data visible on the map
new_zoom <- reactive({
if(!is.null(input$map_zoom)){
new_zoom <- input$map_zoom
}
else {new_zoom <- 2}
})
polyline_visible <- reactive({
validate(
need(new_zoom()>15,"t")
)
#bbox_zone <- input$map_bounds
#st_polygon()
#polyline_test
#What is the best way to extract the lines within the bounds ?
})
#Show layer only at zoom 15
observe({
if (new_zoom() > 15) {
leafletProxy("map") %>%
addPolylines(data = polyline_visible())
}else{
leafletProxy("map") %>% clearShapes()
}
})
}
shinyApp(ui = ui, server = server)
I would like to know the best way to extract the lines within the bounds of the visible map?
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
})
}
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")
}
})
}
)
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 am trying to create a leaflet Shiny app however I keep getting the Warning: Error in derivePoints: addMarkers requires non-NULL longitude/latitude values Error. I have attached the code herewith. Also, a screenshot of the input data files and links to download.
DataBooks.csv
GPSBook.csv
Code:
library(shiny)
library(leaflet)
Location_levels=list(Institutional=0, Provincial=1, National=2, International=3)
DataBook <- read.csv("~/R_Projects/TNL_Network/DataBook.csv", comment.char="#")
GPSBook <- read.csv("~/R_Projects/TNL_Network/GPSBook.csv", comment.char="#")
## Create content for the popups in the markers
popUpContent <- function(ins_id){
subs<-subset(DataBook, Institute_id==ins_id)
name <- subs$Institute[[1]]
return(name[[1]])
}
## Get unique markers based on the location type selected. This function calls the popup content function above and returns a dataframe
markerData <- function(location){
subs1<-subset(DataBook, Location_level<=Location_levels[location])
unique_ins_ids<-levels(factor(subs1$Institute_id))
mdata.list <- vector("list", length(unique_ins_ids))
for(i in 1:length(unique_ins_ids)){
mdata.list[[i]] <- list(subset(GPSBook, Institute_id==unique_ins_ids[i])["Longitude"][[1]], subset(GPSBook, Institute_id==unique_ins_ids[i])["Latitude"][[1]],
as.character(popUpContent(unique_ins_ids[i])))
}
solution <- do.call('rbind', mdata.list)
dataf<-data.frame(solution)
colnames(dataf)<-c("lat", "long", "Msg") ## I ihave mixed up the origincal longitude and latitude. I invert it here.
return(dataf)
}
## Function to create initial data.
initData <- function(){
return(markerData("International"))
}
init_dataset <- initData()
ui <- fluidPage(
leafletOutput("mymap"),
p(),
radioButtons(inputId = "radio", label = "", choices = as.list(levels(DataBook$Location)), selected = "International")
)
server <- function(input, output, session) {
observe({
proxy <- leafletProxy("mymap", data = markerData(input$radio))
proxy %>% clearMarkers()
proxy %>% addMarkers()
})
output$mymap <- renderLeaflet({
leaflet(data = markerData(input$radio)) %>% addTiles() %>%
addMarkers()
})
}
shinyApp(ui, server)
Thanks a lot for the help.
Links to files.
https://drive.google.com/open?id=0B-TWCTRv7UM1bnVpWEIxTnB2d28
https://drive.google.com/open?id=0B-TWCTRv7UM1cjBxNnlhR2ZXc0U
I hope I have understood you intention. If yes this can be simplified a lot.
This is how I would do it. (just change back to the correct directories where your csv files are). The code:
library(shiny)
library(leaflet)
DataBook <- read.csv("./data/DataBook.csv", comment.char="#")
GPSBook <- read.csv("./data/GPSBook.csv", comment.char="#")
names(GPSBook) <- names(GPSBook)[c(1,2,4,3)]
ui <- fluidPage(
leafletOutput("mymap"),
p(),
radioButtons(inputId = "radio", label = "", choices = as.list(levels(DataBook$Location)), selected = "International")
)
server <- function(input, output, session) {
location <- reactive({
tmp <- subset(DataBook, Location_level <= Location_levels[input$radio])
uniqueIds <- unique(tmp$Institute_id)
tmpGps <- subset(GPSBook, Institute_id %in% uniqueIds)
})
observe({
proxy <- leafletProxy("mymap", data = location())
proxy %>% clearMarkers()
proxy %>% addMarkers(popup = ~as.character(Name))
})
output$mymap <- renderLeaflet({
leaflet(data = GPSBook) %>% addTiles() %>%
addMarkers(popup = ~as.character(Name))
})
}
shinyApp(ui, server)
In your original code the function was creating a list so the data was not prepared as leaflet would expect them to be.
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)