Replicating identical tabs and layouts over and over

问题

I am creating an app in which several inputs are displayed in a tab. I would like the user to be able to generate an identical tab (with the same layout) by clicking on a tab dedicated to it (it will be clearer with the example). Therefore, one user could potentially create an infinite number of identical tabs. However, the name given to the inputs should change slightly (e.g. select1, select2, etc.) so that these newly created inputs can be used in a reactive way. Moreover, the tabs should be named following the number of clicks. I know how to do this last part thanks to this answer.

Concerning the first part, I tried to use modules since they aim at gathering some code in one function to generate inputs quite easily. However, in the example below, the app can be launched but clicking on the tab "More" has no effect whereas it should create a new tab with the same layout that the first tab:

library(shiny)
library(shinyWidgets)

addTab_server <- function(input, output, session, count){
  ns <- session$ns

  observeEvent(input$tabs, {
    if (input$tabs == "More"){
      count(count()+1)
      name <- paste0("Name ", count())
      insertTab(inputId = "tabs",
                tabPanel(title = name,
                         selectInput(ns("select"), 
                                     "Choose", 
                                     choices = colnames(mtcars))
                         ), 
                target = "More", 
                position = "before",
                select = TRUE)
    }
    else {}
  })
}

ui <- navbarPage(position = "static-top",
                 title = "foo",
                 id = "tabs",
                 tabPanel(title = "Name 1",
                          fluidRow(
                            selectInput("select1", 
                                        "Choose", 
                                        choices = colnames(mtcars))
                          )),
                 tabPanel(title = "More",
                          icon = icon("plus"),
                          fluidRow()
                 )
)

server <- function(input, output) {

  callModule(addTab_server, "try", count = reactiveVal(1))

}

shinyApp(ui = ui, server = server)

Does anybody know how to do it?

回答1:

Here is the module answer where I added a table to each tab.

library(shiny)
library(shinyWidgets)
library(dplyr)

addTab <- function(id) {
  ns <- NS(id)
  tagList(
    selectInput(ns("select"),
                "Choose", 
                choices = colnames(mtcars)),
    tableOutput(ns("table"))
    )
}

moduleTable <- function(input, output, session){
  output$table <- renderTable({
    select(mtcars, input$select)
  })
}

ui <- navbarPage(position = "static-top",
                 title = "foo",
                 id = "tabs",
                 tabPanel(title = "More",
                          icon = icon("plus"),
                          fluidRow()
                 )
)

server <- function(input, output) {

  count <- reactiveValues(val=1)

  observeEvent(input$tabs, {
    if (input$tabs == "More"){
      name <- paste0("Name ", count$val)
      insertTab(inputId = "tabs",
                tabPanel(title = name,
                         addTab(paste0("select", count$val))
                         ), 
                target = "More", 
                position = "before",
                select = TRUE)

      callModule(moduleTable, paste0("select", count$val))
      count$val <- count$val+1
    }
  })  
}

shinyApp(ui = ui, server = server)

回答2:

Here's a version without modules that answears your question. If you still want to use modules I recommend you to look at this app: https://gallery.shinyapps.io/insertUI-modules/

library(shiny)
library(shinyWidgets)

ui <- navbarPage(position = "static-top",
                 title = "foo",
                 id = "tabs",
                 tabPanel(title = "Name 1",
                          fluidRow(
                            selectInput("select1", 
                                        "Choose", 
                                        choices = colnames(mtcars))
                          )),
                 tabPanel(title = "More",
                          icon = icon("plus"),
                          fluidRow()
                 )
)

server <- function(input, output) {

  count <- reactiveValues(val=2)

  observeEvent(input$tabs, {
    if (input$tabs == "More"){
      name <- paste0("Name ", count$val)
      insertTab(inputId = "tabs",
                tabPanel(title = name,
                         selectInput(paste("select", count$val),
                                     "Choose", 
                                     choices = colnames(mtcars))
                ), 
                target = "More", 
                position = "before",
                select = TRUE)
      count$val <- count$val+1
    }
  })  
}

shinyApp(ui = ui, server = server)

来源：https://stackoverflow.com/questions/59939628/replicating-identical-tabs-and-layouts-over-and-over

标签

Shiny