如何使用闪亮的范围滑块过滤传单点地图上的点

时间:2019-08-01 10:34:49

标签: r shiny leaflet gis r-leaflet

我正在尝试使用闪亮和小叶来过滤点图上点的开/关,具体取决于数字变量(“人口”)的值

我加载库和数据


#load libraries

library(shiny)
library(leaflet)

#create fake data

fake_data <- data.frame(Lat = c(51.4, 51.5, 51.7, 53.4, 50.7, 50.9, 51.1, 51.3, 51.4, 51.2),
                        Long = c(-0.1, -0.1, 0.0, -2.1, -2.4, -1.3, -0.3, -0.2, -0.3, 0.1),
                        Population = c(723, 746, 512, 389, 253, 289, 212, 208, 245, 212),
                        Class1 = c(TRUE, TRUE, TRUE, FALSE, FALSE, TRUE, FALSE, TRUE, FALSE, TRUE),
                        Class2 = c(TRUE, FALSE, FALSE, TRUE, TRUE, FALSE, TRUE, FALSE, TRUE, TRUE),
                        TownName = c("Town1", "Town2", "Town3", "Town4", "Town5", "Town6", "Town7", "Town8", "Town9", "Town10"))

并在rStudio中启动有光泽的应用程序,根据fake.data $ Population的范围创建一个范围滑块


#shiny

##ui

ui <- bootstrapPage(
  tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
  leafletOutput("map", width = "100%", height = "100%"),
  absolutePanel(top = 10, right = 10,
                sliderInput("range", "Population", min(fake_data$Population), max(fake_data$Population), value = range(fake_data$Population)
                )
  )
)

我认为问题出在闪亮的应用程序的服务器端代码块上–是在创建slideData或使用watch()函数时出现的。

使用observe()从sliderData中获取数据,如何根据fake_data $ Class1 == TRUE添加标记?

server <- function(input, output, session) {

  sliderData <- reactive({
    fake_data[fake_data$Population >= input$range[1] & fake_data$Population <= input$range[2],]
  })

  output$map <- renderLeaflet({
    leaflet(fake_data) %>% 
      addProviderTiles(providers$Stamen.TonerLite, options = providerTileOptions(minZoom = 6, maxZoom = 10)) %>%
      setView(lng=-1.7, lat=53.9, zoom=6) 
    })  

  observe({
    leafletProxy("map", data = sliderData()) %>%
    clearMarkers() %>%
      addCircleMarkers(data = fake_data[fake_data$Class1 == TRUE,], group = "Class1", popup = ~as.character(TownName), color = 'black', fillOpacity = 1) %>%
      addCircleMarkers(data = fake_data[fake_data$Class2 == TRUE,], group = "Class2", popup = ~as.character(TownName), color = 'red', fillOpacity = 1) %>%
      addLayersControl(
        overlayGroups = c("Class1", "Class2"),
        options = layersControlOptions(collapsed = FALSE),
        position = "bottomright"
      )
  }) 

我希望能够使用滑块设置人口范围,并使传单地图仅显示“人口”在该范围内的那些“镇”的点。

但是,一旦运行,传单地图将始终映射所有点,而范围滑块对地图没有影响。 Image of app output

1 个答案:

答案 0 :(得分:1)

排序


server <- function(input, output, session) {

  sliderData1 <- reactive({
    fake_data[fake_data$Population >= input$range[1] & fake_data$Population <= input$range[2] & fake_data$Class1 == TRUE,]
  })

  sliderData2 <- reactive({
    fake_data[fake_data$Population >= input$range[1] & fake_data$Population <= input$range[2] & fake_data$Class2 == TRUE,]
  })

...在服务器端(两个反应性命令,每个类一个)

随后...


  observe({
    leafletProxy("map", data = sliderData1()) %>%
      clearMarkers() %>%
      addCircleMarkers(data = sliderData1(), group = "Class1", popup = ~as.character(TownName), color = 'black', fillOpacity = 1) %>%
      addCircleMarkers(data = sliderData2(), group = "Class2", popup = ~as.character(TownName), color = 'red', fillOpacity = 1) %>%
      addLayersControl(
        overlayGroups = c("Class1", "Class2"),
        options = layersControlOptions(collapsed = FALSE),
        position = "bottomright"
      )
  }) 

请告知这是否太基本了,以至于无法生存,我会删除...