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)
})
})
Related
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 am trying to visualise a random walk. Not its path, but actually see the marker moving as it wanders around. Something like this.
I have come with this workaround in which I clear all markers and add them again with the new positions at every step.
library(shiny)
library(leaflet)
df <- data.frame(latitude = 10, longitude = 0)
ui <- fluidPage(
sliderInput("time", "date", 0,
1e2,
value = 1,
step = 1,
animate = TRUE
),
leafletOutput("mymap")
)
server <- function(input, output, session) {
points <- eventReactive(input$time, {
df$latitude <- df$latitude + rnorm(1)
df$longitude <- df$longitude + rnorm(1)
df
})
output$mymap <- renderLeaflet({
leaflet() %>%
addTiles()
})
observe({
leafletProxy("mymap") %>%
clearMarkers() %>%
addMarkers(data = points())
})
}
shinyApp(ui, server)
But I found a much more neat solution in this method movingMarker. I was wondering if there's a way to implement it using that javascript code.
I solved my problem as Lauren.
Changing styles when selecting and deselecting multiple polygons with Leaflet/Shiny
The only difference is that I use polylines instead of polygons. I want to select multiple polylines und deselect them at click again. But it doesn't work..it deletes the reselected from the table but not from the map and after a line was deleted from my selected lines I can't select it anymore.
Can someone help me please!
Data
Here is my code:
library(shiny)
library(leaflet)
library(geojsonio)
url <- "pathTogeojson"
geojson <- geojsonio::geojson_read(url, what = "sp")
shinyApp(
ui <- fluidRow(
leafletOutput("map")),
server <- function(input, output, session) {
click_list <- reactiveValues(ids = vector())
output$map <- renderLeaflet({
leaflet() %>%
addTiles() %>%
setView(lng=16.357795000076294, lat=48.194883921677935, zoom = 15) %>%
addPolylines(data=geojson, layerId = geojson#data$name_1, group = "selected", color="red", weight=3,opacity=1)
})
observeEvent(input$map_shape_click, {
click <- input$map_shape_click
proxy <- leafletProxy("map")
click_list$ids <- c(click_list$ids, click$id)
sel_lines <- geojson[geojson#data$name_1 %in% click_list$ids, ]
if(click$id %in% sel_lines#data$id)
{
nameMatch <- sel_lines#data$name_1[sel_lines#data$id == click$id]
click_list$ids <- click_list$ids[!click_list$ids %in% click$id]
click_list$ids <- click_list$ids[!click_list$ids %in% nameMatch]
proxy %>% removeShape(layerId = click$id)
}
else
{
proxy %>% addPolylines(data = sel_lines, layerId = sel_lines#data$id, color="#6cb5bc", weight=5,opacity=1)
}
})
})
I found the solution by my own..my data and my incomprehension were the problem. It only works, when all used columns are type character...so i had to do a type conversion with as.character()
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?
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.