R shiny UI 'filter' issue

Question

I have been able to have similar pieces of code working perfectly with the UI running from within server. When running UI outside server everything works fine. When running UI in server without observeEvent the UI loads correctly.

However I get this error when using observeEvent

Warning: Error in : Problem with `filter()` input `..1`.
x Input `..1` must be of size 3919 or 1, not size 0.
ℹ Input `..1` is `c(...)`.
  90: <Anonymous>

The sample that gives error is as follows

library(tidyverse)
library(DT)
library(shiny)

pNames<-data.frame("Birth_Date" = as.Date(c("1989-12-05", '1943-03-18', '1989-12-05', '1943-03-18', '1989-12-05', '1943-03-18', '1989-12-05', '1943-03-18', '1989-12-05', '1943-03-18',' 1989-12-05'), format = "%Y-%m-%d"  ), 
                   "service" = c('Fix', 'Price', 'Unable to fix', 'Fix', 'Price', 'Unable to fix', 'Fix', 'Price', 'Unable to fix', 'Fix', 'Price'), 
                   "problem" = c("Warning Lights", "A Sputtering Engine", "Poor Fuel Economy", "Dead Battery", "Flat Tires", "Brakes Squeaking or Grinding", "Alternator Failure", 
                                 "Broken Starter Motor", "Dead Battery", "Broken Starter Motor", "Warning Lights" ))

ui <- uiOutput("uiHome")

server <- function(input, output, session)
  ({
    output$uiHome <- renderUI(fluidPage(sidebarLayout(
      sidebarPanel(
        dateRangeInput(
          inputId = "dobInput",
          label = "Date of Birth",
          start = min(pNames$Birth_Date),
          end   = max(pNames$Birth_Date),
          min = min(pNames$Birth_Date),
          max = max(pNames$Birth_Date)
        ),
        
        selectizeInput(
          "serviceInput",
          label = "Service",
          choices =  unique(pNames[['service']]),
          multiple = TRUE,
          options = list(maxItems = 1 , placeholder = "Enter a Service..")
        ),
        
        selectizeInput(
          "problemInput",
          label = "Problem",
          choices =  unique(pNames[['problem']]),
          multiple = TRUE,
          options = list(maxItems = 1 , placeholder = "Enter a Problem...")
        )
      ),
      mainPanel()
    )))
    
    observeEvent(input$dobInput,
                 {
 
                  
                   print(head(pNames)) 
                   baseFilter <-
                     if (is.null(input$problemInput)) {
                       unique(filter(
                         pNames,
                         c(
                           pNames$Birth_Date >= input$dobInput[1] &
                             pNames$Birth_Date <= input$dobInput[2]
                         )
                       ))
                     }
                   print(baseFilter)
                 },
                 ignoreNULL = FALSE)
  })

shinyApp(ui, server)

Answer 1

You should use eventReactive instead of observe to update baseFilter:

baseFilter <- eventReactiveEvent(input$dobInput,
                 {               
                     if (is.null(input$problemInput)) {
                       unique(filter(
                         pNames,
                         c(
                           pNames$Birth_Date >= input$dobInput[1] &
                             pNames$Birth_Date <= input$dobInput[2]
                         )
                       ))
                     }
                 },
                 ignoreNULL = FALSE)

If you don't do so, baseFilter() won't be a reactive function updated according to input.

Answer 2

Here is a solution that works. The problem was that you tried to filter something when input$dobInput was not defined yet (then it is NULL), so I added an req to the observer. However, I'm not sure what you exactly want to do with the baseFilter and what should be unique.

library(tidyverse)
library(DT)
library(shiny)

pNames<-data.frame("Birth_Date" = as.Date(c("1989-12-05", '1943-03-18', '1989-12-05', '1943-03-18', '1989-12-05', '1943-03-18', '1989-12-05', '1943-03-18', '1989-12-05', '1943-03-18',' 1989-12-05'), format = "%Y-%m-%d"  ), 
                   "service" = c('Fix', 'Price', 'Unable to fix', 'Fix', 'Price', 'Unable to fix', 'Fix', 'Price', 'Unable to fix', 'Fix', 'Price'), 
                   "problem" = c("Warning Lights", "A Sputtering Engine", "Poor Fuel Economy", "Dead Battery", "Flat Tires", "Brakes Squeaking or Grinding", "Alternator Failure", 
                                 "Broken Starter Motor", "Dead Battery", "Broken Starter Motor", "Warning Lights" ))

ui <- uiOutput("uiHome")

server <- function(input, output, session)
{
  output$uiHome <- renderUI({fluidPage(sidebarLayout(
    sidebarPanel(
      dateRangeInput(
        inputId = "dobInput",
        label = "Date of Birth",
        start = min(pNames$Birth_Date),
        end   = max(pNames$Birth_Date),
        min = min(pNames$Birth_Date),
        max = max(pNames$Birth_Date)
      ),
      
      selectizeInput(
        "serviceInput",
        label = "Service",
        choices =  unique(pNames[['service']]),
        multiple = TRUE,
        options = list(maxItems = 1 , placeholder = "Enter a Service..")
      ),
      
      selectizeInput(
        "problemInput",
        label = "Problem",
        choices =  unique(pNames[['problem']]),
        multiple = TRUE,
        options = list(maxItems = 1 , placeholder = "Enter a Problem...")
      )
    ),
    mainPanel()
  ))})
  
  observeEvent(input$dobInput, {
    req(input$dobInput)
    print(head(pNames))
    
    if (is.null(input$problemInput)) {
      baseFilter <- pNames %>% 
        filter(Birth_Date >= input$dobInput[1] &
                 Birth_Date <= input$dobInput[2]) %>% 
        distinct(problem, .keep_all = TRUE)
      
      print(baseFilter)
    }
  },
  ignoreNULL = FALSE)
}

shinyApp(ui, server)