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])
})
Related
I'm trying to highlight points in my map based on the user input slider. If the point falls within a certain date range, change the color, and if it doesn't, default it to black.
#server
shinyServer(function(input, output,session) {
output$myMap <- renderLeaflet({
leaflet() %>%
addTiles()%>%
addCircles(data=df,
# ~Longitude,
# ~Latitude,
group = "myMarkers",
label = ~htmlEscape(date))
})
observeEvent(input$selectVariable, {
mydat$col_format<- ifelse(mydat$Date >= input$falltime[1] & mydat$Date <= input$falltime [2],'blue',
ifelse(mydat$Date >= input$springtime[1] & mydat$Date <= input$springtime [2], 'black',
ifelse (mydat$Date, 'yellow')) )
leafletProxy("myMap") %>%
clearGroup("myMarkers") %>%
addCircles(data = df[df$AnimlID == input$selectVariable, ],
#~ mydat$Longitd ,
#~ mydat$Latitud,
group = "myMarkers",
col = mydat$col_format,
label = ~htmlEscape(date)
)
})
})
#ui shinyUI(dashboardPage(#skin = "black",
dashboardHeader(title = "Mapping Test", titleWidth = 350
),
dashboardSidebar(width = 350,
selectInput("selectVariable", label = h4("Select an D:"),
choices = unique(df$id)),
sliderInput("falltime","NSD Fall Slider:",
min = min, max = max, value = c(min, max)),
verbatimTextOutput("dateText"),
sliderInput("springtime","NSD Spring Slider:",
min = min, max = max, value = c(min, max)),
actionButton("submit", ("Submit"))),
dashboardBody(fluidPage(
box( plotOutput("plotlraj")),
box( leafletOutput("myMap")),
box(DT::dataTableOutput("Table"),
)
),
)
))
With the above code I don't get any errors but the map is really slow to load and the points are always blue no matter what the date range the slider input is set to.
I've also tried adding this reactive block but again, all the points are blue even when I change the slider date range
colorpal<- reactive({
if(mydat$Date >= input$falltime[1] & mydat$Date <= input$falltime [2]){
mydat[,'seasonColor']<-'#626262'
}
if(mydat$Date >= input$springtime[1] & mydat$Date <= input$springtime [2]){
mydat[,'seasonColor']<-'#BAF218
'
}
Using quakes so others can replicate.
In the filtered_df reactive function, manipulate your data.frame as you prefer. I prefer using dplyr, but am showing base R.
req() are used to ensure those inputs have values.
There is no need to have addCircles() in the leaflet instantiation. The observe reactive will take care of displaying the circles once filtered_df() is ready and every time it is changed after that.
For brevity, showing just the server code.
output$myMap <- renderLeaflet({
leaflet() %>%
addTiles()
})
filtered_df <- reactive({
req(input$depth_slider,
input$mag_slider)
filtered_df <- quakes[quakes$depth <= input$depth_slider,]
filtered_df[filtered_df$mag <= input$mag_slider, 'Strength'] <- 'Weak'
filtered_df[filtered_df$mag > input$mag_slider, 'Strength'] <- 'Strong'
return(filtered_df)
})
observe({
filtered_df <- filtered_df()
pal <- colorFactor(c('Green', 'Red'), domain = filtered_df$Strength)
leafletProxy('myMap') %>%
clearGroup('myMarkers') %>%
clearControls() %>%
addCircles(
data = filtered_df,
lng = ~long,
lat = ~lat,
group = 'myMarkers',
color = ~pal(Strength)
) %>%
addLegend(
pal = pal,
values = filtered_df$Strength
)
})
I am trying to show maximum distance covered from swimming events for each person in leaflet map with "shinyapp" based on filtering a "Name" and a "SwimType".
Here is my code:
library(shiny)
library(dplyr)
library(shinydashboard)
library(leaflet)
library(osrm)
swimd <- read.csv('swim.csv', stringsAsFactors = F)
ui <- shinyUI(dashboardPage(
dashboardHeader(title = "Training"),
dashboardSidebar("A swim session"),
dashboardBody(
fluidPage(
box("",
leafletOutput("abc", height = 430),
width = 8, height = 450, background = 'black'),
box("",
selectInput('st', label = 'Swim Type:', choices = unique(swimd$SwimStyle)),
selectInput('pn', label = 'Name:', choices = unique(swimd$Name)),
width = 4, height = 450, background = 'black')
)
)
))
server <- shinyServer(function(input, output, session){
a <- reactive({
swimd %>%
select(Name, SwimStyle, Longitude, Latitude) %>%
filter( SwimStyle %in% input$st)
})
observe({
updateSelectInput(session,
inputId='pn',
choices = c("< select Name>"="", a()$Name ))
})
output$abc <- renderLeaflet({
leaflet() %>%
addProviderTiles(providers$OpenStreetMap) %>%
setView(lng=0, lat=0, zoom = 2)
})
observe({
selection <- a() %>% filter(Name %in% input$pn)
selection$res <- distHaversine(selection$Longitude, selection$Latitude, r=6378137)
#to find the difference between two sequence values
selection[ , list(Name, SwimStyle, Longitude, Latitude,res,Diff=diff(res))]
b <- selection %>% arrange(desc(Diff)) %>% top_n(2)
leafletProxy("abc") %>% clearMarkers() %>% addMarkers(lat = b$Latitude, lng = b$Longitude) %>%
addPolylines(route$lon,route$lat,
label = paste(round(route_summary[1]), 'Minutes - ', round(route_summary[2]/1000), 'Meters'),
labelOptions = labelOptions(noHide = TRUE))
flyTo(lat = b$Latitude, lng = b$Longitude, zoom = 2)
})
})
shinyApp(ui,server)
In this app when the name and swim type filtered the maximum distance of swimming should be shown in map with 'polyline'. For an example a person finished 10 mins of swimming. For each 1 min of swimming we record the distance. I would like to show addPolyline for maximum distance covered in a min for each person by selecting a name from the dropdown list as created in this app.
Can someone help me on this use-case?
Thank you.
I cannot get the map to react with the sliders. THe data was from https://www.kaggle.com/nasa/meteorite-landings/data#
when i move the sliders the map "refreshes" like it resets itself as if something were going to change but all of the data points show up on the graph. any help would be appreciated.
library(shiny)
library(dplyr)
library(leaflet)
library(ggplot2)
Meteor <- read.csv()
#to take all NA values out
ReMeteor <- na.omit(Meteor) #from now on using ReMeteor instead of Meteor
ui <- shinyUI(fluidPage(
titlePanel("Meteorite Landings"),
# Sidebar with a sliders and checkbox
sidebarLayout( position = "right",
sidebarPanel(
#1st slider year range
sliderInput("years","The year the meteorite fell, or the year it was found ",
min = min(ReMeteor$year),
max = max(ReMeteor$year),
step = 1,value = c(1399,2013),
animate = TRUE),
#2nd slider mass range
sliderInput("masss","The mass of the meteorite, in grams",
min = min(ReMeteor$mass),
max = max(ReMeteor$mass),
step = 100,value = c(.010,60000000),
animate = TRUE),
#checkbox
selectInput("fall",
"Was meteorite seen falling or found?",
choices = sort(unique(ReMeteor$fall))),
),
mainPanel( leafletOutput("my_leaf",height = 650, width = 605),textOutput("text1"),textOutput("text2")
))))
server <- shinyServer(function(input, output, session) {
#i think this block of four was letting it refresh, although no changes
filtered <- reactive({
ReMeteor[ReMeteor$year >= input$years[1] & ReMeteor$year <= input$years[2],]
ReMeteor[ReMeteor$mass >= input$masss[1] & ReMeteor$mass <= input$masss[2],]
})
#need last checkbox
# filter(ReMeteor >= input$year[1] &
# ReMeteor <= input$year[2]) %>%
# filter(ReMeteor >= input$mass[1] &
# ReMeteor <= input$mass[2])%>%
# filter(ReMeteor = sort(unique(ReMeteor$fall)))
# fitBounds()#here it is !!! https://rstudio.github.io/leaflet/shiny.html search : fitbounds --- this too https://rstudio.github.io/leaflet/markers.html
output$my_leaf <- renderLeaflet({
leaflet(data = filtered()) %>%
addMiniMap(zoomLevelOffset = -4) %>%
addProviderTiles("Esri.NatGeoWorldMap")
})
#fitBounds(ReMeteor, ReMeteor$reclong,ReMeteor$reclat,ReMeteor$reclong,ReMeteor$reclat)
observe({
# year_ <-input$year
# mass_ <-input$mass
# fall_ <-input$fall
#
leafletProxy("my_leaf", data = filtered()) %>%
clearShapes() %>%
clearMarkers() %>%
clearPopups() %>%
addMarkers(lat = ReMeteor$reclat,
lng = ReMeteor$reclong,
clusterOptions = markerClusterOptions(),
popup = as.character(ReMeteor$name,ReMeteor$recclass))
})
output$text1 <- renderText({
paste("You have chosen a range from the year", input$years[1], "to", input$years[2])
})
output$text2 <- renderText({
paste("You have chosen a range of mass from", input$masss[1], "to", input$masss[2], "grams")
})
})
shinyApp(ui, server)
The issue here is that although you correctly used the reactive value filtered() in your leafletProxy call, you use the non-reactive version of ReMeteor in your addMarkers call.
observe({
leafletProxy("my_leaf", data = filtered()) %>%
clearShapes() %>%
clearMarkers() %>%
clearPopups() %>%
addMarkers(lat = filtered()$reclat,
lng = filtered()$reclong,
clusterOptions = markerClusterOptions(),
popup = as.character(filtered()$name,filtered()$recclass))
})
I am very new to shiny, and I have a question.
I have a simple dataset with observations (Number_Total) of species (Species), in a certain location (X,Y).
I would like to generate a map, that enables you to select the species in a dropdown menu. Shiny then shows you were the species occurs on the map.
I got pretty far (for my experience), but selecting species in the menu does not do anything...
ui <- (fluidPage(titlePanel("Species Checker"),
sidebarLayout(
sidebarPanel(
selectizeInput('species', 'Choose species',
choices = df$Species, multiple = TRUE)
),
mainPanel(
leafletOutput("CountryMap",
width = 1000, height = 500))
)
))
The server side
server <- function(input, output, session){
output$CountryMap <- renderLeaflet({
leaflet() %>% addTiles() %>%
setView(lng = 10, lat = 40, zoom = 5) %>%
addCircles(lng = df$Y, lat = df$X, weight = 10,
radius =sqrt(df$Number_Total)*15000, popup = df$Species)
})
observeEvent(input$species, {
if(input$species != "")
{
leafletProxy("CountryMap") %>% clearShapes()
index = which(df$Species == input$species)
leafletProxy("CountryMap")%>% addCircles(lng = df$X[index],
lat = df$Y[index],
weight = 1,
radius =sqrt(df$Number_Total[index])*30, popup = df$Species[index])
}
})
}
And finally plot it
shinyApp(ui = ui, server = server)
I know my code is probably messy, but again, I blaim my experience =)
I did not manage to get an example dataset in here right away, so here it comes as picture
This is the result of the above code (with slightly different data)
enter image description here
Here's what you need. I think you are skilled enough to understand this but comment if you have any questions.
server <- function(input, output, session) {
# map_data <- reactive({
# req(input$species)
# df[df$Species %in% input$species, ]
# })
output$CountryMap <- renderLeaflet({
leaflet() %>% addTiles() %>%
setView(lng = 10, lat = 40, zoom = 5)
})
map_proxy <- leafletProxy("CountryMap")
observe({
md <- df[df$Species %in% input$species, ]
map_proxy %>%
addCircles(lng = md$Y, lat = md$X, weight = 10,
radius = sqrt(md$Number_Total)*15000, popup = md$Species)
})
}
I am a beginner in R mapping and I am trying to build an R Shiny app to visualise Student Satisfaction and 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 (say "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 together.
Below you can see my code so far with a screenshot of how it looks as well as the data (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: a substantial portion of code is Copyright by (c) 2017 Stephen McDaniel
Screenshot of app
link to the data: csv_shiny