reactiveValuesToList Not Behaving As Expected

Question

I would expect reactiveValuesToList() to return a plain ol' list, but it appears I have to trigger the reactive expressions stored in the resulting object before going about my business. Is there a reason for this? Am I misunderstanding the function?

In this particular case, I am wondering why the first method of getting vals2 does not work and I have to use the workaround immediately following it. It throws the error message Error in : 'match' requires vector arguments.

#' Packages
#' ================================================================= #

load_pkgs <- function(pkgs){
  #' Loads a list of packages, installing them if not already
  #' installed pkgs is a vector of package names as strings
  #' =============================================================== #
  for(pkg in pkgs){
    if(!(require(pkg, character.only = TRUE))){
      install.packages(pkg)
      library(pkg, character.only = TRUE)
    }
  }
}

load_pkgs(
  c('bit64', 'data.table', 'magrittr', 'shiny', 'shinydashboard',
    'shinyWidgets')
)

#' Data
#' ================================================================= #

dataset <- data.table(
  sample(letters, size = 1000, replace = T),
  sample(LETTERS, size = 1000, replace = T),
  sample.int(10, size = 1000, replace = T)
)

#' Functions
#' ================================================================= #

subsel <- function(x, sub, sel = NULL,
                   nomatch = getOption('datatable.nomatch')){
  #' function to subset a data.table (x) using a named list (sub). sel
  #' can be used to return only the specified columns. algorithms
  #' copied from https://stackoverflow.com/questions/55728200/subsetting-a-data-table-based-on-a-named-list
  #' and cutoff decided on some ad hoc testing.
  if(is.null(sel)) sel <- names(x)
  if(x[, .N] < 200000L){
    return(
      x[
        do.call(
          pmin,
          Map(`%in%`, x[, .SD, .SDcols = names(sub)], sub)
        ) == 1L,
        .SD,
        .SDcols = sel,
        nomatch = nomatch
        ]
    )
  } else {
    return(
      x[
        do.call(CJ, sub),
        .SD,
        .SDcols = sel,
        on = names(sub),
        nomatch = nomatch
        ]
    )
  }
}

excelStyleFilterUI <- function(field, dataset){
  #' server for filter on one variable
  #' args -
  #' - field - character string naming field in dataset
  #' - dataset - base dataset
  #' =============================================================== #
  nm <- paste0('filter_', field)
  ns <- NS(nm)
  vals <- dataset[, sort(unique(get(field)))]
  pickerInput(
    inputId = ns('filter'),
    choices = vals,
    selected = vals,
    options = pickerOptions(
      actionsBox = TRUE,
      selectedTextFormat = 'count',
      virtualScroll = TRUE,
      dropupAuto = F,
      liveSearch = TRUE,
      dropdownAlignRight = 'auto'
    ),
    multiple = T
  )
}

excelStyleFilterServer <- function(field, dataset){
  #' server for filter on one variable
  #' args -
  #' - field - character string naming field in dataset
  #' - dataset - reactive, filtered version of dataset
  #' =============================================================== #
  nm <- paste0('filter_', field)
  moduleServer(
    nm,
    function(input, output, session){
      # observer to update selection with allowable choices
      observeEvent(
        dataset(),
        {
          updatePickerInput(
            session = session,
            inputId = 'filter',
            selected = dataset()[, sort(unique(get(field)))]
          )
        }
      )
      
      return(reactive({ input$filter }))
    }
  )
}

#' App
#' ================================================================= #

ui <- dashboardPage(
  dashboardHeader(disable = T),
  dashboardSidebar(
    sidebarMenu(
      actionButton('apply', label = 'Apply')
    )
  ),
  dashboardBody(
    fluidRow(
      box(
        title = 'letters filter',
        excelStyleFilterUI('V1', dataset = dataset),
        width = 4
      ),
      box(
        title = 'LETTERS filter',
        excelStyleFilterUI('V2', dataset = dataset),
        width = 4
      ),
      box(
        title = 'numbers filter',
        excelStyleFilterUI('V3', dataset = dataset),
        width = 4
      )
    ),
    box(
      title = 'Dataset',
      tableOutput('tab')
    )
  )
)

server <- function(input, output, session){
  # reactive, filtered version of dataset
    # initial version of filter vectors
  vals <- reactiveValues()
    # reactive code
  filterset <- eventReactive(
    {
      input$apply
    },
    {
      # vals2 <- isolate(reactiveValuesToList(vals)) # Why doesn't this work below?
      
      vals2 <- lapply(
        names(vals),
        function(x) vals[[x]]()
      )
      names(vals2) <- names(vals)
      
      subsel(dataset, vals2)
    }
  )
  
  # pickers + filter values
  vals[['V1']] <- excelStyleFilterServer('V1', filterset)
  vals[['V2']] <- excelStyleFilterServer('V2', filterset)
  vals[['V3']] <- excelStyleFilterServer('V3', filterset)
  
  # table output
  output$tab <- renderTable({
    filterset()
  })
}

shinyApp(ui, server)

Answer 1

The problem is that your vals is a reactiveValues object, which contain reactive objects. reactiveValuesToList actually transforms your reactiveValues object into a list, which still contain reactives. That is you have to "call" them in order to get their value (like vals[[1]]()).

In fact you do not really need vals to be reactive itself unless you want to add some logic to react ive (pun intended) there is a new element added.

Replacing vals <- reactiveValues() by vals <- list() would equally work (and removes some small overhead).

Whatever you decide, at some point you have to loop through the reactive elements of vals and retrieve their values.

Thus, I would write your server like this:

server <- function(input, output, session){
   vals <- list() # can also be changed to reactiveValues()...
   # reactive code
   filterset <- eventReactive(
      {
         input$apply
      },
      {
         vals2 <- lapply( 
            # ...however the implicit transformation to a list here 
            # is better done explicitly in this case 
            # reactiveValuesToList(vals)
            vals, 
            function(x) x()
         )
         
         subsel(dataset, vals2)
      }
   )
   
   # pickers + filter values
   vals[['V1']] <- excelStyleFilterServer('V1', filterset)
   vals[['V2']] <- excelStyleFilterServer('V2', filterset)
   vals[['V3']] <- excelStyleFilterServer('V3', filterset)
   
   # table output
   output$tab <- renderTable({
      filterset()
   })
}

---

Bonus answer

You should put your box with the table in a fluidRow to avoid the content spilling the box:

fluidRow(
   box(
         title = 'Dataset',
         tableOutput('tab')
      )
)