Search code examples
rshinyr6shinymodulestruthy

How to select a subset of elements of the input R6 class within a shiny module to perform operations on them


Can I access a list of all input widgets within a module (let us name it myModule) and check if their state is isTruthy().

I found a way that works when I know (or can deduce) the exact names of the widgets (see 1).

All_Inputs <- vapply(paste0('axis',1:3),
                     function(x) { isTruthy(input[[x]]) },
                     logical(1))

Of course, I also could do it with a long list of if (isTruthy(input$a) && isTruthy(input$b) && .... But both solutions are not satsifactory to me, mostly because of drawbacks regarding readability and maintainability.

I know that the input class has them all listed under names that start with myModule-[AnyName]. But I do not know how to use that information to access them using a loop or even better an apply function.


Solution

  • As input is a named list, you could use vapply on names(input):

    library(shiny)
    
    counterButton <- function(id, label = "Counter") {
      ns <- NS(id)
      tagList(
        actionButton(ns("button"), label = label),
        verbatimTextOutput(ns("out"))
      )
    }
    
    counterServer <- function(id) {
      moduleServer(
        id,
        function(input, output, session) {
          count <- reactiveVal(0)
          observeEvent(input$button, {
            count(count() + 1)
          })
          output$out <- renderText({
            count()
          })
          count
        }
      )
    }
    
    ui <- fluidPage(
      counterButton("counter1", "Counter #1"),
      counterButton("counter2", "Counter #2"),
      textOutput('istruthy')
    )
    
    server <- function(input, output, session) {
      counterServer("counter1")
      counterServer("counter2")
      output$istruthy <- renderText({ 
        vapply(names(input), 
               function(x) { 
                   ifelse(startsWith(x, "counter2-"), isTruthy(input[[x]]), TRUE) 
               },
               logical(1)) 
      })
     
    }
    
    shinyApp(ui, server)
    

    enter image description here