R Shiny - 以编程方式生成shinymaterial

时间:2018-06-13 22:39:36

标签: r shiny material-design metaprogramming

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

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

我尝试解决方案是编写一个函数来构建一个字符串,其中包含几个单一复选框的命令(主要使用paste0for循环)。我计划简单地将该字符串转换为表达式然后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)

The page generated by the MWE

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

1 个答案:

答案 0 :(得分: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)

这会给你

enter image description here

附录。请注意,在您的应用程序中,无需使用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)

示例输出:

enter image description here