0

I want to build a module in shiny that renders a tabBox with the number of tabPanel as a function of the data. The simulated data (see script below) has the tank or pond variable (column) ("viveiro" in Portuguese) whose quantity can be a variable. So the number of panels is a function of this variable. But the biggest problem is when inside each tabPanel I render a simple table (with renderTable()) that corresponds to a subset of each "viveiro" (tank/pond). I use the lapply() function both to build the renderUI and to assign the reactive expression to the outputs (see the applicable example below). nCiclo() is a reactive that represent the number of "viveiro" (tank/pond as you prefer) that can correspond to a sequence of 1:6 for example. It works well on the first lapply() in renderUI() for output$tab_box, but it doesn't work when I use it on the second lapply() for the output[[paste0('outCiclo',j)]] outputs in renderTable below.

Question: How do I put this last lapply() function as a function of the number of "viveiro" (tank/pond) in the simulation data? I tried to replace the fix sequence 1:6 for reactive nCiclo() but does not work.

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)

When running the first session of the script note that you get an excel file (.xlsx) in your Working Directory, it is the simulated data to import into the app. The problem is that the 1:6 sequence is fixed and doesn't vary depending on the data (the cycles above 6 are not rendered in the panels), when I replace 1:6 with nCiclo() (try to test for yourself) (it is found in the server module) doesn't work.

I'm not sure if I made myself clear or if the English are understandable, but I thank you for taking the time to read the problem and help in my learning.

1 Answers1

2

Calling nCicle() must be done in a reactive environment, which @Mikael's solution creates using observeEvent() (see comments). Another way is simply to move the lapply(nCiclo(), ...)) up into the output$tab_box <- renderUI() function:

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

Good example of creating dynamic content in a Shiny app.

Jeremy Caney
  • 7,102
  • 69
  • 48
  • 77