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.
Related
I am attempting to add markers to a map based on coordinates uploaded by a user. I am having trouble storing the file input as a data frame and then passing the coordinates from the data frame to the proxy map to add markers.
ui <- fluidPage(
titlePanel(title = "My Dashboard"),
sidebarLayout(
fileInput(inputId = "file",
label = "File upload"),
mainPanel(
leafletOutput("mymap")
)
)
)
server <- function(input, output) {
m <- leaflet() %>%
setView(lng = -71.0589,
lat = 42.3601,
zoom = 12) %>%
addProviderTiles(providers$CartoDB.Positron)
output$mymap <- renderLeaflet(m)
observe({
input$file
df <- read.csv('input$file$datapath')
proxy <- leafletProxy("mymap", data = df)
proxy %>% addMarkers(~long, ~lat)
})
shinyApp(ui = ui, server = server)
You were almost there, just change the way how you are reading the file to
observe({
req(input$file)
df <- read.csv(input$file$datapath)
proxy <- leafletProxy("mymap", data = df)
proxy %>% addMarkers(~long, ~lat)
})
That is removing the quotes '. The req makes sure that no error is thrown when there is no upload yet. When uploading a csv make sure that there are columns labeled long and lat.
I'm using leaflet to plot a map and to get coordinates from user click.
Next, I want to save these coordinates in a global reactive list, so I can use these coordinates in another module. The problem is that I can't access the reactive list when it's placed on the server function (in app.R escope), neither outside the server function. The only way i found is to put the list of reactives inside the server function on the module server, so obviously is not global anymore.
How should I proceed? I want something like this (code below), so I can use the value saved in 'r' in all modules within the same session (not shared between sessions).
Map Module
mapModuleUI <- function(id){
ns <- NS(id)
leafletOutput(ns('map'), height="600px")
}
mapModuleServer <- function(input, output, session, r){
# MAP plot #####
output$map = renderLeaflet({
leaflet(width = '50 px', height = '50 px') %>% addTiles() %>% setView(-41.65, -22.0285, zoom = 10)
})
# # MAP LOGIC
observe({
click <- input$map_click
leafletProxy('map') %>% removeMarker('pointClicked')
if (is.null(click)){return()}
leafletProxy('map') %>% addMarkers(lng = click$lng, lat = click$lat, layerId = 'pointClicked')
r$lat <- click$lat %>% formatC(digits = 2, format = 'f')
r$lon <- click$lng %>% formatC(digits = 2, format = 'f')
})
} # end server function
app.R
ui <- dashboardPage(skin = 'green',
....
tabItem(tabName = "newGr",
box(mapModuleUI('mapa'))
)
...
)
server <- function(input, output, session) {
r <- reactiveValues()
callModule(mapModuleServer, 'mapa')
}
shinyApp(ui, server)
I am trying to build a R Shiny Dashboard application with Leaflet library. In the application, a user can select the source country, destination country and product. The dataframe is then filtered for this particular combination of inputs. The resulting dataframe is then passed to renderLeaflet and the location data and details are displayed to the user.
My aim is to only render and display the leaflet plot when the filtered dataframe is created after the user input. I have tried using both validate+need and eventReactive for this. I have added some placeholder data in the leaflet call for now.
eventReactive does not return any leaflet map on the dashboard even after user selects input.
For validate+need, the leaflet map and placeholder data are plotted and displayed even before user selects input.
Code for UI.R:
sidebar <- shinydashboard::dashboardSidebar(
selectizeInput(
"srcLoc", label="Source Country", choices=locsAgg$SrcLocation, options=list(create=TRUE, maxItems=100, placeholder="Select a Country")
),
selectizeInput(
"destLoc", label="Destination Country", choices=locsAgg$SonLocation, options=list(create=TRUE, maxItems=100, placeholder="Select a Country")
),
selectizeInput(
"pdt", label="Product", choices=locsAgg$Pdt, options=list(create=TRUE, maxItems=100, placeholder="Select a Product")
)
)
body <- shinydashboard::dashboardBody(
tags$style(type = "text/css", "#map {height: calc(100vh - 80px) !important;}"),
leafletOutput("map")
)
# Put them together into a dashboardPage
dashboardPage(
dashboardHeader(title = "World Map"),
sidebar,
body
)
Code for Server.R for validate + need:
### Using valid and need --> plot still gets plotted
shinyServer<- function(input,output,session){
updateSelectizeInput(session, "srcLoc", choices=locsAgg$SrcLocation, server=T)
locsFil1 <-reactive({
locsAgg %>% filter(SrcLocation %in% input$srcLoc)
})
observeEvent(input$srcLoc, {updateSelectizeInput(session, "destLoc", choices=locsFil1()$SonLocation, server=T)})
locsFil2 <-reactive({
locsFil1() %>% filter(SonLocation %in% input$destLoc)
})
observeEvent(input$destLoc, {updateSelectizeInput(session, "pdt", choices=locsFil2()$Pdt, server=T)})
locsFil3 <-reactive({
locsFil2() %>% filter(Pdt %in% input$pdt)
})
output$map <- renderLeaflet({
validate(
need(locsFil3(), "Select inputs")
)
m <- leaflet(options=leafletOptions(minZoom=1, maxZoom=5, zoomDelta=0.5)) %>%
addProviderTiles(providers$OpenStreetMap) %>% setView(lng=-93.85, lat=37.45, zoom=2)
m <- addMarkers(m, lng=c(12,21) , lat=c(37,67))
})
}
Code for Server.R for eventReactive:
# doesnt work and messes up filters as well
shinyServer<- function(input,output,session){
updateSelectizeInput(session, "srcLoc", choices=locsAgg$SrcLocation, server=T)
locsFil1 <-reactive({
locsAgg %>% filter(SrcLocation %in% input$srcLoc)
})
observeEvent(input$srcLoc, {updateSelectizeInput(session, "destLoc", choices=locsFil1()$SonLocation, server=T)})
locsFil2 <-reactive({
locsFil1() %>% filter(SonLocation %in% input$destLoc)
})
observeEvent(input$destLoc, {updateSelectizeInput(session, "pdt", choices=locsFil2()$Pdt, server=T)})
locsFil3 <-reactive({
locsFil2() %>% filter(Pdt %in% input$pdt)
})
output$map <- eventReactive(locsFil3(), {
renderLeaflet({
m <- leaflet(options=leafletOptions(minZoom=1, maxZoom=5, zoomDelta=0.5)) %>%
addProviderTiles(providers$OpenStreetMap) %>% setView(lng=-93.85, lat=37.45, zoom=2)
m <- addMarkers(m, lng=c(12,21) , lat=c(37,67))
})
}
)
}
Packages used: defined in Global.R:
packages = c("shiny",
"shinydashboard",
"dplyr",
"openxlsx",
"stringr",
"readr",
"tidyr",
"leaflet",
"geosphere")
How do I update the server.R code for the leaflet plot to render only once the filtered dataframe becomes available? Thank you!
It's hard to help without having the dataset locsAgg.
I would try
locsFil3 <- eventReactive(list(locsFil2(), input$pdt), {
locsFil2() %>% filter(Pdt %in% input$pdt)
}, ignoreInit = TRUE)
output$map <- renderLeaflet({
req(locsFil3())
m <- leaflet(options=leafletOptions(minZoom=1, maxZoom=5, zoomDelta=0.5)) %>%
addProviderTiles(providers$OpenStreetMap) %>% setView(lng=-93.85, lat=37.45, zoom=2)
addMarkers(m, lng=c(12,21) , lat=c(37,67))
})
or
locsFil3 <- reactive({
locsFil2() %>% filter(Pdt %in% input$pdt)
})
observeEvent(locsFil3(), {
output$map <- renderLeaflet({
m <- leaflet(options=leafletOptions(minZoom=1, maxZoom=5, zoomDelta=0.5)) %>%
addProviderTiles(providers$OpenStreetMap) %>% setView(lng=-93.85, lat=37.45, zoom=2)
addMarkers(m, lng=c(12,21) , lat=c(37,67))
})
}, ignoreInit = TRUE)
If that does not work, please provide locAggs (edit your question and paste the output of dput(locsAgg), or dput(head(locsAgg,20)) if this is enough).
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()
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)
})
})