Pass reactive value from server to two conditional panels(not nested) in ui in shiny?

Question

I'm making a shiny app, which takes "dateRangeInput" as input and plots plot for data within that "date range". Also, I'm using conditionalPanel to not show the plot when the dates from input are not available in data and show text to the user to select dates only available in data.

The problem is, the conditional panel is not working and not showing anyting at all irrespective of date inputs. (setting the limits to max and min dates available in data to max & min of dateRangeInput is not an option.).

link to data: https://drive.google.com/open?id=17ipXwRimovR_QBYT2O1kxSGTzem_bN-1

Here's what I've done and tried:

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

That code returns object of type 'closure' is not subsettable in my mainPanel.

EDIT 1: changes in server:

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

I just can't solve this. both libraries' plots show up irrespective of inputs in dateRangeInput. if the data for the selected date range is not available, there's simply a blank plot, no error messages shows up in that case.

conditionalPanel works with elements in the UI. For example, an action button 'show more' opens a box showing more and both the action button and the box are defined in ui. But in your app, the decision to plot vs. send error message happens based on filtering in the server, and ui does not know any values in the server, only those explicitly sent to it via output$. So you want to create the appropriate element through renderUI and send it to the ui through output$name, while in the ui you have uiOutput("name"). — teofil
object of type 'closure' is not subsettable, that's my error for above changes in code after your suggestions. — Naveen Reddy Marthala
Its hard to debug since we don't have your entire code or data. But a simpler and better solution is to use validate. See my answer for example code which can be easily applied to your app without renderUI or conditionalPanel. — teofil
check the question now. It has complete code and link to the complete data. — Naveen Reddy Marthala

teofil teofil · Accepted Answer · 2019-08-30T07:36:33

As long as all you want to do is print an informative message when the plot can't be made for some reason, validate + need are your friends. For example:

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)

EDIT: r user's code and data.

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

EDIT 2: check with the dates instead of data frame

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

Pass reactive value from server to two conditional panels(not nested) in ui in shiny?

1 Answers