R Shiny - Programmatically generate checkboxes in shinymaterial

Question

I'm working with a package in R called shinymaterial, which allows me to build R Shiny apps with material design elements. One element that I need to use is a group of checkboxes based on data uploaded by the user. However, the shinymaterial package has not yet implemented checkbox groups, only singular checkboxes. Unfortunately, it has masked the use of stock R shiny checkbox groups in the process, so I cannot simply fall back on those.

My best guess at a solution is to write a function that can programmatically generate a series of singular checkboxes based on an input vector of labels. What should I use in order to do that? Or is there a totally different approach that might work instead?

My attempt at a solution is to write a function that builds a string containing the commands for several singular checkboxes (mainly using paste0 and a for loop). I planned on simply converting that string to an expression and then evaling it. However, when I did that (example code below), the Shiny web page just renders the text of the command rather than executing it as a UI element.

materialCheckboxGroupGen <- function(idBase, choices, initials, color) {
  #' Generate a group input made from several material_checkbox elements
  #'
  #' Generate shinymaterial checkboxGroupInput expression Use `eval` to run the expression in your app.
  #' @param idBase String. Serves as a base for the inputId of the checkboxes; each checkbox's inputId will start with idBase and have a number appended.
  #' @param choices A character vector containing the labels for each checkbox to be made, respectively.
  #' @param initials A logical vector indicating the initial value for each checkbox to be made, respectively. Defaults to all FALSE, unchecked.
  #' @param color A character vector containing the color for each checkbox to be made, respectively. \emph{This input requires using color hex codes, rather than the word form. E.g., "#ef5350", rather than "red lighten-1".}

  #Setup
  nBoxes <- length(choices)
  if (missing(initials)) initials <- rep(FALSE, length.out = nBoxes)
  command <- NULL

  #Color will be recycled if it is not long enough
  if (length(color) != nBoxes) {
    color <- rep(x = color, length.out = nBoxes)
    warning("Length of color input not the same as number of choices. Color vector recycled to match.")
  }

  #Loop to generate commands
  for (i in 1:nBoxes) {
    #Set up all the arguments
    id <- paste0("\"", idBase, as.character(i), "\"")
    lab <- paste0("\"", choices[i], "\"")
    init <- as.character(initials[i])
    col <- paste0("\"", color[i], "\"")

    #Add a comma before all but the first checkbox
    if (i != 1) command <- paste0(command, ", ")

    #Add a new checkbox command to the end of the string
    command <- paste0(command,
                      "material_checkbox(input_id = ", id,
                      ", label = ", lab,
                      ", initial_value = ", init,
                      ", color = ", col,
                      ")")
  }

  return(command)
}

#Example
materialCheckboxGroupGen(idBase = "testing", choices = c("Choice 1", "Choice 2", "Choice 3"), color = "#ef5350")
# [1] "material_checkbox(input_id = \"testing1\", label = \"Choice 1\", initial_value = FALSE, color = \"#ef5350\"), material_checkbox(input_id = \"testing2\", label = \"Choice 2\", initial_value = FALSE, color = \"#ef5350\"), material_checkbox(input_id = \"testing3\", label = \"Choice 3\", initial_value = FALSE, color = \"#ef5350\")"

#Bugs
#Merely wrapping the output of this function in eval(expression()) just renders the text of the output in the Shiny page, rather than executing it to create checkbox elements

Here's a small working example of that function in use, showing that it renders out the text of the command rather than the checkboxes instead:

require(shiny)
require(shinymaterial)

ui <- material_page(
  title = "Material Checkbox Groups",
  material_row(
    material_column(
      width = 12,
      material_card(
        title = "Example",
        eval(expression(materialCheckboxGroupGen(idBase = "testing", choices = c("Choice A", "Choice B", "Choice C"), color = "#EF5350")))
      )
    )
  )
)

server <- function(input, output) {}

shinyApp(ui = ui, server = server)

I suspect there may be an alternate way to do this, perhaps involving quote and substitute as mentioned in this answer to related question, but I'm not totally familiar with those commands.

Answer 1

The eval(parse(...)) construct works fine. Let the output of materialCheckboxGroupGen be a vector (like the out object below), then use eval(parse(...)). Here's a minimal working example:

library(shiny)
library(shinymaterial)

out <- c('material_checkbox(input_id = \"testing1\",
                            label = \"Foo\",
                            initial_value = FALSE,
                            color = \"#ef5350\")',
         'material_checkbox(input_id = \"testing2\",
                           label = \"Bar\",
                           initial_value = FALSE,
                           color = \"#ef5350\")')

ui <- material_page(
  title = "shinymaterial",
  tags$br(),
  material_row(
    material_column(
      width = 2,
      material_card(
        title = "",
        depth = 4,
        lapply(out, function(x) eval(parse(text = x)))
      )
    ),
    material_column(
      width = 9,
      material_card(
        title = "Output here",
        depth = 4
      )
    )
  )
)

server <- function(input, output) {
  NULL
}

shinyApp(ui, server)

This gives you

---

Addendum. Note that in your application, there is no need to use the eval(parse(...)) construct. Here is an alternative implementation.

make_checkboxgroup is a function that takes a character vector (e.g. c("foo", "bar") and returns a list of material_checkbox values.

make_checkboxgroup <- function(x) {
  lapply(seq_along(x), function(i) {
    material_checkbox(input_id = paste0("var", i), label = x[i])
  })
}

In the ui object, we dynamically generate the checkboxes given, in this example, a comma-separated string of labels provided by the user. The main panel dynamically displays the status of each textbox.

ui <- material_page(
  title = "shinymaterial",
  tags$br(),
  material_row(
    material_column(
      width = 3,
      material_text_box("string", "Variables"),
      uiOutput("checkboxes")
    ),
    material_column(
      width = 9,
      material_card(
        title = "Output here",
        depth = 4,
        htmlOutput("checkbox_status")
      )
    )
  )
)

In the server, we use do.call(material_card, ...) to generate the checkboxes. We use renderUI to generate the output in the main panel.

server <- function(input, output) {
  output$checkboxes <- renderUI({
    X <- strsplit(input$string, ",")[[1]]
    do.call(material_card, c(make_checkboxgroup(X), title = "", depth = 4))
  })
  output$checkbox_status <- renderUI({
    X <- strsplit(input$string, ",")[[1]]
    status <- sapply(paste0("var", seq_along(X)), function(i) input[[i]])
    HTML(paste(X, status, collapse = '<br/>'))
  })
}

shinyApp(ui, server)

Example output: