Search code examples
rshinypurrrgt

How do I use req() with inputs created dynamically by purrr?


I created a dynamic form using {gt} and {purrr} combined with a function that extracts the HTML of shiny::selectizeInput.

I need to ensure that inputs created dynamically with {purrr} are available for others operations.

How can I use shiny::req() for all inputs created dynamically?

# libraries

library(shiny)
library(magrittr)

# functions
selectizeInput_gt <- function(value, inputid, ...) {
  as.character(shiny::selectizeInput(paste0(value, inputid),
                                     ...)) %>%
    gt::html()
}

# datasets
number_tests <- 5
df <- data.frame("test_number" = 1:number_tests)

# UI
ui <- fluidPage(gt::gt_output(outputId = "table"))

# server
server <- function(input, output, session) {
  output$table <- gt::render_gt({
    req(df)
    
    df %>%
      tibble::rownames_to_column() %>%
      dplyr::rowwise() %>%
      dplyr::mutate(
        rowname = as.numeric(rowname),
        selectinput_column = purrr::map(
          rowname,
          .f = ~ selectizeInput_gt(
            .x,
            "_selectinput",
            label = "",
            choices = c("A", "B", "C")
          )
        )
      ) %>%
      gt::gt()
    
  })
  
}

# runApp
shinyApp(ui, server) 

Solution

  • After a lot of fiddling, I figured out a way to use purrr::walk to pass the inputs to req(). To generate the inputs, I use purrr::map.

    As a small example, I use the req() to prevent an error in a simple output that uses the values of the inputs.

    # libraries
    
    library(shiny)
    library(magrittr)
    
    # functions
    selectizeInput_gt <- function(value, inputid, ...) {
      as.character(shiny::selectizeInput(paste0(value, inputid),
                                         ...)) %>%
        gt::html()
    }
    
    # datasets
    number_tests <- 5
    df <- data.frame("test_number" = 1:number_tests)
    
    # UI
    ui <- fluidPage(gt::gt_output(outputId = "table"),
                    textOutput("selections"))
    
    # server
    server <- function(input, output, session) {
      output$table <- gt::render_gt({
        req(df)
        
        df %>%
          tibble::rownames_to_column() %>%
          dplyr::rowwise() %>%
          dplyr::mutate(
            rowname = as.numeric(rowname),
            selectinput_column = purrr::map(
              rowname,
              .f = ~ selectizeInput_gt(
                .x,
                "_selectinput",
                label = "",
                choices = c("A", "B", "C")
              )
            )
          ) %>%
          gt::gt()
        
      })
      output$selections <- renderText({
        purrr::walk(purrr::map(paste0(df$test_number, "_selectinput"), ~input[[.]]), req)
        
        paste(purrr::map_chr(paste0(df$test_number, "_selectinput"), ~input[[.]]))
      })
    }
    
    # runApp
    shinyApp(ui, server)