代码之家 › 专栏 › 技术社区 › bretauv

反复复制相同的选项卡和布局

shiny r

bretauv · 技术社区 · 5 年前

我正在创建一个应用程序,其中多个输入显示在一个选项卡中。我希望用户能够通过单击专用于它的选项卡来生成一个相同的选项卡(具有相同的布局)(示例会更清晰)。因此,一个用户可能会创建无限数量的相同标签。但是,输入的名称应稍作更改(例如。 select1 , select2 以便这些新创建的输入可以以被动的方式使用。此外,选项卡应按照点击次数命名。多亏了 this answer .

关于第一部分,我尝试使用模块,因为它们的目的是在一个函数中收集一些代码,以便很容易地生成输入。但是,在下面的示例中,可以启动应用程序,但单击选项卡“更多”无效,而它应该创建一个与第一个选项卡布局相同的新选项卡:

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)

有人知道怎么做吗?

0 回复 | 直到 5 年前

motch 5 年前

这是模块答案,我在每个选项卡中添加了一个表。

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)

motch 5 年前

这是一个没有模块的版本,可以回答你的问题。如果你还想使用模块,我建议你看看这个应用程序: 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)