在一个闪亮的模块中使用lApply()函数构建一个tabBox，其中包含多个tabPanel，其数量取决于导入的数据 [英] Using the lapply() function in a Shiny module to build a tabBox with multiple tabPanel whose amount depends on the imported data

问题描述

我想在SHILY中构建一个模块，将tabBox作为数据的函数呈现为tabPanel。模拟数据(参见下面的脚本)具有坦克或池塘变量(列)(葡萄牙语中的"；Viveiro"；)，其数量可以是一个变量。因此，电池板的数量是这个变量的函数。但最大的问题是，当我在每个tabPanel中呈现一个简单的表(带有renderTable())时，该表对应于每个&viveiro&qot；(水箱/池塘)的子集。我使用lapply()函数来构建renderUI，并将反应式表达式赋给输出(请参见下面的适用示例)。nCiclo()是表示和(你喜欢的水箱/池塘)的数量的反应，例如，可以对应于1:6的序列。对于output$tab_box，它在renderUI()中的第一个lapply()上运行得很好，但当我在第二个lapply()上对下面renderTable中的output[[paste0('outCiclo',j)]]输出使用它时，它就不起作用了。

问题： 如何将最后的lapply()函数作为模拟数据中&viveiro&(水箱/池塘)数量的函数？我尝试将修复序列1:6替换为反应性nCiclo()，但不起作用。

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替换为nCiclo()(尝试自己测试)(它在服务器模块中找到)时，1:6序列是固定的，并且不会随着数据的不同而变化(6以上的周期不会在面板中呈现)。

我不确定我是否讲得很清楚，或者英语是否可以理解，但我感谢您抽出时间阅读问题并帮助我学习。

推荐答案

调用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)) )
                      )}
                    ))
  )
})

在闪亮的应用程序中创建动态内容的好例子。

这篇关于在一个闪亮的模块中使用lApply()函数构建一个tabBox，其中包含多个tabPanel，其数量取决于导入的数据的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！