我正在使用名为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
相关问题,但我并不完全熟悉那些命令。
答案 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)
这会给你
附录。请注意,在您的应用程序中,无需使用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)
示例输出: