在 Shiny 模块中使用 lapply() 函数构建带有多个 tabPanel 的 tabBox，其数量取决于导入的数据

Question

我想在 shiny 中构建一个模块，它呈现一个 tabBox，其中 tabPanel 的数量是数据的函数。模拟数据（参见下面的脚本）具有水箱或池塘变量（列）（"viveiro" 葡萄牙语），其数量可以是变量。所以面板的数量是这个变量的函数。但最大的问题是，在每个 tabPanel 中，我渲染一个简单的 table（带有 renderTable()），它对应于每个 "viveiro" 的子集(tank/pond)。我使用 lapply() 函数来构建 renderUI 并将反应式表达式分配给输出（参见下面的适用示例）。 nCiclo() 是一个反应式，表示 "viveiro"（tank/pond 如您所愿）的数量，可以对应于 1:6 的序列.它在 renderUI() 中的第一个 lapply() 对于 output$tab_box 的第一个 lapply() 上运行良好，但是当我在第二个 lapply() 上使用它对于 output[[paste0('outCiclo',j)]] 输出时它不起作用在下面 renderTable 中。

问题： 如何将最后一个 lapply() 函数作为模拟数据中 "viveiro" (tank/pond) 数量的函数？我试图为反应性 nCiclo() 替换修复序列 1:6 但不起作用。

library(shiny)
library(shinydashboard)
library(openxlsx) 
rm(list = ls())
#--------------------------------------------------
# Simulated data for the app
(n = 2*sample(3:8,1)) # tank/pond (portuguese viveiro) number (quantity) / random variable in the data
bio <- data.frame(
  semana = rep(1:5,n),
  peso = rnorm(5*n,85,15),
  viveiro = rep(1:2,each=(5*n)/2),
  ciclo = rep(1:n,each=5)
)
# An excel file will be saved to your Working Directory
# Use the file to import into the app
write.xlsx(bio,'bio.xlsx')

#--------------------------------------------------

####### Module #######

# UI Module
dashMenuUI <- function(id){
  ns <- NS(id)
  
  uiOutput(ns("tab_box"))
  
  
  
}

# Server Module
dashMenuServer <- function(id,df){
  moduleServer(id,function(input,output,session){
    
    ns <- session$ns
    nCiclo <- reactive(unique(df()$ciclo)) # nCycle is simply 1:6 sequence.
    
    output$tab_box <- renderUI({
      do.call(tabBox, c(id='tabCiclo',
                        lapply(nCiclo(), function(i) {
                          tabPanel(
                            paste('ciclo', i),
                            tableOutput(outputId =  ns(paste0('outCiclo',i)) )
                          )
                        }))
      )
    })
    
    # The problem is here. I want to put the lapply function as a function of the pond/tank (portuguese viveiro) number (simulated data).
    # but the nCycle() reactive doesn't work in place of 1:6
    lapply(1:6, function(j) {
      output[[paste0('outCiclo',j)]] <- renderTable({
        subset(df(), ciclo==j)
      })
    })
    
  })
}

#------------------------------------------------------

ui <- dashboardPage(
  dashboardHeader(title = "Teste Módulo TabBox Dinâmico"),
  dashboardSidebar(
    sidebarMenu(
      menuItem('Ciclo e viveiro',tabName = 'box_din')
    )
  ),
  dashboardBody(
    tabItems(
      tabItem(tabName='box_din',
              fileInput(inputId = "upload",label = "Carregue seu arquivo", accept = c(".xlsx")),
              dashMenuUI('tabRender')
      )
    )
  )
  
)

server <- function(input, output, session) {
  dados <- reactive({
    req(input$upload)
    file <- input$upload
    ext <- tools::file_ext(file$datapath)
    req(file)
    validate(need(ext == "xlsx", "Por gentileza insira um arquivo de Excel (extensão .xlsx)"))
    df <- read.xlsx(file$datapath,sheet = 1)
    df
  })
  # Ciclo output
  dashMenuServer('tabRender',dados)
  
  
}

shinyApp(ui, server)

当运行脚本的第一个会话注意到您在工作目录中得到一个 excel 文件 (.xlsx) 时，它是要导入应用程序的模拟数据。问题是 1:6 序列是固定的，不会因数据而异（面板中未呈现 6 以上的循环），当我将 1:6 替换为 nCiclo() （尝试自己测试）（在服务器模块中找到）不起作用。

不知道我说的清楚了没有，英文是不是看懂了，但是感谢大家花时间看题，对我的学习有帮助

Answer 1

调用 nCicle() 必须在反应环境中完成，@Mikael 的解决方案使用 observeEvent() 创建（请参阅评论）。另一种方法是简单地将 lapply(nCiclo(), ...)) 向上移动到 output$tab_box <- renderUI() 函数中：

output$tab_box <- renderUI({

  lapply(nCiclo(), function(j) {
    output[[paste0('outCiclo',j)]] <- renderTable({
      subset(df(), ciclo==j)
    })
  })
  
  
  do.call(tabBox, c(id='tabCiclo',
                    lapply(nCiclo(), function(i) {
                      tabPanel(
                        paste('ciclo', i),
                       tableOutput(outputId =  ns(paste0('outCiclo', i)) )
                      )}
                    ))
  )
})

在 Shiny 应用中创建动态内容的好例子。

在 Shiny 模块中使用 lapply() 函数构建带有多个 tabPanel 的 tabBox，其数量取决于导入的数据

Using the lapply() function in a Shiny module to build a tabBox with multiple tabPanel whose amount depends on the imported data

r

lapply

shiny

shinydashboard

shinymodules