Question

如何使用带有动态输入的代码在tabItem元素中填充shinydashboard中的tabItems？

我正在做的例子如下。单击按钮时，代码可以工作并生成额外的选项卡。 TODO线解释了我遇到困难的地方。我想通过代码为每个选项卡添加tabItem，而不是显式地放置tab0，tab1等。

ui.R

library(shiny)
library(shinydashboard)


dashboardPage(

  dashboardHeader(title = "EXAMPLE MULTI TABS"),
  dashboardSidebar( 
    sidebarMenuOutput("menu"),
    actionButton("add", label = "Add tab")),
  dashboardBody(uiOutput("body1"))
)

server.R

library(shiny)
library(shinydashboard)
# example server
function(input, output) {
    output$menu <- renderMenu(

      sidebarMenu(
        # adding sub items if action button pressed
        do.call(menuItem, c(text = "Example tabs", tabName = "settings", startExpanded = T,
                            lapply(0:input$add, function(i) {
                              menuSubItem(text = paste0("sub menu ", i), tabName=paste0("tab",i))
                        }
                        )))
  ))

# body for different tabs
output$body1 <- renderUI({
  tabItems(
    #TODO: add tabs content based on number of tabs that is defined by action button value
    tabItem(tabName = "tab0",
            uiOutput("tab0")),
    tabItem(tabName = "tab1",
            uiOutput("tab1"))
  )
})

# add tab content for each tab
observe({
  for (i in 0:input$add) {
    local({
      my_i <- i
      tabname <- paste0("tab",my_i)
      output[[tabname]] <- renderUI({
        box(
          renderText(paste0("tab",my_i))
          )
        })
      })
    }
  })
}

Answer 1

感谢您的链接。我搞定了。

这是工作服务器.R：

library(shiny)
library(shinydashboard)
# example server
function(input, output) {
    output$menu <- renderMenu(

      sidebarMenu(id = "tabs",
        # adding sub items if action button pressed

        do.call(menuItem, c(text = "Example tabs", tabName = "settings", startExpanded = T,
                            lapply(0:input$add, function(i) {
                              menuSubItem(text = paste0("sub menu ", i), tabName=paste0("tab",i))
                        }
                        )))
  ))

# body for different tabs
output$body1 <- renderUI({
  if (input$add == 0) {
    return(NULL)
  }
  Tabs <- vector("list", input$add)
  for(i in 1:input$add) {
      tabname <- paste0("tab",i)
      Tabs[[i]] <- tabItem(tabName = tabname, uiOutput(tabname))
  }
  do.call(tabItems, Tabs)
})

tabContent <- reactive(input[[input$tabs]])

# add tab content for each tab
observe({
  if (input$add == 0) {
    return(NULL)
  }

  for (i in 1:input$add) {
    local({
      my_i <- i
      tabname <- paste0("tab",my_i)
      output[[tabname]] <- renderUI({
        box(
          renderText(paste0("tab",my_i))
          )
        })
      })

    }
  })
}

填充dashboardBody中的tabItems

1 个答案: