rshinyset-difference

How to filter out answer options on previous answers


I am creating a shiny app. I have a first multiple choice question q1 with a possible list of answers. In the second, one-choice question q2, as a list of possible answers I have the options selected in q1 (and until here everything works ok). In q3, as a list of possible answers I am trying to have the ones selected in q1 minus the ones selected in q2 (input$q1 - input$q2). Then I have q4 where i want as possible answers input$q1 - input$q2 - input$q3, and so on.

So for example, if the answers to q1 are "a","b","c", "d" then, as a list of possible answers in q2 I will have the same ( a","b","c", "d"). If in q2 I answer "a", as a list of possible answers for q3 I want to have "b", "c", "d". If in q3 I answer "b", then the options for q4 should be "c","d". And so on.

Here is a simplified code with the issue, as it is now it gives the error "Error in [[: subscript out of bounds":

library(shiny)
library(shinyWidgets)


v1<-c("a", "b", "c", "d", "e", "f")


ui<- fluidPage(
  
pickerInput("q1", "", choices = v1, selected = NULL, multiple = TRUE),

radioButtons("q2", "", choices = c("0"), selected = NULL),

radioButtons("q3", "", choices = c("0"), selected = NULL),

radioButtons("q4", "", choices = c("0"), selected = NULL)

)

server<-function(input, output, session) {
 v2<-reactive({
   input$q1
 })
  
   observeEvent(v2(), {
    updateRadioButtons(
      session,
      "q2",
      choices = v2()
    )
  })
   
  v3<-reactive({
    input$q1[input$q1 !=input$q2]
  })
   
  
  observeEvent(v3(), {
    updateRadioButtons(
      session,
      "q3",
      choices = v3()
    )
  })
  
  v4<-reactive({
    input$q1[input$q1 !=input$q2 & input$q1 !=input$q3]
  })
  
  
  observeEvent(v4(), {
    updateRadioButtons(
      session,
      "q4",
      choices = v4()
    )
  })
  
}

shinyApp(ui = ui, server = server)

I also tried with setdiff() with this code. This is problematic because it does not update if the answer in q1 is changed and I wouldn't be sure on how to do when I add the 4th question.

ui <- fluidPage(
  pickerInput("q1", "", choices = v1, selected = NULL, multiple = TRUE),
  radioButtons("q2", "", choices = c("0"), selected = NULL),
  radioButtons("q3", "", choices = c("0"), selected = NULL)
)

server <- function(input, output, session) {
  v2 <- reactive({
    input$q1
  })
  
  observeEvent(v2(), {
    updateRadioButtons(
      session,
      "q2",
      choices = v2()
    )
  })

  v3<-reactive({
c(input$q1, input$q2
)  })
  
  observeEvent(v3, {
    updateRadioButtons(
      session,
      "q3",
      choices = setdiff(input$q1, input$q2)
    )
  })
  
  
  
  
}

shinyApp(ui = ui, server = server)

Thank you to anyone that can help me!


Solution

  • The error occurs due to initializing the radio buttons with selected = NULL instead of selected = character(0). See this question for details.

    With selected = NULL the input variables are non-empty from the get-go, which leads to a calculation where the choices are calculated as character(0) and then this happens:

    > radioButtons("q3","",choices = character(0),selected = NULL)
    ## Error in args$choiceValues[[1]] : subscript out of bounds
    

    This should work (and I shortened the code a bit):

    library(shiny)
    library(shinyWidgets)
    
    v1<-c("a", "b", "c", "d", "e", "f")
    
    ui<- fluidPage(
      pickerInput("q1", "", choices = v1, selected = NULL, multiple = TRUE),
      radioButtons("q2", "", choices = c("0"), selected = character(0)),
      radioButtons("q3", "", choices = c("0"), selected = character(0)),
      radioButtons("q4", "", choices = c("0"), selected = character(0))
    )
    
    server<-function(input, output, session) {
    
      observeEvent(input$q1, {
        updateRadioButtons(
          session,
          "q2",
          choices = input$q1,
          selected = character(0)
        )
      })
      
      observeEvent(input$q2, {
        updateRadioButtons(
          session,
          "q3",
          choices = input$q1[input$q1 !=input$q2],
          selected = character(0)
        )
      })
      
      observeEvent(input$q3, {
        updateRadioButtons(
          session,
          "q4",
          choices = input$q1[input$q1 !=input$q2 & input$q1 !=input$q3],
          selected = character(0)
        )
      })
      
    }
    
    shinyApp(ui = ui, server = server)