将反应值从服务器传递到闪亮的ui中的两个条件面板（未嵌套）？答案

【问题标题】：Pass reactive value from server to two conditional panels(not nested) in ui in shiny?将反应值从服务器传递到闪亮的ui中的两个条件面板（未嵌套）？
【发布时间】：2020-01-03 08:32:30
【问题描述】：

我正在制作一个闪亮的应用程序，它将“dateRangeInput”作为输入，并为该“日期范围”内的数据绘制绘图。此外，当输入的日期在数据中不可用时，我使用conditionalPanel 不显示绘图，并向用户显示文本以选择仅在数据中可用的日期。

问题是，无论日期输入如何，条件面板都无法正常工作并且根本没有显示任何内容。（将数据中可用的最大和最小日期限制设置为max 和min 的dateRangeInput 不是一种选择。）。

数据链接：https://drive.google.com/open?id=17ipXwRimovR_QBYT2O1kxSGTzem_bN-1

这是我做过和尝试过的：

# loading the data and making the interpretation of first column proper
wait_data <- transform(read.csv("dummy wait times data of 12 departments.csv", header = TRUE),
                       Date = as.Date(Date, "%d-%m-%y"))

# sorting the data according to dates
wait_data <- data.frame(with(wait_data, wait_data[order(Date),]), 
                        row.names = NULL)



library(shiny)
library(plotly)

ui_function <- fluidPage(
  sidebarLayout(
    sidebarPanel(width = 3,
      dateRangeInput(inputId = 'date_range',
                     label = paste('Choose range from January 1, 2017 to December 31, 2018:'),
                     start = as.Date("2017-01-01"), end = as.Date("2017-05-31"),
                     min = as.Date("2017-01-01"), max = Sys.Date(),
                     separator = " to ", format = "MM-dd, yyyy",
                     startview = 'year', weekstart = 1),
      selectInput(inputId = "department_input", 
                  label = "Choose a Department to see wait times:",
                  choices = c("General Checkup"="General Checkup", 
                              "Emergency"="Emergency",
                              "Cardiology"="Cardiology",
                              "Gynaecology"="Gynaecology",
                              "Maternity"="Maternity",
                              "Neurology"="Neurology",
                              "Oncology"="Oncology",
                              "Orthopedics"="Orthopedics",
                              "Otalaryntology"="Otalaryntology",
                              "Psychiatry"="Psychiatry",
                              "Radiology"="Radiology",
                              "Urology"="Urology"),
                  multiple = TRUE,
                  selected = c("Cardiology","Gynaecology"))
    ),
    mainPanel(width = 9,
      uiOutput("plots_or_text")
      # uiOutput("resource_or_moretext")
      # conditionalPanel(
      #   condition = "output.dates_matches",
      #   plotlyOutput("wait_times_plot"),
      #   dataTableOutput("resource_counts")
      # ),
      # conditionalPanel(
      #  condition = "output.dates_matches",
      #   htmlOutput("select_available_dates")
      # )

      )
    )
  )


server_function <- function(input, output) {

  min_date_in_data <- reactive({min(wait_data[,"Date"])})
  max_date_in_data <- reactive({max(wait_data[,"Date"])})


  # output$dates_matches <- reactive ({
  #   if (input$date_range[2] > max_date_in_data() | input$date_range[1] < min_date_in_data()){return(FALSE)}
  #   else if (input$date_range[2] <= max_date_in_data() | input$date_range[1] >= min_date_in_data()){return(TRUE)}
  #   })
  # 
  # 
  # # output$select_good_dates <- renderText({dates_matches()})
  # output$select_available_dates <- renderText({paste("select dates available in data")})


  # now filter based on date range inputs
  date_range_data <- reactive({
    wait_data[(wait_data[,"Date"] > input$date_range[1] & wait_data[,"Date"] < input$date_range[2]), ]
  })


  # now take the data returned from above aggregation and filter it for department selection.
  filtered_department_data <- reactive({date_range_data()[date_range_data()[,"Department"] %in% input$department_input, ]})


  # # plot it now
  # output$wait_times_plot <- renderPlotly({
  #   plot_ly(data = filtered_department_data(),
  #           x = ~Date, y=~average_wait_time_min,
  #           split = ~Department,
  #           type = "scatter", mode="lines+markers")
  # })



  output$plots_or_text <- renderUI({

    if (input$date_range[2] <= max_date_in_data() | input$date_range[1] >= min_date_in_data()){
        renderPlotly({plot_ly(data = filtered_department_data(),
                              x = ~Date, y=~average_wait_time_min, split = ~Department,
                              type = "scatter", mode="lines+markers")
          })
      }
    else if (input$date_range[2] > max_date_in_data() | input$date_range[1] < min_date_in_data()){
      renderText({paste("select dates available in data")})
    }
  })

}

