使用insertUI和模块动态添加选项卡

Question

我正在尝试创建一个标签集，其中标签是动态添加的。每个新选项卡都有相同的带有图像的轮播。轮播是从模块加载的。

这将是期望的最终结果，但它适用于多个动态添加的选项卡：

​

阅读其他SO问题会让我相信我可能需要一个嵌套的模块。或者，我在insertUI上犯了一个错误。非常感谢您的帮助！

下面是一个MVE，您需要将单个png放在与代码相同的文件夹中：

library(shiny)
library(slickR)

my_module_UI <- function(id) {
  ns <- NS(id)
  slickROutput(ns("slickr"), width="100%")
}

my_module <- function(input, output, session) {

  output$slickr <- renderSlickR({
    imgs <- list.files("", pattern=".png", full.names = TRUE)
    slickR(imgs)
  })
}

ui <- fluidPage(  
  tabItem(tabName = "main_tab_id",
          tabsetPanel(id = "test_tabs",
                      tabPanel(
                        title = "First tab",
                        value = "page1",
                        fluidRow(textInput('new_tab_name', 'New tab name'),
                                 actionButton('add_tab_button','Add'))
                      )
          )
  )
)

server <- function(input, output, session) {

  tab_list <- NULL

  observeEvent(input$add_tab_button,
               {
                 tab_title <- input$new_tab_name

                 if(tab_title %in% tab_list == FALSE){

                   appendTab(inputId = "test_tabs",
                             tabPanel(
                               title=tab_title,
                               div(id="placeholder") # Content
                             )
                   )

                   # A "unique" id based on the system time
                   new_id <- gsub("\\.", "", format(Sys.time(), "%H%M%OS3"))
                   insertUI(
                     selector = "#placeholder",
                     where = "beforeBegin",
                     ui = my_module_UI(new_id)
                   )

                   callModule(my_module, new_id)

                   tab_list <<- c(tab_list, tab_title)

                 }
                 updateTabsetPanel(session, "test_tabs", selected = tab_title)
               })
}

shinyApp(ui, server)

Answer 1

这是一个有趣的模块练习。

1. carousel_module只是呈现carousel
2. my_tab模块，并为每个选项卡创建一个标签和一个observeEvent，用于监听选项卡点击

library(shiny)
library(slickR)

carousel_ui <- function(id){
  ns <- NS(id)
  slickROutput(ns("slickr"), width="100%")
}

carousel_module <- function(input, output, session) {
  output$slickr <- renderSlickR({
    imgs <- list.files("~/Desktop/imgs", pattern=".png", full.names = TRUE)
    slickR(imgs)
  })
}

my_tab <- function(input,output,session,parent_session,tab_element,tab_name){

  ns = session$ns

  appendTab(inputId = "test_tabs",
            tabPanel(
              title = tab_name,
              value = tab_name,
              carousel_ui(ns("carousel")) # Operating in the parent session so explicitly supply the namespace
          ),
          session = parent_session
  )

  updateTabsetPanel(parent_session, "test_tabs", selected = tab_name) # Refer to test_tabs from the parent namespace

  # Need to update the carousel every time the user clicks on a tab
  # Else the carousel is only updated on the latest tab created

  observeEvent(tab_element(),{
    req(tab_element())

    if(tab_element() == tab_name){
      cat("Running\n")
      callModule(carousel_module,"carousel")# This module knows the namespace so no need to supply the namespace
    }
  })

}

ui <- fluidPage(  
      tabsetPanel(id = "test_tabs",
                  tabPanel(
                    title = "First tab",
                    value = "page1",
                    fluidRow(textInput('new_tab_name', 'New tab name'),
                             actionButton('add_tab_button','Add'))
                  )
      )
  )
)

server <- function(input, output, session) {

  tab_list <- NULL

  observeEvent(input$add_tab_button,{

                 tab_title <- input$new_tab_name
                 callModule(my_tab,tab_title,session,reactive(input$test_tabs),input$new_tab_name)

               })
}

shinyApp(ui, server)