Home > Software engineering >  How do I use req() with inputs created dynamically by purrr?
How do I use req() with inputs created dynamically by purrr?

Time:09-27

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) 

CodePudding user response:

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) 
  • Related