Shiny Leaflet map 带电抗 slider 输入

Question

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

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

我在 leaflet map 中将每个点显示为标记，使用Lat和Long作为坐标，但正如您所见， Value范围因Type而有很大差异。 为了使我的 map 更加用户友好，我启用了一个pickerInput()来让我选择要在 map 上显示的Type ，然后是一个sliderInput()来选择Value 。 使用reactive()我过滤了 map 的点。

我的问题是，我无法根据在pickerInput中选择的Type创建反应性sliderInput()范围。 我只设法得到一个覆盖整个范围的 slider，在上面的示例数据中，它是从 150 到 4000000。

我需要从 150 到 200 和从 1000000 到 4000000 的 slider ，具体取决于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)

Answer 1

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

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

• 第二，slider更新后，我们选择范围。

这是完整的示例：

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)