I have been trying to create a dashboard with up to 3 inputs and then plot some data. I have done this part but the requirement now has changed that every time there is a selection of a new variable they should also be able to filter the data based on the new input. Here has been my attempt so far:

UI:

library(shiny)

ui <- fluidPage(
  
  sidebarPanel(
    tags$br(),
    uiOutput("textbox_ui"),
    uiOutput("filter_ui"),
    tags$br(),
    actionButton("add_btn", "Add Factor"),
    actionButton("rm_btn", "Remove Factor"),
    tags$br(),
    
    actionButton("make","Create Graph and Tables")
    
  ),
  
  mainPanel(
    tabsetPanel(type = "tabs",
                tabPanel("Data stuff")
                         
    )
  )
)

Server:

server <- function(input, output) {
  
  
  # Track the number of input boxes to render
  counter <- reactiveValues(n = 0)
  
  AllInputs <- reactive({
    x <- reactiveValuesToList(input)
  })
  
  observeEvent(input$add_btn, {
    if(counter$n >2){
      2
    }else{
      counter$n <- counter$n   1
    }
    
  })
  observeEvent(input$rm_btn, {
    if (counter$n > 0) counter$n <- counter$n - 1
  })
  
  
  textboxes <- reactive({
    
    n <- counter$n
    
    if (n > 0) {
      isolate({
        lapply(seq_len(n), function(i) {
          selectInput(inputId = paste0("var", i 1),
                      label = "", 
                      choices = colnames(mtcars),
                      selected = AllInputs()[[paste0("var", i 1)]])
        })
      })
    }
  })
  
  filterboxes <- reactive({
    n <- counter$n
    
    extrainputs <- sapply(seq_len(n), function(i) {
      AllInputs()[[paste0("var", i 1)]]
    })
    summvar <- c(input$var1, extrainputs)
    
    if(n > 0 ){
      isolate({
        lapply(1:length(summvar), function(x){
          text <- summvar[x]
          
          val_level <- unique(mtcars[[text]])
          
          selectInput(inputId =  paste0("fil",x 1),
                      label = paste0("Filter for ", text),
                      choices = val_level,
                      multiple = TRUE,
                      selected = val_level)
        })
      })
    }
    
  })
  
  output$textbox_ui <- renderUI({ textboxes() })
  output$filter_ui <- renderUI({ filterboxes() })
   
}

Two problems arise with this set up so far. One I cannot unselect any of the values when they appear in the filter second I see this warning on the sever side "Warning: Error in .subset2: invalid subscript type 'list'". My reactive skills are quite poor and any suggestions (reactive or not) would be appreciated.

CodePudding user response：

As suggested in my comment...

library(shiny)

myfun <- function(df, var1) {
  df %>% mutate(newvar = !!sym(var1))   # create newvar
}

ui <- fluidPage(
  
  sidebarPanel(
    tags$br(),
    # uiOutput("textbox_ui"),
    # uiOutput("filter_ui"),
    tags$br(),
    tags$div(id = 'placeholder'),
    actionButton("add_btn", "Add Factor"),
    actionButton("removeBtn", "Remove Factor"),
    
    tags$br(),
    
    actionButton("make","Create Graph and Tables")
    
  ),
  
  mainPanel(
    tabsetPanel(type = "tabs",
                tabPanel("Data stuff")
                
    )
  )
)

server <- function(input, output, session) {
  # Track the number of variables 
  numvars <- reactiveVal(0)
  
  ### keep track of elements/lines inserted and not yet removed
  inserted <- c()
  
  observeEvent(input$add_btn, {
   
    if(input$add_btn==0) {
      return(NULL)
    }
    else {  
      if (numvars()<0) {
        numvars(0)  #  clicking on remove button too many times yields negative number; reset it to zero
      }
      
      newValue <- numvars()   1     # newValue    <- rv$numvars   1
      numvars(newValue)             # rv$numvars <- newValue
      # btn needs to be adjusted if removing and adding factors 
      if (input$removeBtn==0){
        btn <- input$add_btn
      }else {
        if (input$add_btn > input$removeBtn) {
          btn <- input$add_btn - input$removeBtn  #  add_btn counter does not decrease
        }else btn <- numvars()
      } 
      
      id <- paste0('txt', btn)
      
      insertUI(
        selector = '#placeholder',
        ## wrap element in a div with id for ease of removal
        ui = tags$div(
          selectInput(inputId = paste0("var", btn),
                      label = "",
                      choices = colnames(mtcars)
                      ),
          selectInput(inputId =  paste0("fil",btn),
                      label = paste0("Filter for ", id),
                      choices = "",
                      multiple = TRUE),
          id = id
        )
      )
      
    }
    # inserted <<- c(id, inserted)  ##  removes first one first
    inserted <<- c(inserted, id)  ##  removes last one first
  }, ignoreInit = TRUE)  ## end of observeevent for add_btn
  
  observe({
    #print(numvars())
    lapply(1:numvars(), function(i){
      observeEvent(input[[paste0("var",i)]], {
        mydf <- mtcars
        mydf2 <- myfun(mydf,input[[paste0("var",i)]])
        mysub <- unique(mydf2$newvar)
        nam <- as.character(input[[paste0("var",i)]])
        updateSelectInput(session = session,
                          inputId = paste0("fil",i),
                          label = paste0("Filter for ", nam),
                          choices = mysub, 
                          selected = mysub
                          )
      })
    })
  })
  
  observeEvent(input$removeBtn, {
    newValue <- numvars() - 1     
    numvars(newValue)             
    removeUI(
      ## pass in appropriate div id
      selector = paste0('#', inserted[length(inserted)])
    )
    inserted <<- inserted[-length(inserted)]
    print(inserted)
  }, ignoreInit = TRUE)
  
  
}

shinyApp(ui = ui, server = server)