Search code examples
rshinyr-leaflet

Multiple Reactive Sliders in Shiny using leafletProxy()


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).

Do you have any tips how to continue so the two slider don't take values from each other?

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:

enter image description here

Link to used Data


Solution

  • 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]) 
        })