闪亮：如何将 renderUI 生成的 "reactive input" 作为函数的输入？
Shiny: How to take a "reactive input" generated from renderUI as input in a function?
简介
我正在为一些工作制作一个闪亮的应用程序（仪表板）。我有一个名称数据框（从可以扩展的外部 Excel 文件生成，因此需要反应性），它应该为每个名称生成一个 collapsePanel（来自 bsCollapse）上述名单中的名字。这已经在服务器中使用 renderUI 实现并工作；但是，现在我想真正能够更改 collapsePanel 中包含的内容的输入：我在面板中有几个输入，但最重要的，我将在本示例中显示的是一个复选框组。当我想在函数中使用复选框组的输入时（例如保存新信息），我的问题就出现了。
最小工作示例
if (!require("pacman")) install.packages("pacman")
pacman::p_load(tidyverse, shiny, shinythemes, sweetalertR, shinyWidgets,
shinycssloaders, shinyBS, shinyjs, shinydashboard, rlist, readxl)
list_of_names <- tibble("Name" = c("Name1", "Name2", "Name3"),
"0 pt" = c("Criteria 0 name1", "Criteria 0 name2", "Criteria 0 name3"),
"1 pt" = c("Criteria 1 name1", "Criteria 1 name2", "Criteria 1 name3"),
"2 pt" = c("Criteria 2 name1", "Criteria 2 name2", "Criteria 2 name3"))
t <- c()
for (i in list_of_names$Name) {
t <- c(t, paste0("input$", i, "_id"))
}
mycollapse <- lapply(1:nrow(list_of_names), function(i) {
bsCollapsePanel(paste0(list_of_names$Name[i]),
awesomeCheckboxGroup(inputId = paste0(list_of_names$Name[i], "_id"),label = NULL,
choices = as.character(list_of_names[i,2:4]),
status = "success", width = "75%"))
})
mycollapse[["id"]] <- "collapseID"
mycollapse[["multiple"]] <- FALSE
mycollapse[["open"]] <- "Name1"
#### UI ----------
ui <- dashboardPage(
dashboardHeader(title = "Minimal Example"),
dashboardSidebar(
sidebarMenu(
menuItem("Dashboard", tabName = "Dashboard", icon = icon("dashboard"),
selected = TRUE))),
dashboardBody(
fluidPage(
column(6, shinyjs::useShinyjs(), withSpinner(uiOutput("Data"))))))
server <- function(input, output, session) {
output$Data <- renderUI({
tagList(
do.call(bsCollapse, args = mycollapse) %>% return(),
actionButton("Save", "Save"))
})
observeEvent(input$Save, {
confirmSweetAlert(session, inputId = "Save_SWAL", title =
"Save?", text = "Are you sure?",
type = "warning", danger_mode = TRUE, btn_labels = c("Cancel", "Yes, save please"))
})
observeEvent(input$Save_SWAL, {
if (isTRUE(input$Save_SWAL)) {
# SOMETHING HERE
}
})
}
shinyApp(ui, server)
问题
我现在的问题是我想在代码中显示 "SOMETHING HERE" 的函数中使用 input$Name1_id、input$Name2_id 和 input$Name3_id，例如当我单击操作按钮时，将选择的分数转换为最大值和最小值。
所以基本上我想要的是以下但以反应方式：
observeEvent(input$Save_SWAL, {
if (isTRUE(input$Save_SWAL)) {
list(
"Result1" = list("min" = min(input$Name1_id), "max" = max(input$Name1_id)),
"Result2" = list("min" = min(input$Name2_id), "max" = max(input$Name2_id)),
"Result3" = list("min" = min(input$Name3_id), "max" = max(input$Name3_id))
) %>% print()
}
})
如何使用 for 循环执行此操作并应用？
我试过在字符串上使用 eval() 和 do.call()，例如："input$Name1_id"；然而 none 这些选项似乎可以解决问题。
observeEvent(input$Save_SWAL, {
if (isTRUE(input$Save_SWAL)) {
sapply(do.call(t), min) %>% print()
}
})
@Morten，我对 sapply 不是很有经验，但我想试一试。
2 小时后，我未能从 sapply 结构中获得任何有用的信息，但我确实为您提供了 2 个替代解决方案。下面的代码在评论中有一些解释
我 运行 使用 sapply 遇到的问题是我得到 list() 或 inputs 的名字而不是他们的 values。
通常我会使用 eval(parse(text = 'name of input here')) 来处理以字符串而不是代码形式呈现的输入名称，但是对于在 apply 函数中使用它的这种情况，我似乎无法理解为什么它不起作用。
无论如何，下面有一种方法可以对输入名称进行 lapply，或者将结果收集在 reactiveVariable 中，即包含所有 T/F values 的列表每组 checkboxes。
list_of_names <- tibble("Name" = c("Name1", "Name2", "Name3"),
"0 pt" = c("Criteria 0 name1", "Criteria 0 name2", "Criteria 0 name3"),
"1 pt" = c("Criteria 1 name1", "Criteria 1 name2", "Criteria 1 name3"),
"2 pt" = c("Criteria 2 name1", "Criteria 2 name2", "Criteria 2 name3"))
vectorx <- c('input$Name1_id', 'input$Name2_id', 'input$Name3_id')
listx <- sapply(sapply(1:3, function(i) { paste0("input$Name", i, "_id")}),function(x) NULL)
mycollapse <- lapply(1:nrow(list_of_names), function(i) {
bsCollapsePanel(paste0(list_of_names$Name[i]),
awesomeCheckboxGroup(inputId = paste0(list_of_names$Name[i], "_id"),label = NULL,
choices = as.character(list_of_names[i,2:4]),
status = "success", width = "75%"))
})
mycollapse[["id"]] <- "collapseID"
mycollapse[["multiple"]] <- FALSE
mycollapse[["open"]] <- "Name1"
#### UI ----------
ui <- dashboardPage(
dashboardHeader(title = "Minimal Example"),
dashboardSidebar(
sidebarMenu(
menuItem("Dashboard", tabName = "Dashboard", icon = icon("dashboard"),
selected = TRUE))),
dashboardBody(
fluidPage(
column(6, shinyjs::useShinyjs(), withSpinner(uiOutput("Data"))))))
server <- function(input, output, session) {
#approach 1 make a reactive list to store the inputs
values <- reactiveValues(mylist = list())
output$Data <- renderUI({
tagList(
do.call(bsCollapse, args = mycollapse) %>% return(),
actionButton("Save", "Save"))
})
#approach 1 observe changes in the inputs (including deselect of all, which would not work if you use observeEvent as it does not fire if all boxes are FALSE)
observe({ lapply(1:3, function(i) {
values$mylist[[paste0('Name', i, '_id', sep = '')]] <- input[[paste0('Name', i, '_id', sep = '')]]
})
})
####################
observeEvent(input$Save, {
confirmSweetAlert(session, inputId = "Save_SWAL", title =
"Save?", text = "Are you sure?",
type = "warning", danger_mode = TRUE, btn_labels = c("Cancel", "Yes, save please"))
})
observeEvent(input$Save_SWAL, {
if (isTRUE(input$Save_SWAL)) {
#approach 1 simply print the minimums in the reactive list
print("#approach 1")
print(sapply(values$mylist, min) )
##### I tried for over 1.5 hour, but I could not get an sapply block working on strings called "input$Name1_id" etc
## normally I would use eval(parse(text = 'input$Name1_id')) to read what the input is, but for some reason it will not work with a list of names
## This makes a named yet empty list for instance:
## listx <- sapply(sapply(1:3, function(i) { paste0("input$Name", i, "_id")}),function(x) NULL)
## with the idea that I could then try to sapply over the names with eval(parse()) construct, but it doesn't return the minimums
# keeps printing empty 'list()'
# print(sapply(eval(parse(text = names(listx))), min))
##this keeps printing the names of vectorx
# print(sapply(vectorx, min))
#approach 2 run an lapply over all the inputs without the need to store them
print("#approach 2")
lapply(1:3, function(i) {
if(!!length(input[[paste0('Name', i, '_id', sep = '')]])) { ## !!length means it is NOT an empty list, so then we want the min
min(input[[paste0('Name', i, '_id', sep = '')]]) %>% print()
}
})
}
})
}
shinyApp(ui, server)
简介
我正在为一些工作制作一个闪亮的应用程序（仪表板）。我有一个名称数据框（从可以扩展的外部 Excel 文件生成，因此需要反应性），它应该为每个名称生成一个 collapsePanel（来自 bsCollapse）上述名单中的名字。这已经在服务器中使用 renderUI 实现并工作；但是，现在我想真正能够更改 collapsePanel 中包含的内容的输入：我在面板中有几个输入，但最重要的，我将在本示例中显示的是一个复选框组。当我想在函数中使用复选框组的输入时（例如保存新信息），我的问题就出现了。
最小工作示例
if (!require("pacman")) install.packages("pacman")
pacman::p_load(tidyverse, shiny, shinythemes, sweetalertR, shinyWidgets,
shinycssloaders, shinyBS, shinyjs, shinydashboard, rlist, readxl)
list_of_names <- tibble("Name" = c("Name1", "Name2", "Name3"),
"0 pt" = c("Criteria 0 name1", "Criteria 0 name2", "Criteria 0 name3"),
"1 pt" = c("Criteria 1 name1", "Criteria 1 name2", "Criteria 1 name3"),
"2 pt" = c("Criteria 2 name1", "Criteria 2 name2", "Criteria 2 name3"))
t <- c()
for (i in list_of_names$Name) {
t <- c(t, paste0("input$", i, "_id"))
}
mycollapse <- lapply(1:nrow(list_of_names), function(i) {
bsCollapsePanel(paste0(list_of_names$Name[i]),
awesomeCheckboxGroup(inputId = paste0(list_of_names$Name[i], "_id"),label = NULL,
choices = as.character(list_of_names[i,2:4]),
status = "success", width = "75%"))
})
mycollapse[["id"]] <- "collapseID"
mycollapse[["multiple"]] <- FALSE
mycollapse[["open"]] <- "Name1"
#### UI ----------
ui <- dashboardPage(
dashboardHeader(title = "Minimal Example"),
dashboardSidebar(
sidebarMenu(
menuItem("Dashboard", tabName = "Dashboard", icon = icon("dashboard"),
selected = TRUE))),
dashboardBody(
fluidPage(
column(6, shinyjs::useShinyjs(), withSpinner(uiOutput("Data"))))))
server <- function(input, output, session) {
output$Data <- renderUI({
tagList(
do.call(bsCollapse, args = mycollapse) %>% return(),
actionButton("Save", "Save"))
})
observeEvent(input$Save, {
confirmSweetAlert(session, inputId = "Save_SWAL", title =
"Save?", text = "Are you sure?",
type = "warning", danger_mode = TRUE, btn_labels = c("Cancel", "Yes, save please"))
})
observeEvent(input$Save_SWAL, {
if (isTRUE(input$Save_SWAL)) {
# SOMETHING HERE
}
})
}
shinyApp(ui, server)
问题
我现在的问题是我想在代码中显示 "SOMETHING HERE" 的函数中使用 input$Name1_id、input$Name2_id 和 input$Name3_id，例如当我单击操作按钮时，将选择的分数转换为最大值和最小值。
所以基本上我想要的是以下但以反应方式：
observeEvent(input$Save_SWAL, {
if (isTRUE(input$Save_SWAL)) {
list(
"Result1" = list("min" = min(input$Name1_id), "max" = max(input$Name1_id)),
"Result2" = list("min" = min(input$Name2_id), "max" = max(input$Name2_id)),
"Result3" = list("min" = min(input$Name3_id), "max" = max(input$Name3_id))
) %>% print()
}
})
如何使用 for 循环执行此操作并应用？
我试过在字符串上使用 eval() 和 do.call()，例如："input$Name1_id"；然而 none 这些选项似乎可以解决问题。
observeEvent(input$Save_SWAL, {
if (isTRUE(input$Save_SWAL)) {
sapply(do.call(t), min) %>% print()
}
})
@Morten，我对 sapply 不是很有经验，但我想试一试。
2 小时后，我未能从 sapply 结构中获得任何有用的信息，但我确实为您提供了 2 个替代解决方案。下面的代码在评论中有一些解释
我 运行 使用 sapply 遇到的问题是我得到 list() 或 inputs 的名字而不是他们的 values。
通常我会使用 eval(parse(text = 'name of input here')) 来处理以字符串而不是代码形式呈现的输入名称，但是对于在 apply 函数中使用它的这种情况，我似乎无法理解为什么它不起作用。
无论如何，下面有一种方法可以对输入名称进行 lapply，或者将结果收集在 reactiveVariable 中，即包含所有 T/F values 的列表每组 checkboxes。
list_of_names <- tibble("Name" = c("Name1", "Name2", "Name3"),
"0 pt" = c("Criteria 0 name1", "Criteria 0 name2", "Criteria 0 name3"),
"1 pt" = c("Criteria 1 name1", "Criteria 1 name2", "Criteria 1 name3"),
"2 pt" = c("Criteria 2 name1", "Criteria 2 name2", "Criteria 2 name3"))
vectorx <- c('input$Name1_id', 'input$Name2_id', 'input$Name3_id')
listx <- sapply(sapply(1:3, function(i) { paste0("input$Name", i, "_id")}),function(x) NULL)
mycollapse <- lapply(1:nrow(list_of_names), function(i) {
bsCollapsePanel(paste0(list_of_names$Name[i]),
awesomeCheckboxGroup(inputId = paste0(list_of_names$Name[i], "_id"),label = NULL,
choices = as.character(list_of_names[i,2:4]),
status = "success", width = "75%"))
})
mycollapse[["id"]] <- "collapseID"
mycollapse[["multiple"]] <- FALSE
mycollapse[["open"]] <- "Name1"
#### UI ----------
ui <- dashboardPage(
dashboardHeader(title = "Minimal Example"),
dashboardSidebar(
sidebarMenu(
menuItem("Dashboard", tabName = "Dashboard", icon = icon("dashboard"),
selected = TRUE))),
dashboardBody(
fluidPage(
column(6, shinyjs::useShinyjs(), withSpinner(uiOutput("Data"))))))
server <- function(input, output, session) {
#approach 1 make a reactive list to store the inputs
values <- reactiveValues(mylist = list())
output$Data <- renderUI({
tagList(
do.call(bsCollapse, args = mycollapse) %>% return(),
actionButton("Save", "Save"))
})
#approach 1 observe changes in the inputs (including deselect of all, which would not work if you use observeEvent as it does not fire if all boxes are FALSE)
observe({ lapply(1:3, function(i) {
values$mylist[[paste0('Name', i, '_id', sep = '')]] <- input[[paste0('Name', i, '_id', sep = '')]]
})
})
####################
observeEvent(input$Save, {
confirmSweetAlert(session, inputId = "Save_SWAL", title =
"Save?", text = "Are you sure?",
type = "warning", danger_mode = TRUE, btn_labels = c("Cancel", "Yes, save please"))
})
observeEvent(input$Save_SWAL, {
if (isTRUE(input$Save_SWAL)) {
#approach 1 simply print the minimums in the reactive list
print("#approach 1")
print(sapply(values$mylist, min) )
##### I tried for over 1.5 hour, but I could not get an sapply block working on strings called "input$Name1_id" etc
## normally I would use eval(parse(text = 'input$Name1_id')) to read what the input is, but for some reason it will not work with a list of names
## This makes a named yet empty list for instance:
## listx <- sapply(sapply(1:3, function(i) { paste0("input$Name", i, "_id")}),function(x) NULL)
## with the idea that I could then try to sapply over the names with eval(parse()) construct, but it doesn't return the minimums
# keeps printing empty 'list()'
# print(sapply(eval(parse(text = names(listx))), min))
##this keeps printing the names of vectorx
# print(sapply(vectorx, min))
#approach 2 run an lapply over all the inputs without the need to store them
print("#approach 2")
lapply(1:3, function(i) {
if(!!length(input[[paste0('Name', i, '_id', sep = '')]])) { ## !!length means it is NOT an empty list, so then we want the min
min(input[[paste0('Name', i, '_id', sep = '')]]) %>% print()
}
})
}
})
}
shinyApp(ui, server)