使用leafletProxy()在Shiny中使用多个反应滑块

时间:2017-01-05 20:15:48

标签: r slider shiny leaflet

我是R map的初学者,我正在尝试构建一个Shiny应用程序,以显示英国所有大学的学生满意度和大学排名。

通过传单我已经用标记绘制了大学位置,并添加了带弹出窗口的滑块,以查看学生满意度得分和排名(见截图)。

我们的想法是能够在滑块上选择一组值(例如“满意度从80到90”和“从1到30排名”,应用程序只会显示符合这两个标准的值。

问题在于有多个反应滑块。如果我按照与“满意”滑块相同的方式对“排名”滑块进行编码,则“满意”滑块将采用“排名”值而不是两个独立工作的滑块。

下面你可以看到我的代码到目前为止的截图,其中包含它的外观以及数据(排名滑块的实验部分被注释,因此它们不会干扰)。

任何提示如何继续,以便两个滑块不相互取值?

非常感谢,如果问题非常基本,我很抱歉。

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

1 个答案:

答案 0 :(得分:0)

重命名每个滑块satisfactionranking后,您必须在同一个过滤器中使用这两个范围,以便应用所有条件:

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