shiny - fancy sibling modules

r
shiny
Auteur

Simon Coulombe

Date de publication

17 février 2025

library(shiny)
library(ggplot2)
library(bslib)

# Module 1: Go Button
mod_go_button_ui <- function(id) {
  ns <- NS(id)
  actionButton(ns("go"), "Generate Data", class = "btn-primary")
}

mod_go_button_server <- function(id) {
  moduleServer(id, function(input, output, session) {
    return(reactive(input$go))
  })
}

# Module 2: Species Selection
mod_selectspecies_ui <- function(id) {
  ns <- NS(id)
  selectInput(ns("species"), "Select species:",
              choices = unique(iris$Species),
              selected = "setosa")
}

mod_selectspecies_server <- function(id) {
  moduleServer(id, function(input, output, session) {
    return(reactive(input$species))
  })
}

# Module 3: Data Preparation
mod_preparedata_server <- function(id, selected_species, go_trigger) {
  moduleServer(id, function(input, output, session) {
    eventReactive(go_trigger(), {
      req(selected_species())
      df <- subset(iris, Species == selected_species())
      return(df)
    })
  })
}

# Module 4: Y-Variable Selection
mod_select_yvar_ui <- function(id, label = "Select Y Variable:") {
  ns <- NS(id)
  selectInput(ns("y_var"), label,
              choices = c("Sepal.Width", "Petal.Length", "Petal.Width"),
              selected = "Sepal.Width")
}

mod_select_yvar_server <- function(id) {
  moduleServer(id, function(input, output, session) {
    return(reactive(input$y_var))
  })
}

# Module 5: Data Plotting
mod_plotdata_ui <- function(id) {
  ns <- NS(id)
  plotOutput(ns("plot"))
}

mod_plotdata_server <- function(id, prepared_data, y_var) {
  moduleServer(id, function(input, output, session) {
    output$plot <- renderPlot({
      df <- prepared_data()
      req(nrow(df) > 0, y_var())

      ggplot(df, aes(x = Sepal.Length, y = .data[[y_var()]])) +
        geom_point(size = 3, color = "steelblue") +
        labs(title = paste("Iris Species:", unique(df$Species)),
             y = y_var(), x = "Sepal.Length") +
        theme_minimal()
    })
  })
}

# Module 6: Data Table
mod_tabledata_ui <- function(id) {
  ns <- NS(id)
  tableOutput(ns("table"))
}

mod_tabledata_server <- function(id, prepared_data, y_var) {
  moduleServer(id, function(input, output, session) {
    output$table <- renderTable({
      df <- prepared_data()
      req(nrow(df) > 0, y_var())
      df[, c("Sepal.Length", y_var()), drop = FALSE]
    })
  })
}

# Parent Module
mod_outer_ui <- function(id,title = "outer") {
  ns <- NS(id)
  bslib::nav_panel(
    title = title,
    layout_sidebar(
      sidebar = sidebar(
        mod_go_button_ui(ns("go_button")),
        mod_selectspecies_ui(ns("species_select"))
      ),
      navset_tab(
        nav_panel("Plot",
                  mod_select_yvar_ui(ns("y_var_select_plot"), "Select Y Variable for Plot:"),
                  mod_plotdata_ui(ns("species_plot"))
        ),
        nav_panel("Table",
                  mod_select_yvar_ui(ns("y_var_select_table"), "Select Y Variable for Table:"),
                  mod_tabledata_ui(ns("species_table"))
        )
      )

    )
  )
}

mod_outer_server <- function(id) {
  moduleServer(id, function(input, output, session) {21w21
    go_trigger <- mod_go_button_server("go_button")
    selected_species <- mod_selectspecies_server("species_select")
    prepared_data <- mod_preparedata_server("prepare_data", selected_species, go_trigger)

    y_var_plot <- mod_select_yvar_server("y_var_select_plot")
    mod_plotdata_server("species_plot", prepared_data, y_var_plot)

    y_var_table <- mod_select_yvar_server("y_var_select_table")
    mod_tabledata_server("species_table", prepared_data, y_var_table)
  })
}

# Main App

ui <-  page_navbar(
  title = "prout",
  mod_outer_ui("outer1", title = "outer1"),
  mod_outer_ui("outer2", title = "outer2")
)

server <- function(input, output, session) {
  mod_outer_server("outer1")
  mod_outer_server("outer2")
}

shinyApp(ui, server)

Réutilisation

Citation

BibTeX
@online{coulombe2025,
  author = {Coulombe, Simon},
  title = {shiny - fancy sibling modules},
  date = {2025-02-17},
  url = {https://aidememoire.netlify.app/rstats/shiny_fancy_sibling_modules.html},
  langid = {fr}
}
Veuillez citer ce travail comme suit :
Coulombe, Simon. 2025. “shiny - fancy sibling modules.” February 17, 2025. https://aidememoire.netlify.app/rstats/shiny_fancy_sibling_modules.html.