将服务器的反应值传递给ui中的ui中的两个条件面板（未嵌套）？

Question

我正在制作一个闪亮的应用程序，该应用程序将“ 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 object of type 'closure' is not subsettable 。

---

编辑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的输入如何，两个库的图都会显示。 如果所选日期范围的数据不可用，则只是一个空白图，在这种情况下不会显示错误消息。

Answer 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)