Question

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

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

我尝试解决方案是编写一个函数来构建一个字符串，其中包含几个单一复选框的命令（主要使用paste0和for循环）。我计划简单地将该字符串转换为表达式然后eval。但是，当我这样做时（下面的示例代码），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)

我怀疑可能有另一种方法可以执行此操作，可能涉及this answer quote中提到的substitute相关问题，但我并不完全熟悉那些命令。

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)

示例输出：

R Shiny - 以编程方式生成shinymaterial

1 个答案: