带有嵌套在dynamic appendTab和removeTab中的dynamic appendTab和removeTab的闪亮应用程序

我想制作一个闪亮的应用程序，允许用户创建和删除带有自定义标题的选项卡，这可以通过appendTab和removeTab轻松实现。但是，我也希望用户能够在每个更高级别的选项卡中创建和删除具有自定义标题的选项卡（我们称之为子选项卡）

我已经能够实现这一点与滑块（但没有自定义标题），但想做同样的动作按钮。在以下示例中，“威胁”是更高级别的选项卡，“行动”是子选项卡

下面是一个使用滑块的工作应用程序：

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      textInput("newthreatname","Threat name to add or remove", "Threat 1"),
      actionButton("add", "Add this threat"),
      actionButton("remove", "Remove this threat")
    ),
    mainPanel(
      navbarPage("App Title",id="maintabs",
                 tabPanel("Introduction")
      )
    )
  )
)

server <- function(input, output, session) {
  observeEvent(input$add, {
    id <- input$newthreatname
    appendTab(inputId = "maintabs", ######add a higher level tab
              tabPanel(title = glue(id),
                       renderUI({   ######create slider to control number of subtabs within this higher level tab
                         sliderInput(inputId = paste0("sliderac",id), label = NULL, min = 1, max = 5, value = 3, step = 1)
                               }),
                       renderUI({ #######create subtabs within higher level tab
                         myTabs2 <- lapply(1:input[[paste0("sliderac",id)]], function(i) {
                           tabPanel(title = glue("Subtab {i}"),
                                    h3(glue("Content {i}")))
                               })
                       do.call(tabsetPanel, c(myTabs2,id="subtabs"))})
              ),select=TRUE)
    
  })
  
  observeEvent(input$remove, { #####remove higher level tabs
    id <- input$newthreatname
    removeTab(inputId = "maintabs", target = id)
  })
  
  
}

shinyApp(ui, server)

用户界面

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      textInput("newthreatname","Threat name to add or remove", "Threat 1"),
      actionButton("add", "Add this threat"),
      actionButton("remove", "Remove this threat")
    ),
    mainPanel(
      navbarPage("App Title",id="maintabs",
                 tabPanel("Introduction")
      )
    )
  )
)

server <- function(input, output, session) {
  observeEvent(input$add, {
    id <- input$newthreatname
    appendTab(inputId = "maintabs",
              tabPanel(title = glue(id),id="subtabs",
                       renderUI({
                         textInput(paste0("newactionname",id),"Action name to add or remove", "Action 1")
                               }),
                       renderUI({
                         actionButton(paste0("addac",id), "Add this action")}),
                       renderUI({
                         actionButton(paste0("removeac",id), "Remove this action")}),
                       eventReactive(input[[paste0("addac",id)]], {
                       renderUI({
                         appendTab(inputId = "subtabs",
                                   tabPanel(title = input[[paste0("newactionname",id)]],
                                            h3(glue("Hello"))
                                            )
                                   )
                         })}),
                       eventReactive(input[[paste0("removeac",id)]], {
                         renderUI({
                           removeTab(inputId = "subtabs", target = input[[paste0("newactionname",id)]]
                                     )})})
                        )
                       ,select=TRUE)
    
  })
  
  observeEvent(input$remove, {
    id <- input$newthreatname
    removeTab(inputId = "maintabs", target = id)
  })
  
  
}

shinyApp(ui=ui, server=server)