R Shiny - 以编程方式在闪亮材料中生成复选框

Question

我正在使用 R 中的一个名为 shinymaterial 的包，它允许我使用材料设计元素构建 R Shiny 应用程序。我需要使用的一个元素是一组基于用户上传数据的复选框。然而，shinymaterial 包还没有实现复选框groups，只有单个复选框。不幸的是，它掩盖了在此过程中使用股票 R 闪亮复选框组，所以我不能简单地依赖这些。

我对解决方案的最佳猜测是编写一个函数，该函数可以基于标签的输入向量以编程方式生成一系列奇异复选框。 我应该使用什么来做到这一点？或者是否有一种完全不同的方法可以代替？

我尝试的解决方案是编写一个函数，该函数构建一个字符串，其中包含几个单数复选框的命令（主要使用paste0 和for 循环）。我计划简单地将该字符串转换为表达式，然后evaling 它。但是，当我这样做时（下面的示例代码），Shiny 网页只是呈现命令的文本，而不是将其作为 UI 元素执行。

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

这是一个正在使用的函数的小示例，显示它呈现的是命令的文本而不是复选框：

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)

我怀疑可能有另一种方法可以做到这一点，可能涉及quote 和substitute，如this answer 中提到的相关问题，但我并不完全熟悉这些命令。

Answer 1

eval(parse(...)) 构造工作正常。让materialCheckboxGroupGen 的输出为向量（如下面的out 对象），然后使用eval(parse(...))。这是一个最小的工作示例：

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)

这给了你

---

附录。请注意，在您的应用程序中，不需要使用 eval(parse(...)) 构造。这是另一种实现方式。

make_checkboxgroup 是一个函数，它接受一个字符向量（例如 c("foo", "bar"）并返回一个 material_checkbox 值列表。

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

在ui 对象中，我们动态生成给定的复选框，在此示例中，是用户提供的以逗号分隔的标签字符串。主面板动态显示每个文本框的状态。

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")
      )
    )
  )
)

在server 中，我们使用do.call(material_card, ...) 来生成复选框。我们使用renderUI 在主面板中生成输出。

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)

示例输出：