shinyApp(ui_function, server_function)

该代码返回 object of type 'closure' is not subsettable 在我的mainPanel 中。

编辑 1：服务器变化：

make_plot <- reactive({
# I've copied the below condition from my if
validate(
     need(input$date_range[2] <= max_date_in_data() | input$date_range[1] >= min_date_in_data(),
          message = "Seems like you've selected dates out of range. Please change your filters."))

    plot_ly(data = filtered_department_data(),
            x = ~Date, y=~average_wait_time_min, split = ~Department,
            type = "scatter", mode="lines+markers")
    # ggplot(data = filtered_department_data(),
    #        aes(x = Date, y=average_wait_time_min, split = Department)) + geom_line() + geom_point()
  })

  output$plot_or_error <- renderPlotly(make_plot())
  # output$plot_or_error <- renderPlot(make_plot())

我无法解决这个问题。无论dateRangeInput 中的输入如何，两个库的图都会显示。如果所选日期范围的数据不可用，则只有一个空白图，在这种情况下不会显示任何错误消息。

【问题讨论】：

conditionalPanel 适用于 UI 中的元素。例如，操作按钮“显示更多”打开一个显示更多内容的框，操作按钮和框都在ui 中定义。但是在您的应用程序中，绘制与发送错误消息的决定是基于server 中的过滤，而ui 不知道server 中的任何值，只有那些通过output$ 明确发送给它的值。因此，您想通过renderUI 创建适当的元素并将其发送到ui 通过output$name，而在ui 中您有uiOutput("name")。
object of type 'closure' is not subsettable，这是我在您提出建议后对上述代码更改的错误。
请检查我的问题中的编辑，@teofil
很难调试，因为我们没有您的完整代码或数据。但更简单更好的解决方案是使用validate。请参阅我的答案，例如无需renderUI 或conditionalPanel 即可轻松应用于您的应用程序的代码。
现在检查问题。它有完整的代码和完整数据的链接。

标签： r shiny conditional-statements shiny-reactivity

【解决方案1】：

只要您只想在由于某种原因无法制作情节时打印一条信息性消息，validate + need 就是您的朋友。例如：

library(shiny)
library(dplyr)
library(ggplot2)

ui <- basicPage(
  selectInput(
    inputId = "sp",
    label = "Select species",
    choices = unique(iris$Species),
    #selected = unique(iris$Species),
    multiple = TRUE
  ),
  tags$br(),
  plotOutput("plot_or_error")
)

server <- function(input, output) {

  make_plot <- reactive({
    df <- filter(iris, Species %in% input$sp)
    validate(need(nrow(df) > 0, 
    message = "Seems like after filtering there are 0 rows. Please change your filters."))

    ggplot(df, aes(x=Species, y=Sepal.Length)) + geom_boxplot() 
  })

  output$plot_or_error <- renderPlot({
    make_plot()
  })
}
shinyApp(ui, server)

编辑：r 用户的代码和数据。

# loading the data and making the interpretation of first column proper
wait_data <-
  transform(
    read.csv("dummy wait times data of 12 departments.csv", header = TRUE),
    Date = as.Date(Date, "%d-%m-%y")
  )

# sorting the data according to dates
wait_data <- data.frame(with(wait_data, wait_data[order(Date), ]),row.names = NULL)


library(shiny)
library(dplyr) # not necessary, code included with dplyr or base R
library(plotly)

ui_function <- fluidPage(
  sidebarLayout(
    sidebarPanel(width = 3,
                 dateRangeInput(inputId = 'date_range',
                                label = paste('Choose range from January 1, 2017 to December 31, 2018:'),
                                start = as.Date("2017-01-01"), end = as.Date("2017-05-31"),
                                min = as.Date("2017-01-01"), max = Sys.Date(),
                                separator = " to ", format = "MM-dd, yyyy",
                                startview = 'year', weekstart = 1),
                 selectInput(inputId = "department_input", 
                             label = "Choose a Department to see wait times:",
                             choices = c("General Checkup"="General Checkup", 
                                         "Emergency"="Emergency",
                                         "Cardiology"="Cardiology",
                                         "Gynaecology"="Gynaecology",
                                         "Maternity"="Maternity",
                                         "Neurology"="Neurology",
                                         "Oncology"="Oncology",
                                         "Orthopedics"="Orthopedics",
                                         "Otalaryntology"="Otalaryntology",
                                         "Psychiatry"="Psychiatry",
                                         "Radiology"="Radiology",
                                         "Urology"="Urology"),
                             multiple = TRUE,
                             selected = c("Cardiology","Gynaecology"))
    ),
    mainPanel(width = 9,
              plotlyOutput("plot_or_error")
    )
  )
)


server_function <- function(input, output) {


  make_df <- reactive({
    wait_data %>% 
      filter(Department %in% input$department_input) %>% 
      filter(Date >= input$date_range[1], Date <= input$date_range[2])
  })

  # no dplyr
  make_df_base <- reactive({
    fd <- wait_data[wait_data$Department %in% input$department_input, ]
    fd <- fd[fd$Date > input$date_range[1] & fd$Date < input$date_range[2], ]
    fd

  })

  make_plot <- reactive({
    validate(
      need(nrow(make_df_base()) > 0, # can be make_df()
           message = "Seems like you've selected dates out of range. Please change your filters."))

    plot_ly(data = make_df_base(), # can be make_df()
            x = ~Date, y=~average_wait_time_min, split = ~Department,
            type = "scatter", mode="lines+markers")
  })

  output$plot_or_error <- renderPlotly({make_plot()})

}

shinyApp(ui_function, server_function)

编辑 2：检查日期而不是数据框

# loading the data and making the interpretation of first column proper
wait_data <-
  transform(
    read.csv("dummy wait times data of 12 departments.csv", header = TRUE),
    Date = as.Date(Date, "%d-%m-%y")
  )

# sorting the data according to dates
wait_data <- data.frame(with(wait_data, wait_data[order(Date), ]),row.names = NULL)


library(shiny)
library(dplyr)
library(plotly)

ui_function <- fluidPage(
  sidebarLayout(
    sidebarPanel(width = 3,
                 dateRangeInput(inputId = 'date_range',
                                label = paste('Choose range from January 1, 2017 to December 31, 2018:'),
                                start = as.Date("2017-01-01"), end = as.Date("2017-05-31"),
                                min = as.Date("2017-01-01"), max = Sys.Date(),
                                separator = " to ", format = "MM-dd, yyyy",
                                startview = 'year', weekstart = 1),
                 selectInput(inputId = "department_input", 
                             label = "Choose a Department to see wait times:",
                             choices = c("General Checkup"="General Checkup", 
                                         "Emergency"="Emergency",
                                         "Cardiology"="Cardiology",
                                         "Gynaecology"="Gynaecology",
                                         "Maternity"="Maternity",
                                         "Neurology"="Neurology",
                                         "Oncology"="Oncology",
                                         "Orthopedics"="Orthopedics",
                                         "Otalaryntology"="Otalaryntology",
                                         "Psychiatry"="Psychiatry",
                                         "Radiology"="Radiology",
                                         "Urology"="Urology"),
                             multiple = TRUE,
                             selected = c("Cardiology","Gynaecology"))
    ),
    mainPanel(width = 9,
              plotlyOutput("plot_or_error")
    )
  )
)


server_function <- function(input, output) {
  # these don't need to be reactive unless you have the user load or switch datasets
  min_date_in_data <- reactive({ min(wait_data[,"Date"], na.rm = TRUE) })
  max_date_in_data <- reactive({ max(wait_data[,"Date"], na.rm = TRUE) })

  make_df <- reactive({
    se <- input$date_range

    validate(need(se[1] >= min_date_in_data(), message = "The first date is outside the range of the data."))
    validate(need(se[2] <= max_date_in_data(), message = "The second date is outside the range of the data."))
    validate(need(se[1] < se[2], message = "The second date needs to be after the first date."))
    validate(need(input$department_input != "", message = "Please select a department."))

    wait_data %>% 
      filter(Department %in% input$department_input) %>% 
      filter(Date >= input$date_range[1], Date <= input$date_range[2])
  })

  # no dplyr
  make_df_base <- reactive({
    fd <- wait_data[wait_data$Department %in% input$department_input, ]
    fd <- fd[fd$Date > input$date_range[1] & fd$Date < input$date_range[2], ]
    fd

  })

  make_plot <- reactive({

    plot_ly(data = make_df(),
            x = ~Date, y=~average_wait_time_min, split = ~Department,
            type = "scatter", mode="lines+markers")
  })

  output$plot_or_error <- renderPlotly({make_plot()})

}

shinyApp(ui_function, server_function)

【讨论】：

我根据您的建议尝试使用validate 和need，并用我尝试过的方法更新了问题。但是，无法解决。
1.仅当两个日期都不可用时才有效。实际上，当数据框为空时，会显示消息。 2. 条件检查不适用于日期。好像我永远无法解决这个问题。感谢您的时间和精力。
看看我的新编辑。您的日期比较失败的原因是您的测试数据包含NA，在这种情况下min 和max 将返回NA，除非您包含na.rm=TRUE。