使用shinydashboardplus包（boxDropdownItem）在R Shiny中创建和删除动态框答案

【问题标题】：Creation and deletion of dynamic boxes in R Shiny using shinydashboardplus package (boxDropdownItem)使用shinydashboardplus包（boxDropdownItem）在R Shiny中创建和删除动态框
【发布时间】：2021-07-25 02:17:57
【问题描述】：

我正在尝试使用 shinydashboardplus 包中的 boxDropdownItem 创建一个页面以动态包含和排除框，但是应用程序崩溃了，有人可以帮帮我吗？

*也欢迎使用 javascript 的解决方案 :)

这是我的代码：

shinyApp(
        ui = dashboardPage(
        dashboardHeader(),  
        dashboardSidebar(),
        dashboardBody(
        uiOutput("boxes")
        )
),

server = function(input, output) {

        rvs = reactiveValues(boxDropdownItem = list(), observers = list())

        output$boxes <- renderUI({
        for(i in 1:5) {
                rvs$boxDropdownItem[[i]] =
                column(width = 12,
                        box(    id = paste("box",i),
                                title = paste("box",i),
                                width = 4,
                                status = NULL,
                                dropdownMenu = boxDropdown(
                                        icon = icon("ellipsis-v"),
                                        boxDropdownItem(id = paste0("del",i), "Delete")
                                )
                        )
                )
        }

        rvs$observers = lapply(1:(length(rvs$boxDropdownItem)),function(i) {
  
        observeEvent(input[[paste0("del",i)]],{ 
                rvs$observers <- rvs$observers[-i]
                rvs$boxDropdownItem <- rvs$boxDropdownItem[-i]
        })
        }) 

        do.call(fluidRow, rvs$boxDropdownItem) 
})

}
)

【问题讨论】：

如果您希望用户能够删除这些框，您可以在box 调用中的for 语句中添加参数closable = T。它将在角落添加一个X 以关闭框。
Kat，感谢您的快速互动。但在这种情况下，我确实需要使用 boxDropdownItem 组件而不是框的 x 组件。当用户单击删除选项（“删除”）时，我必须动态删除该框。

标签： r dynamic shiny dropdown shinydashboardplus

【解决方案1】：

您需要首先将框创建为reactiveValues 对象。然后您可以控制在renderUI 中显示的内容。我在这里展示了 3 个盒子。您可以将其修改为动态数字。试试这个

library(shinydashboardPlus)

shinyApp(
  ui = shinydashboard::dashboardPage(title = "My Box Dropdown",
    dashboardHeader(),  
    dashboardSidebar(),
    dashboardBody(
      uiOutput("boxes")
    )
  ),
  
  server = function(input, output) {
    
    rvs = reactiveValues(boxDropdownItem = list(), observers = list(), tmp=list())
    
    observe({
      for(i in 1:3) {
        rvs$boxDropdownItem[[i]] <-
          box(id = paste0("box",i),
              title = paste("box",i),
              width = 12,
              status = "warning",
              solidHeader = TRUE,
              collapsible = TRUE,
              dropdownMenu = boxDropdown(
                icon = icon("ellipsis-v"),
                boxDropdownItem("Click me", id = paste0("dropdownItem",i), icon = icon("heart")),
                dropdownDivider(),
                boxDropdownItem(id = paste0("del",i), "Delete")
              ),
              paste("My Box",i)
          )
        
      }
      
    })
    
    output$boxes <- renderUI({
      if (length(rvs$tmp)>0){
        rvs$boxDropdownItem[!(rvs$boxDropdownItem %in% rvs$tmp)]
      } else rvs$boxDropdownItem
    })
    
    lapply(1:3, function(i) {
      observeEvent(input[[paste0("del",i)]],{
        rvs$tmp[[i]] <<- rvs$boxDropdownItem[[i]]
      }, ignoreInit = TRUE)
      
      
      observeEvent(input[[paste0("dropdownItem",i)]], {
        showNotification("Hello", duration = i, type = "error")
      })

    })
    
  }
)

下图显示框2已删除。

【讨论】：

我该怎么做？我想感谢您的帮助。
答案的左上角有一个数字0。数字的正上方是一个向上的三角形，如果你将鼠标悬停在它上面，它会说“这个答案很有用”。点击它，数字 0 变为 1。
当我尝试它时，会出现以下消息：感谢您的反馈！您需要至少 15 声望才能投票，但您的反馈已被记录。对不起，我对你的回答很满意，你帮了我很多。请让我知道是否有其他方式可以识别您。
没关系。您可以等到获得 15 点声望点后再进行操作。我忘记了这个要求。