Question

我有一组数据，它们在不同位置具有不同的日期范围。我希望我的日期范围小部件在使用选择框小部件选择位置后更新最小日期和最大日期。

我尝试了https://mastering-shiny.org/action-dynamic.html#hierarchical-select中提到的步骤，并针对日期范围小部件对其进行了修改，但它似乎无法正常工作。我在下面添加了一个reprex，选择位置B或C但不选择位置A之后，开始日期似乎没有更新。


# Loading up packages required ----

packages <-
  c("data.table", "lubridate", "magrittr", "stringr", "shiny")

invisible(lapply(packages, library, character.only = TRUE))

rm(packages)

# Dummy data ----

set.seed(5L)

dummy_data <- data.table(
  location = c(rep("A", 10L),
               rep("B", 5L),
               rep("C", 3L)),
  date = c(
    seq.Date(Sys.Date() - 10L, by = 1L, length.out = 10L),
    seq.Date(Sys.Date() - 5L, by = 1L, length.out = 5L),
    seq.Date(Sys.Date() - 3L, by = 1L, length.out = 3L)
  ),
  counts = round(runif(18L) * 10L, digits = 0L)
)

# Define UI ----
ui <- fluidPage(

  sidebarLayout(

    sidebarPanel(
      h3('Filtering Criteria'),
      selectInput("location", label = h4('Location'), 
                  choices = c("All", unique(dummy_data$location))),
      dateRangeInput("date_range",
                     label = h4('Date Range (YYYY-MM-DD)'),
                     min = min(dummy_data$date),
                     start = min(dummy_data$date),
                     max = max(dummy_data$date),
                     end = max(dummy_data$date))
    ),

    mainPanel(
      h4('Dashboard'),
      tableOutput("data")
    )

  )

)

# Define server logic ----
server <- function(input, output, session) {

  # Filter location
  location_filter <- reactive({
    if (input$location == "All") {
      dummy_data
    } else {
      dummy_data[location == input$location]
    }
  })
  observeEvent(location_filter(), {
    updateDateRangeInput(session,
                         "date_range",
                         min = min(location_filter()$date),
                         start = min(location_filter()$date),
                         end = max(location_filter()$date),
                         max = max(location_filter()$date))
  })

  # Table Output
  output$data <- renderTable({
    location_filter() %>%
      .[date >= input$date_range[1] & date <= input$date_range[2]] %>%
      .[, date := as.character(date)]
  })

}

# Run the app ----
shinyApp(ui = ui, server = server)

我刚接触光泽，因为我是2-3周前才拿起它，所以如果这是一个菜鸟错误，请对我保持温柔。

Answer 1

问题似乎出在同时设置min / start或max / end上。您必须始终确保start和end都在[min和max]范围内。最简单的方法是将更新分为多个阶段：

将min和max设置为最早和最新的日期数据集
将start和min设置为最早和最晚的日期当前位置
将min和max设置为最早和最新的日期在当前位置

我在一次对updateDateRangeInput的呼叫中合并了1和2。

这很混乱，但似乎可以正常工作。

我调查了您的反应堆的结构，同时调查了它们的更新是否存在优先权。这是整个服务器功能。

server <- function(input, output, session) {
  locationData <- reactive({
    if (input$location == "All") {
      dummy_data
    } else {
      dummy_data[location == input$location]
    }

  })

  filteredData <- reactive({
    locationData() %>%
      .[date >= input$date_range[1] & date <= input$date_range[2]] %>%
      .[, date := as.character(date)]
  })

  # Filter location
  observeEvent(input$location, {
    updateDateRangeInput(session,
                         "date_range",
                         min = min(dummy_data$date),
                         max = max(dummy_data$date),
                         start = min(locationData()$date),
                         end = max(locationData()$date))
    updateDateRangeInput(session,
                         "date_range",
                         min = min(locationData()$date),
                         max = max(locationData()$date))
  })
  # Table Output
  output$data <- renderTable({
    filteredData()
  })
}

我很想将其发布为Rstudio的问题，以查看这是否是预期的行为。

闪亮的问题：: updateDateRangeInput（）

1 个答案: