0

我想构建一个闪亮的模块，将 atabBox的数量tabPanel作为数据的函数呈现。模拟数据（请参见下面的脚本）具有罐或池塘变量（列）（葡萄牙语中的“viveiro”），其数量可以是变量。所以面板的数量是这个变量的函数。但最大的问题是，当tabPanel我在每个内部渲染一个简单的表（带有renderTable()）时，它对应于每个“viveiro”（坦克/池塘）的子集。我使用该lapply()函数来构建renderUI和将反应表达式分配给输出（参见下面的适用示例）。nCiclo()是一个反应式，表示可以对应于序列的“viveiro” （您喜欢的坦克/池塘）的数量1:6例如。它lapply()在renderUI()for的第一个中运行良好，但是当我在第二个中将它用于下面的输出output$tab_box时它不起作用。lapply()output[[paste0('outCiclo',j)]]renderTable

问题： 如何将最后一个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顺序是固定的，不会因数据而异（面板中未呈现 6 以上的循环），当我替换1:6为nCiclo()（尝试自己测试）时（在服务器模块中找到）不起作用。

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

4

1 回答 1

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 应用程序中创建动态内容的好例子。

于 2021-12-01T17:23:24.613 回答