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()
Related
below is my code. I have a working map that zooms into each county when clicked on but I want the map to be shaded darker or lighter based on how many zip codes are in a certain place and the count of data in each state.
Any help would be much appreciated!
require(leaflet)
require(maps)
require(maptools)
require(sp)
require(rgeos)
zipdata=data2$LossZipCode
statedata=data2$LossStateAbbreviation
mapStates=map("state",fill=TRUE,plot=FALSE)
mapCounty=map("county",fill=TRUE,plot=FALSE)
shinyApp(
ui = fluidPage(leafletOutput('myMap'),
br(),
leafletOutput('myMap2')),
server <- function(input, output, session) {
#leafletOutput("myMap"),br(),leafletOutput("myMap2")
output$myMap=renderLeaflet({
leaflet()%>%
addProviderTiles("Stamen.TonerLite",options=providerTileOptions(noWrap=TRUE))%>%
addPolygons(lng=mapStates$x, lat=mapStates$y,fillColor=topo.colors(10,alpha=NULL),stroke=FALSE)
})
observeEvent(input$myMap_shape_click, {
click <- input$myMap_shape_click
if(is.null(click))
return()
lat <- click$lat
lon <- click$lng
coords <- as.data.frame(cbind(lon, lat))
point <- SpatialPoints(coords)
mapStates_sp <- map2SpatialPolygons(mapStates, IDs = mapStates$names)
i <- point [mapStates_sp, ]
selected <- mapStates_sp [i]
mapCounty_sp <- map2SpatialPolygons(mapCounty, IDs = mapCounty$names)
z <- over(mapCounty_sp, selected)
r <- mapCounty_sp[(!is.na(z))]
output$myMap2 <- renderLeaflet({
leaflet() %>%
addProviderTiles("Stamen.TonerLite",
options = providerTileOptions(noWrap = TRUE)) %>%
addPolygons(data=r,
fillColor = topo.colors(10, alpha = NULL),
stroke = FALSE)
})
})
})
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 would like to highlight a row of a datatable in a Shiny app based on a marker clicked on a leaflet map. To do so I have to change the page and go to page 5 if row 46 is selected for example.
It works fine if I do not change the rows order.
If I reorder the rows (for example on ascending val), I cannot find a way to go to the page corresponding to the selected row.
I have ckecked the dataTableProxy manual but it has not helped.
Any help would be much appreciated.
A code example you can run:
ui.R
library(shiny)
library(leaflet)
library(DT)
shinyUI(fluidPage(
mainPanel(
leafletOutput("Map"),
dataTableOutput("Table")
)
))
server.R
library(shiny)
library(leaflet)
library(DT)
shinyServer(function(input, output) {
nbpts <- 50
center <- c(47,3)
ref <- 1:nbpts
lat <- rnorm(nbpts, center[1], 2)
lng <- rnorm(nbpts, center[2], 2)
val <- sin(lat+lng)
data <- data.frame(ref, lat, lng,val)
output$Table <- renderDataTable({
DT::datatable(data, selection = "single")
})
TableProxy <- dataTableProxy("Table")
output$Map <- renderLeaflet({
data_map <- leaflet(data) %>%
addTiles() %>%
addCircleMarkers(
lng=~lng,
lat=~lat,
layerId = ~ref,
radius = 4,
color = "purple",
stroke = FALSE,
fillOpacity = 0.5
)
data_map
})
observeEvent(input$Map_marker_click, {
clickId <- input$Map_marker_click$id
dataId <- which(data$ref == clickId)
TableProxy %>%
selectRows(dataId) %>%
selectPage(dataId %/% 10 + 1)
})
})
It seems that for the rows you should filter for the ref number and the page number you should calculate with the help of the actual row number.
This should help you:
observeEvent(input$Map_marker_click, {
clickId <- input$Map_marker_click$id
dataTableProxy("Table") %>%
selectRows(which(data$ref == clickId)) %>%
selectPage(which(input$Table_rows_all == clickId) %/% 10 + 1)
})
Upvote, because the question was quite interesting.
Edit:
Credits to NicE for the hint for the dynamic table length variable, see the comments.
output$Table <- renderDataTable({
DT::datatable(data, selection = "single",options=list(stateSave = TRUE))
})
observeEvent(input$Map_marker_click, {
clickId <- input$Map_marker_click$id
dataTableProxy("Table") %>%
selectRows(which(data$ref == clickId)) %>%
selectPage(which(input$Table_rows_all == clickId) %/% input$Table_state$length + 1)
})
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'm creating a shiny leaflet map to record where I have been. I have a dataset contains coordinates and time. In my shiny app I've got 2 widgets-- a sliderbard for time line, a dropdown box to show the current countries that I have been. The country choices in the dropdown box is based on the time line sliderbar. Say for example: before 2016 all coordinates on the map are in country A then in the dropdown box there will be only one option in the dropdown box (country A). After 2016-01-01, the number of countries that I have been increased to 2 then in the dropdown box there will be 2 options (country A and country B) and currently this function works well.
Now I want to further develop my shiny app, the function I want is when I have multiple countries in the dropdown box, the app should allow me to choose one of the countries and when the country is chosen, the leaflet map will focus on the country I choose. I think using if else in setview() should solve the problem.
Then I created a (partially) workable shiny script below:
global.R
df <-read.csv("https://dl.dropbox.com/s/5w09dayyeav7hzy/Coordinatestest.csv",
header = T,
stringsAsFactors = F)
df$Time <- as.Date(df$Time, "%m/%d/%Y")
countriesSP <- getMap(resolution='low')
and
ui.R
library(devtools)
library(leaflet)
library(htmlwidgets)
library(shiny)
library(shinydashboard)
library(sp)
library(rworldmap)
library(RCurl)
header <- dashboardHeader(
title = 'Shiny Memery'
)
body <- dashboardBody(
fluidRow(
tabBox(
tabPanel("My Map", leafletOutput("mymap",height = 550)),
width = 700
))
)
dashboardPage(
header,
dashboardSidebar(
sliderInput('Timeline Value','Time line',min = min(df$Time),max = max(df$Time), value = min(df$Time)),
selectInput("select_country", label = "Select Country",
choices = NULL,
selected = NULL)
),
body
)
and
server.R
shinyServer(function(input, output, session) {
output$mymap <- renderLeaflet({
df <- subset(df, df$Time <= input$`Timeline Value`)
observe({
pointsSP <- SpatialPoints(df[,c("lon", "lat")], proj4string=CRS(proj4string(countriesSP)))
indices <- over(pointsSP, countriesSP)
part_choices <- as.list(c("All", na.omit(unique(as.character(indices$ADMIN)))))
updateSelectInput(session, "select_country", choices=part_choices)
})
lng <- ifelse(input$select_country == "All", mean(df$lon), 0)
lat <- ifelse(input$select_country == "All", mean(df$lat), 0)
m <- leaflet(df) %>%
addTiles(
#urlTemplate = "http://otile4.mqcdn.com/tiles/1.0.0/sat/{z}/{x}/{y}.png"
) %>% # Add default OpenStreetMap map tiles
#setView(mean(df$lon), mean(df$lat), zoom = 5) %>%
setView(lng, lat, zoom = 5) %>%
addMarkers(~lon, ~lat,
clusterOptions = markerClusterOptions())
})
})
Please copy and paste the script into Rstudio and run it. You will see as you drag the time line till the end, the country option will increase but default is always All. Ideally when I select one country and as you see based on some simple logic as long as the selection is not All, the coordinates in setview() function should be (0,0) (this can be dynamic later, currently I just want setview() to change the focus of the map). This function is not really working currently, i.e. when I select other country, the focus of the map will change to (0,0) but again change back to the default focus (mean(df$lon), mean(df$lat)) immediately and the selection will change back to All as well.
So any idea on how to alter my code to make this work?
Hope you are clear about my situation in this example.
Much appreciate for the help
I have changed the server.R part how I think this should be done. Let me know if this helps.
server.R
shinyServer(function(input, output, session) {
dfs <- reactive({
tmp <- subset(df, df$Time <= input$`Timeline Value`)
tmp
})
part_choices <- reactive({
tmp <- dfs()
pointsSP <- SpatialPoints(tmp[,c("lon", "lat")], proj4string=CRS(proj4string(countriesSP)))
indices <- over(pointsSP, countriesSP)
as.list(c("All", na.omit(unique(as.character(indices$ADMIN)))))
})
observe({
updateSelectInput(session, "select_country", choices=part_choices())
})
output$mymap <- renderLeaflet({
lng <- ifelse(input$select_country == "All", mean(df$lon), 0)
lat <- ifelse(input$select_country == "All", mean(df$lat), 0)
m <- leaflet(dfs()) %>%
addTiles(
#urlTemplate = "http://otile4.mqcdn.com/tiles/1.0.0/sat/{z}/{x}/{y}.png"
) %>% # Add default OpenStreetMap map tiles
#setView(mean(dfs()$lon), mean(dfs()$lat), zoom = 5) %>%
setView(lng, lat, zoom = 5) %>%
addMarkers(~lon, ~lat,
clusterOptions = markerClusterOptions())
})
})