Shiny：如何将 renderUI 生成的“反应式输入”作为函数的输入？

Question

简介

我正在为一些工作制作一个闪亮的应用程序（仪表板）。我有一个名称数据框（从可以扩展的外部 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)

问题

我现在的问题是我想在代码中显示“这里有东西”的函数中使用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";然而，这些选项似乎都不起作用。

observeEvent(input$Save_SWAL, {
    if (isTRUE(input$Save_SWAL)) {
        sapply(do.call(t), min) %>% print()
    }
})

Answer 1

@Morten，我对sapply 不是很有经验，但我想试一试。 2 小时后，我未能从 sapply 结构中获得任何有用的信息，但我确实为您提供了 2 个替代解决方案。 cmets下面的代码中有一些解释

我遇到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)