Репликация идентичных вкладок и макетов снова и снова

Question

Я создаю приложение, в котором несколько вкладок отображаются на вкладке. Я хотел бы, чтобы пользователь мог создавать идентичную вкладку (с тем же макетом), нажав на вкладку, посвященную ему (это будет более понятно с примером). Следовательно, один пользователь может потенциально создать бесконечное количество одинаковых вкладок. Однако имя, данное входам, должно немного измениться (например, select1, select2, et c.), Чтобы эти вновь созданные входы можно было использовать реактивно. Кроме того, вкладки должны называться по количеству кликов. Я знаю, как сделать эту последнюю часть благодаря этому ответу .

Что касается первой части, я попытался использовать модули, поскольку они нацелены на то, чтобы собрать некоторый код в одну функцию, чтобы довольно легко генерировать входные данные. Тем не менее, в приведенном ниже примере приложение можно запустить, но нажатие на вкладку «Больше» не имеет никакого эффекта, тогда как оно должно создать новую вкладку с тем же макетом, что и первая вкладка:

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)

Кто-нибудь знаете, как это сделать?

Answer 1

Вот ответ модуля, где я добавил таблицу к каждой вкладке.

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)

Answer 2

Вот версия без модулей, которая отвечает на ваш вопрос. Если вы все еще хотите использовать модули, я рекомендую вам взглянуть на это приложение: 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)