时间戳

首页 > 解决方案 > 带有反应式滑块输入的闪亮传单地图

r - 带有反应式滑块输入的闪亮传单地图

问题描述

我有一个看起来像这样的数据集：

Dataset <- data.frame(
  "Type" = c("A", "B", "A", "B"),
  "Value" = c(1000000, 200, 4000000, 150),
  "Lat" = c(40.7, 41.8, 42.4, 43.1), 
  "Long" = c(-3.2, -2.1, -1.6, -3.1)
)

Type    Value   Lat   Long
 A     1000000  40.7  -3.2
 B       200    41.8  -2.1
 A     4000000  42.4  -1.6
 B       150    43.1  -3.1

我使用Lat和Long作为坐标在传单地图中将每个点显示为标记，但正如您所见，Value范围因Type. 为了使我的地图更加用户友好，我启用了 apickerInput()让我选择Type要在地图上显示的 ，然后启用 asliderInput()来选择Value. 使用reactive()I 过滤地图的点。

我的问题是我无法sliderInput()根据Type. pickerInput我只设法得到一个覆盖整个范围的滑块，在上面的示例数据中，它是从 150 到 4000000。

根据pickerInput. 到目前为止我的代码：

library(shiny)
library(shinyWidgets)
library(dplyr)
library(leaflet)

ui <- bootstrapPage(
  absolutePanel(top = 10, right = 10,
   sliderInput("range", "Value", min(Dataset$Value, na.rm = TRUE), max(Dataset$Value, na.rm = TRUE),
      value = range(Dataset$Value, na.rm = FALSE), step = 1000),
    pickerInput("Type", "Type", choices = c("A", "B"),      selected = c("A", "B"), multiple = T, options = list(`actions-box` = TRUE)),
  ),
  leafletOutput("map", width = "50%")
)

server <- function(input, output) {
  
  filteredData <- reactive({
    Dataset %>% 
    filter(Type %in% input$Type) %>%
    filter(Value >= input$range[1]) %>% 
    filter(Value <= input$range[2])
 })

  output$map <- renderLeaflet({
    leaflet(Dataset) %>% addTiles() %>% addMarkers(data = filteredData(), lng = ~Long, lat = ~Lat)
  })
}

shinyApp(ui, server)

标签： rshinyleaflet

解决方案

您可以使用（当您想要更新选择时updateSliderInput()更一般地使用功能）。update*()不要忘记添加session。function(input, output)在这里，我们可以分两步过滤数据：

  • 首先，我们选择类型。这将确定滑块的范围。

  • 其次，滑块更新后，我们选择范围。

这是完整的示例：

library(shiny)
library(shinyWidgets)
library(dplyr)
library(leaflet)

Dataset <- data.frame(
  "Type" = c("A", "B", "A", "B"),
  "Value" = c(1000000, 200, 4000000, 150),
  "Lat" = c(40.7, 41.8, 42.4, 43.1), 
  "Long" = c(-3.2, -2.1, -1.6, -3.1)
)
ui <- bootstrapPage(
  absolutePanel(
    top = 10,
    right = 10,
    sliderInput(
      "range",
      "Value",
      min(Dataset$Value, na.rm = TRUE),
      max(Dataset$Value, na.rm = TRUE),
      value = range(Dataset$Value, na.rm = FALSE),
      step = 1000
    ),
    pickerInput(
      "Type",
      "Type",
      choices = c("A", "B"),
      selected = c("A", "B"),
      multiple = T,
      options = list(`actions-box` = TRUE)
    ),
  ),
  leafletOutput("map", width = "50%")
)

server <- function(input, output, session) {
  
  filter_type <- reactive({
    Dataset %>%
      filter(Type %in% input$Type)
  })
  
  observeEvent(input$Type, {
    updateSliderInput(
      session = session,
      inputId = "range",
      min = min(filter_type()$Value),
      max = max(filter_type()$Value),
      value = range(filter_type()$Value, na.rm = FALSE)
    )
  })
  
  filter_range <- reactive({
    filter_type() %>% 
      filter(Value >= input$range[1]) %>% 
      filter(Value <= input$range[2])
  })
  
  output$map <- renderLeaflet({
    leaflet(Dataset) %>% 
      addTiles() %>% 
      addMarkers(data = filter_range(), lng = ~Long, lat = ~Lat)
  })
}

shinyApp(ui, server)

推荐阅读