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

Question

我正在尝试创建一个页面以使用 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) 
})

}
)

标签： rdynamicshinydropdownshinydashboardplus

Answer 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 已删除。