I'm new to shiny and leaflet and I would appreciate any pointers. The code below is an attempt to map points over a base map. It works, but not reactively.
The points come from a data frame (imported from CSV), which I can map. However, at the top of the app, I created a checkbox to let the user choose features. The idea is that selection will determine which rows are passed forwards, and therefore which points are mapped. This is the step I'm struggling with. In the code, I'm now passing the full list of possible points from the data frame, not from the output of the filtering (checkbox input). How do I pass the result of the filtering process instead?
My approach is to grab the cols with coordinates to create a data frame with cbind(), passing this to points; but perhaps one could pass the relevant cols from the filtered data directly. Thank you.
library(shiny)
library(leaflet)
library(dplyr)
parks <- read.csv("data.csv")
r_colors <- rgb(t(col2rgb(colors()) / 255))
names(r_colors) <- colors()
ui <- fluidPage(
# First row for selectInputs
fluidRow(
column(4,
checkboxGroupInput(inputId = "d_Governorate",
label = "Governorate:",
choices = c("All",
unique(as.character(parks$Governorate))),
selected = "All"
)
),
leafletOutput("d_map")
)
)
server <- function(input, output, session) {
points <- reactive({
validate(
need(input$d_Governorate != "", 'Please choose at least one feature.')
)
temp <- select(parks, lon, lat)
if (input$d_Governorate != "All") {
temp <- filter(parks, Governorate %in% input$d_Governorate) %>%
select(lon, lat)
}
temp
}),
output$d_map <- renderLeaflet({
leaflet() %>%
addProviderTiles("Stamen.TonerLite",
options = providerTileOptions(noWrap = TRUE)
) %>%
addMarkers(data = points())
})
}
shinyApp(ui, server)
DATA:
https://www.dropbox.com/s/3nq07fbyurur8ec/data.csv?dl=0
I would change the part where you define the point reactive variable with the following code (the code uses the dplyr package):
points <- reactive({
validate(
need(input$d_Governorate != "", 'Please choose at least one feature.')
)
temp <- select(parks, lon, lat)
if (input$d_Governorate != "All") {
temp <- filter(parks, Governorate %in% input$d_Governorate) %>%
select(lon, lat)
}
temp
})
In the UI part add the:
selected = "All"
to the checkboxGroupInput definition.
Related
I want to subset my data set and show only the rows which its column value is different than 0.
This is a fake data set very similar to mine:
library(dplyr)
library(tidyr)
library(leaflet)
library(data.table)
ID<-c("1","10","15")
Bar<-c("2","5","0")
School<-c("3","0","2")
lat<- c(40.43008, 40.42424, 40.43375)
lon<-c(-3.803114,-3.689486,-3.733934)
Results<-data.frame(ID,Bar,School,lat,lon)
As it can be appreciated There are 3 ID (1,10,5).
This is a simulation of the leaflet map I did for a shiny app:
ui <- fluidPage(
mainPanel(
tabsetPanel(
tabPanel("Map",leafletOutput("map"))
),
checkboxGroupInput(
inputId = "profile_input",
label="Choose a Profile of People",
choices = c("Bar","School")
)))
server <- function(input, output, session) {
output$map<-renderLeaflet({
map<- leaflet(Results)
map<- addTiles(map=map)
map<- addCircleMarkers(map=map, lng=~lon,lat=~lat,data=Results)
map
})
}
shinyApp(ui, server)
What I need is the checkboxgroupinput() to filter my data according to "Bar" and "School" and just plot the ID that have a different value than 0.
So for example if I select option "Bar" :
ID "15" has value "0" for "Bar", then I dont want ID 15 to be plotted. But ID "1" & "10" have different values than 0, so I want these 2 IDs to be on the map.
Any ID of how can I do that? I have been struggling with this for a long time!!
One approach would be replacing 0 values with NAs. This will allow you to benefit from the functions that are written to handle NAs in this particular problem (and in other similar cases). Below is a working solution:
# import required packages
library(shiny)
library(leaflet)
library(dplyr)
# construct the dummy data frame
Results <- data_frame(
ID = c("1","10","15"),
Bar = c("2","5","0"),
School = c("3","0","2"),
lat = c(40.43008, 40.42424, 40.43375),
lon = c(-3.803114,-3.689486,-3.733934)
)
# replace 0 values with NAs in order to use na.omit()
Results[Results == 0] <- NA
ui <- fluidPage(
mainPanel(
tabsetPanel(
tabPanel(
"Map",
leafletOutput("map")
)
),
checkboxGroupInput(
inputId = "profile_input",
label="Choose a Profile of People",
choices = c("Bar","School")
)
)
)
server <- function(input, output, session) {
clean_data <- reactive({
# store the needed column names based on user input
var <- c("ID", input$profile_input, "lon", "lat")
# filter the data frame and omit rows that include NAs
na.omit(Results[var])
})
# insert the reactive output of clean_data() where needed below
output$map<-renderLeaflet({
map <- leaflet(clean_data())
map <- addTiles(map = map)
map <- addCircleMarkers(
map = map,
lng = ~lon,
lat = ~lat,
data = clean_data()
)
map
})
}
shinyApp(ui = ui, server = server)
You need to use/create a reactive data-frame, based on input$profile_input, that you can 'feed' to the leaflet.
So, in the server-part:
filteredData <- reactive({
Results[ !Results[ ,input$profile_input] == 0, ]
})
Then later on:
output$map<-renderLeaflet({
map<- leaflet(filteredData())
map<- addTiles(map=map)
map<- addCircleMarkers(map=map, lng=~lon,lat=~lat,data=filteredData())
map
})
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()
The minimal example below renders a leaflet map with 3 markets, and a DT table with 3 records. When a market on the map is selected, so to is the matching record on the table. However, what I cannot do, is to also have the reverse of that, where a clicked row on the table also shows the related popup on the map.
I have been unable to find an example R shiny leaflet app that does something similar.
CODE tweaked to reflect initial comments
library(shiny)
library(leaflet)
library(DT)
library(tidyverse)
# Define UI for application that draws a histogram
ui <- fluidPage(
leafletOutput("opsMap"),
DT::dataTableOutput('ranksDT')
)
# Define server logic required to draw a histogram
server <- function(input, output) {
lats <- c(21.608889,21.693056, 24.04)
longs <- c(-74.650833, -73.095,-74.341944)
popups <- c('a','b','c')
layerids <- c('a','b','c')
iconNames <- c('cog','cog','cog')
iconColors <- c('red','red','red')
sampleData <- tibble(lats,longs, popups,layerids,iconNames,iconColors)
score <- c(7,3,9)
locationRanks <- tibble(popups, score)
output$opsMap <- renderLeaflet({
leaflet() %>%
addTiles() %>%
addAwesomeMarkers(lat = sampleData$lats,
lng = sampleData$longs,
popup = sampleData$popups,
layerId = sampleData$layerids,
icon = makeAwesomeIcon(icon=sampleData$iconNames,
markerColor=sampleData$iconColors))
})
output$ranksDT <- DT::renderDataTable({
d1 <- datatable(locationRanks,
selection = 'single',
rownames=FALSE,
options = list(dom = 'tpi',
pageLength =5,
paging=FALSE,
searching=FALSE
)
)
d1
})
# create a reactive value that will store the click position
mapClick <- reactiveValues(clickedMarker=NULL)
mapClick <- reactiveValues(clickedGroup=NULL)
# create a reactive for the DT table
locationClick <-reactiveValues(clickedRow = NULL)
# observe click events
observe({
mapClick$clickedMarker <- paste(input$opsMap_marker_click$id)
mapClick$clickedGroup <- paste(input$opsMap_marker_click$group)
locationClick$clickedRow <- input$ranksDT_rows_selected
})
# define a proxy variable for the plant rank table
proxy1 = dataTableProxy('ranksDT')
# when map is clicked, make the same table row selection - need row number
observeEvent(input$opsMap_marker_click$id, {
a <- which(locationRanks[1] == input$opsMap_marker_click$id)
proxy1 %>% selectRows(a)
})
proxy2 = leafletProxy('opsMap', session = shiny::getDefaultReactiveDomain())
# if table is clicked, select the same market from the map
observeEvent(locationClick$clickedRow, {
a <- as.character(locationRanks[locationClick$clickedRow,1])
cat(file=stderr(),"clicked row", locationClick$clickedRow, a,'\n')
#proxy2 %>% opsMap_marker_click$id <- a
})
}
# Run the application
shinyApp(ui = ui, server = server)
A solution could be to use input$map01_marker_click$id together with dataTableProxy(), selectRows() and selectPage() if you want to highlight rows in the datatable.
In order to highlight markers, i think you could either use some javascript to simulate a click on the marker. But i would also go for the easier way to adding a highlighted marker and removing it afterwards.
Basically your question was partly answered in this question: Shiny - how to highlight an object on a leaflet map when selecting a record in a datatable? and the remaining part was in one of the answers. -> credits to them.
As the code was quity lengthy, i made the effort to reduce it towards a minimal reproducible example.
Minimal reproducible example:
library(shiny)
library(leaflet)
library(DT)
qDat <- quakes[1:10, ]
qDat$id <- seq.int(nrow(qDat))
ui <- fluidPage(
mainPanel(
leafletOutput('map01'),
dataTableOutput('table01')
)
)
server <- function(input,output){
output$table01 <- renderDataTable({
DT::datatable(qDat, selection = "single", options = list(stateSave = TRUE))
})
# to keep track of previously selected row
prev_row <- reactiveVal()
# new icon style
highlight_icon = makeAwesomeIcon(icon = 'flag', markerColor = 'green', iconColor = 'white')
observeEvent(input$table01_rows_selected, {
row_selected = qDat[input$table01_rows_selected, ]
proxy <- leafletProxy('map01')
proxy %>%
addAwesomeMarkers(popup = as.character(row_selected$mag),
layerId = as.character(row_selected$id),
lng = row_selected$long,
lat = row_selected$lat,
icon = highlight_icon)
# Reset previously selected marker
if(!is.null(prev_row())){
proxy %>%
addMarkers(popup = as.character(prev_row()$mag),
layerId = as.character(prev_row()$id),
lng = prev_row()$long,
lat = prev_row()$lat)
}
# set new value to reactiveVal
prev_row(row_selected)
})
output$map01 <- renderLeaflet({
leaflet(data = qDat) %>%
addTiles() %>%
addMarkers(popup = ~as.character(mag), layerId = as.character(qDat$id))
})
observeEvent(input$map01_marker_click, {
clickId <- input$map01_marker_click$id
dataTableProxy("table01") %>%
selectRows(which(qDat$id == clickId)) %>%
selectPage(which(input$table01_rows_all == clickId) %/% input$table01_state$length + 1)
})
}
shinyApp(ui = ui, server = server)
This is not a solution, just some things that I found out about the code when looking at it.
The ID plantRanks only appears once in your code.
That is in input$plantRanksDT_rows_selected. Such things are easy to find and easy to fix. The correct id should be the output id of the datatable, so ranksDT. Once you replace that, you will see a second issue
proxy2 %>% opsMap_marker_click$id <- a makes no sense.
input$opsMap_marker_click$id exists but can obviously not be written. I don't exactly know how leaflet proxys work, but
leaflet::addMarkers()
looks promising. Good luck!
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())
})
})