R Shiny Leaflet Server Won't Change Map Output - r

I'm new to making maps with Shiny but my goal is to create an interactive map that changes when you select various inputs. For example: when you select the month, it will only display markers from that given month. When you select the year it will display observations from that year AND month (and so on).
Right now I am able to get my map to render but the points that appear on the map do not correspond with what the user selects in the drop down options.
Here is the code I have tried:
library(shiny)
library(dplyr)
library(leaflet)
SampleData <- data.frame(year = c('2017', '2018', '2019', '2020'),
lon = c(38.62893, 38.62681, 38.62797, 38.62972),
lat = c(-90.26233, -90.25272, -90.26232, -90.25703),
month = c('January', 'February', 'March', 'April', 'May'),
new_use = c('Industrial', 'Institutional', 'Commercial', 'Residential')
use <- sort(unique(SampleData$new_use))
years <- sort(unique(SampleData$year))
months <- sort(unique(SampleData$month))
ui <- bootstrapPage(
tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
leafletOutput("map", width = "100%", height = "100%"),
absolutePanel(top = 10, right = 10,
selectInput("month", "Month",
choices = sort(unique(SampleData$month))),
selectInput("year", "Year",
choices = sort(unique(SampleData$year))),
selectInput("new_use", "Permit Use",
choices = sort(unique(SampleData$new_use))),
)
)
server <- function(input, output, session) {
output$map <- renderLeaflet({
leaflet() %>%
setView(lng = -90.1994, lat = 38.6270, zoom = 10)%>%
addProviderTiles(providers$CartoDB.Positron)
})
# Reactive expression for the data subsetted to what the user selected
filteredData <- reactive({
dplyr::filter(SampleData, years %in% input$year & use %in% input$new_use & months %in% input$month)
})
observe({
leafletProxy("map") %>%
clearShapes() %>%
addMarkers(data = filteredData(),
~lat, ~lon, popup = paste("<b>Year:</b> ", filteredData()$year, "<br>",
"<b>Permit Type:</b> ", filteredData()$new_use, "<br>"))
})
}
shinyApp(ui, server)
Does anyone have any suggestions? What am I missing?

The filtering in the reactive statement needs to be done by the column names in the data frame. For example, you need 'year' not 'years'.
So the reactive statement should read:
filteredData <- reactive({
dplyr::filter(SampleData, year %in% input$year & new_use %in% input$new_use & month %in% input$month)
})
And to clear the previous markers you want to use clearMarkers() not clearShapes().
However with the sample dataframe provided, a marker will only appear when a specific combination year, month and use are selected (this is after removing 'May' to make all the columns the same length). For example, the first marker will only show when '2017', 'January' and 'Industrial' are all selected by the user as these are the corresponding values associated with the first pair of coordinates (and so on).

Related

Drawing Polygons with leaflet in shiny?

I have a geospatial dataset of monthly average temperatures in the US. I want to display this as a leaflet map in a Shiny app. With a time-slider, users should be able to select a visualisation of each month.
When I try to run my data with codes I found online I run into a number of problems and unfortunately I don't understand exactly where which data is needed.
On Wetransfer I uploaded my dataset Data.
Relevant info about the dataset: I want the slider to run by either the "Valid_Seas" column (monthly values by parts of the US) or "values". The polygons (column: Geometry) should be colored by the column "Prob", this is the monthly average temperature.
Regarding the R.skript: Starting at line 215 is my attempt to create the ShinyApp map, just a you can see here:
ui <- bootstrapPage(
tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
leafletOutput("map", width = "100%", height = "100%"),
absolutePanel(top = 10, right = 10,
style="z-index:500;", # legend over my map (map z = 400)
tags$h3("Average Temperature"),
sliderInput("periode", "Months 2021",
min(tempyear21$values),
max(tempyear21$values),
value = range(tempyear21$values),
step = 1,
sep = ""
)
)
)
#bis hier hin stimmt es
server <- function(input, output, session) {
# reactive filtering data from UI
reactive_data_chrono <- reactive({
tempyear21 %>%
filter(Valid_Seas >= input$periode[1] & Valid_Seas <= input$periode[2])
})
# static backround map
output$map <- renderLeaflet({
leaflet(tempyear21) %>%
addTiles() %>%
fitBounds(-49.57,24.91,-166.99,68.00)
})
# reactive circles map
observe({
leafletProxy("map", data = reactive_data_chrono()) %>%
clearShapes() %>%
addMarkers(lng=~lng,
lat=~lat,
layerId = ~id) # Assigning df id to layerid
})
}
shinyApp(ui, server)
I am very much looking forward to any advice. Kind regards
Pernilla
I spotted three problems with your code. First, your input slider returns number(s), while your data set column Valid_Seas is character ("Jan 2021", etc.). Hence, after you apply filter the dataset is reduced to zero rows. Better use the values column instead.
Second, if you wanted to display month by month, you should pass only one single number as value argument to sliderInput, like
ui <- bootstrapPage(
tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
leafletOutput("map", width = "100%", height = "100%"),
absolutePanel(top = 10, right = 10,
style="z-index:500;", # legend over my map (map z = 400)
tags$h3("Average Temperature"),
sliderInput("periode", "Months 2021",
min(tempyear21$values),
max(tempyear21$values),
value = min(tempyear21$values), # !
step = 1,
animate=TRUE, # add play button
sep = ""
)
)
)
Otherwise, you get an overlay of several months.
Third problem: your dataset has polygons, in your server function you use addMarkers. You need to use addPolygons instead. In order to fill the polygons, you need to determine a color for each number. The classInt and RColorBrewer packages can help you with that:
library(classInt)
library(RColorBrewer)
n <- 3 # number of categories
pal <- RColorBrewer::brewer.pal(n, "Reds")
ivar <- classInt::classIntervals(
tempyear21$Prob, n=n, style="quantile"
)
tempyear21$colcode <- classInt::findColours(ivar, pal)
legend_names <- names(attr(tempyear21$colcode, "table"))
As for the server function, I think you are on the right track with leafletProxy.
server <- function(input, output, session) {
# static map elements
output$map <- renderLeaflet({
leaflet() |> addTiles() |>
fitBounds(-49.57,24.91,-166.99,68.00) |>
addLegend(position="topleft", colors=pal, labels=legend_names)
})
# map handler
map_proxy <- leafletProxy("map", session)
# react on slider changes
observeEvent(input$periode, {
dat <- subset(tempyear21, values == input$periode)
map_proxy |> leaflet::clearShapes() |>
leaflet::addPolygons(
data=dat,
weight=1,
color=dat$colcode, # border
opacity=1,
fillColor=dat$colcode
)
})
}

Shiny + Leaflet reactive function not working

My data consists of columns like lon , lat, region, flat-type and year. I have used leaflet and shiny to create a map with cluster markers.
I included 2 selectInput boxes - one for year and one for the flat-type. Using the reactive function, it keeps giving me this error whenever I run the shiny app.
Error: Don't know how to get location data from object of class
reactiveExpr,reactive
Here's my code
library(shiny)
library(leaflet)
library(dplyr)
ui <- fluidPage(
titlePanel("Transactions for Resale Flats"),
h3("Model A Flats: 3-Room, 4-Room, 5-Room"),
sidebarLayout(position = 'right',
sidebarPanel(
selectInput("year","Year", choices = c("2007","2008",
"2009","2010","2011",
"2012","2013","2014",
"2015","2016","2017"), selected="2007"),
selectInput("type","Flat-Type",choices = c("3 ROOM",'4 ROOM',"5 ROOM"),selected = "3-Room"),
width = 2),
mainPanel(leafletOutput("mymap",height = 650,width=605)))
)
server <- function(input,output, session){
headlinedata<-reactive({
headlinedata%>%
filter(year %in% input$year & flat_type %in% input$type)
})
output$mymap <- renderLeaflet({
leaflet(data=headlinedata) %>%
addTiles() %>%
addMarkers(clusterOptions = markerClusterOptions(),
label = paste(headlinedata$address,',',headlinedata$town))
})
observe(leafletProxy('mymap', data=headlinedata()))%>%
clearMarkers()%>%
addMarkers(clusterOptions = markerClusterOptions(),
label = paste(headlinedata$address,',',headlinedata$town))
}
shinyApp(ui = ui, server = server)
Also this code
observe(leafletProxy('mymap', data=headlinedata()))%>%
clearMarkers()%>%
addMarkers(clusterOptions = markerClusterOptions(),
label = paste(headlinedata$address,',',headlinedata$town))
Whenever I include this, the app will run for a second and then close immediately. This code is supposed to update the map markers whenever the input changes.
Thanks.
First, you need to refer to reactive variables as the variable name followed by (). In output$mymap, you refer to headlinedata, which is the data frame to be filtered, when it should be headlinedata(), which is the reactive variable that's already been filtered. To disambiguate the two, I changed the name of the reactive variable to df. Then, when that reactive variable is needed in code downstream, I refer to it as df().
Second, since df() is a reactive variable and we've set up the leaflet to depend upon it, whenever the reactive variable changes, the map will also change. This means we don't need the observe(leafletProxy ... code.
Here's a reproducible example you can copy and paste.
library(shiny)
library(leaflet)
library(dplyr)
set.seed(1)
headlinedata <- data.frame(year = rep(2007:2017, 10),
flat_type = sample(c("3 ROOM",'4 ROOM',"5 ROOM"),
110, replace=T),
lat = sample(1:50, 110, replace=T),
lng = sample(1:50, 110, replace=T),
address = "address",
town = "town")
ui <- fluidPage(
titlePanel("Transactions for Resale Flats"),
h3("Model A Flats: 3-Room, 4-Room, 5-Room"),
sidebarLayout(position = 'right',
sidebarPanel(
selectInput("year","Year", choices = c("2007","2008",
"2009","2010","2011",
"2012","2013","2014",
"2015","2016","2017"), selected="2007"),
selectInput("type","Flat-Type",choices = c("3 ROOM",'4 ROOM',"5 ROOM"),selected = "3-Room"),
width = 2),
mainPanel(leafletOutput("mymap",height = 650,width=605)))
)
server <- function(input,output, session){
df<-reactive({
headlinedata%>%
dplyr::filter(year %in% input$year & flat_type %in% input$type)
})
output$mymap <- renderLeaflet({
leaflet(data=df()) %>%
addTiles() %>%
addMarkers(clusterOptions = markerClusterOptions(),
label = paste(df()$address,',',df()$town))
})
}
shinyApp(ui = ui, server = server)

Multiple Reactive Sliders in Shiny using leafletProxy()

I'm a beginner in R mapping and I am trying to build a Shiny app to visualise Student Satisfaction and University-Ranking for all the universities in the UK.
Through leaflet I have mapped the university locations with markers and added sliders with popups to see the student Satisfaction Score and the Ranking (see screenshot).
The idea is to be able to choose a set of values on the sliders (e.g "Satisfaction from 80 to 90" and "Ranking from 1 to 30" and the app would only display the ones that fit both criteria.
The problem lies within having multiple reactive sliders. If I code the Ranking slider the same way as the Satisfaction slider, the Satisfaction slider takes on the Ranking values instead of the two sliders working independently.
Below you can see my code so far with a screenshot of how it looks as well as the data (the experimental parts of the Ranking slider are commented so they don't interfere).
Any tips how to continue so the two slider don't take values from each other?
Thanks a lot and sorry if the question is very basic.
library(dplyr)
library(shiny)
library(leaflet)
mapData <- read.csv("~/Desktop/Shiny app/Csv Shiny Data Clean.csv") %>%
filter(!is.na(Latitude) & !is.na(Longitude))
ui <- bootstrapPage(
tags$style(type = "text/css", "html,
body {width:100%;height:100%}"),
leafletOutput("uniSmap", width = "100%", height = "100%"),
#slider for student satisfaction
absolutePanel(
top = 50,
right = 50,
sliderInput(
"range",
"Satisfaction Score",
min = 1,
max = 100,
value = round(range(mapData$Satisfaction.....2016.Registered, na.rm = TRUE), 1),
step = 1
)
),
#slider for Ranking
absolutePanel(
top = 200,
right = 50,
sliderInput(
"range",
"QS University Ranking",
min = 1,
max = 128,
value = round(range(mapData$QS.Ranking, na.rm = TRUE), 1),
step = 1
)
),
#bottom right title
absolutePanel(
bottom = 10,
left = 10,
"Satisfaction Map 2016"
)
)
server <- function(input, output, session) {
filteredData <- reactive({
mapData %>%
filter(Satisfaction.....2016.Registered >= input$range[1] &
Satisfaction.....2016.Registered <= input$range[2])
})
#question here: can I just do the same for Ranking Data (as below)?
# filteredDataRanking <- reactive({
# mapData %>%
# filter(QS.Ranking >= input$range[1] &
# QS.Ranking <= input$range[2])
# })
output$uniSmap <- renderLeaflet({
# as the map is only drawn once
# use non-reactive dataframe, mapData
leaflet(mapData) %>%
addTiles() %>%
fitBounds(~min(Longitude), ~min(Latitude),
~max(Longitude), ~max(Latitude))
})
# Incremental changes to the map performed in an observer.
observe({
leafletProxy("uniSmap", data = filteredData()) %>%
clearShapes() %>%
clearPopups() %>%
clearMarkers() %>%
addMarkers(lat = ~Latitude,
lng = ~Longitude,
popup = ~paste(
Institution,
"<br>",
"Overall Satisfaction:",
Satisfaction.....2016.Registered,
"<br>"
)
)
}) #end of observe for satisfaction
#would I have to create another observe for ranking data (as below)?
# observe({
#
# leafletProxy("uniSmap", data = filteredDataRanking()) %>%
#
# clearShapes() %>%
# clearPopups() %>%
# clearMarkers() %>%
#
# addMarkers(lat = ~Latitude,
# lng = ~Longitude,
# popup = ~paste(
# Institution,
# "<br>",
# "QS University Ranking",
# QS.Ranking,
# "<br>"
# )
# )
#
# }) #end of observe for Ranking
} #end of server description
shinyApp(ui = ui, server = server)
#License: thanks to Stephen McDaniel, from whom a substantial portion of this code is Copyright by ((c) 2017 Stephen McDaniel)
Screenshot of the app
Link to used Data
After renaming each slider satisfaction and ranking you have to use both ranges in same filter so that all conditions are applied:
filteredData <- reactive({
mapData %>%
filter(Satisfaction.....2016.Registered >= input$satisfaction[1] &
Satisfaction.....2016.Registered <= input$satisfaction[2]) &
QS.Ranking >= input$ranking[1] &
QS.Ranking <= input$ranking[2])
})

Change setView dynamically according to select box in R shiny app

I'm developing a leaflet map in R shiny. In this app I want the focus of the map to be changed whenever the lng and lat value in setView() is changed. The lng and lat values are based on what country I select from a drop down box. Previously I use static value for lng and lat in an ifelse() function and the app works. But now the problem is when I want to make things more generic: the lng and lat will be the mean of the longitude and latitude from a subset of the data with the chosen country, the app doesn't show map anymore (from my point of view the calculation seems right)
Below is the simplified and workable R script:
global.R:
library(devtools)
library(leaflet)
library(htmlwidgets)
library(shiny)
library(shinydashboard)
library(sp)
library(rworldmap)
library(RCurl)
library(ggmap)
df <- read.csv(url("https://docs.google.com/spreadsheets/d/1rrEJiuxr4nafTqUQBlPpUdGwvGeGtBJExlPJdday2uw/pub?output=csv"),
header = T,
stringsAsFactors = F)
df$Time <- as.Date(df$Time, "%d/%m/%Y")
ui.R
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 = c(min(df$Time), min(df$Time)+10)),
selectInput("select_country", label = "Select Country",
choices = NULL,
selected = NULL)
),
body
)
server.R
shinyServer(function(input, output, session) {
dfs <- reactive({
tmp <- subset(df, df$Time <= input$`Timeline Value`[2] & df$Time >= input$`Timeline Value`[1])
tmp
})
part_choices <- reactive({
as.list(c("All", unique(as.character(dfs()$Country))))
})
observe({
updateSelectInput(session, "select_country", choices=part_choices())
})
output$mymap <- renderLeaflet({
lng <- ifelse(input$select_country == "All", mean(dfs()$lon),
mean(subset(dfs(), Country %in% input$select_country)$lon)
)
lat <- ifelse(input$select_country == "All", mean(dfs()$lat),
mean(subset(dfs(), Country %in% input$select_country)$lat)
)
m <- leaflet(dfs()) %>%
addTiles(
) %>%
setView(lng, lat, zoom = 5) %>%
addMarkers(~lon, ~lat,
clusterOptions = markerClusterOptions())
})
})
You will see in the server.R part I use ifelse() to change the lng and lat value that later can be used in setView() function. After I changed the else argument into a calculation the app doesn't work anymore.
Really appreciate if someone can tell me where I was wrong.
Thanks in advance.
In your ui.R, try changing your country input to
selectInput("select_country", label = "Select Country",
choices = "All",
selected = "All")
My guess is that the ifelses do not return a number, given that input$select_country is initialized at NULL, which (for reasons that are unclear to me) causes both renderLeaflet and updateSelectInput not to run, preventing the country selector from being updated.

Use the dynamic value from selectinput in R leaflet setview

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())
})
})

Resources