如何根据 Shiny 中的 select 输入调用不同的模块？

Question

I am trying to create a Shiny app where each module is completely independent from each other. I have two modules which should be saved in different R files.

Module 1 (both functions should be saved in a separate R script as 'module1.R')

module_ui1 <- function (id) {
    ns <- NS(id)
    tagList(
        fluidRow(
            box(width = 6, 
                sliderInput(ns("mean_first"), label = "Mean Var1",
                            min = 0, max = 100, value = 20)),
            box(width = 6, 
                sliderInput(ns("mean_second"), label = "Mean Var2",
                            min = 0, max = 100, value = 20))),
        fluidRow(box(width = 12, height= 440,
                     plotOutput(ns('output_plot')))))}

# Server
module_server1 <- function (input, output, session ){
    output$output_plot <- renderPlot({
        mean_first <- input$mean_first
        mean_second <- input$mean_second
        
        random_1<- rnorm(4, mean= mean_first, sd=10)
        random_2<- rnorm(4, mean= mean_second, sd=10)
        data<- data.frame(random_1, random_2)
        p<- ggplot(data, aes(x= random_1, y= random_2)) +
            geom_point()+
            ggtitle('Mod1')
        return(p) })
}

Module 2 - both functions should be saved in a separate R script as 'module2.R'

# UI
module_ui2 <- function (id) {
    ns <- NS(id)
    tagList(
        fluidRow(
            box(width = 6, 
                sliderInput(ns("mean_first"), label = "Mean Var1",
                            min = 0, max = 100, value = 20)),
            box(width = 6, 
                sliderInput(ns("mean_second"), label = "Mean Var2",
                            min = 0, max = 100, value = 20))),
        fluidRow(box(width = 12, height= 440,
                     plotOutput(ns('output_plot')))))}

# Server
module_server2 <- function (input, output, session ){
    output$output_plot <- renderPlot({
        mean_first <- input$mean_first
        mean_second <- input$mean_second
        
        random_1<- rnorm(4, mean= mean_first, sd=10)
        random_2<- rnorm(4, mean= mean_second, sd=10)
        data<- data.frame(random_1, random_2)
        p<- ggplot(data, aes(x= random_1, y= random_2)) +
            geom_point()+
            ggtitle('Mod2')
        return(p) })
}

In this example they will produce the same output except the plot title (Mod 1 or Mod2).

The app would look like this

source('module1.R', local = TRUE)
source('module2.R', local = TRUE)

library(shiny)
library(shinydashboard)
library(tidyverse)
library(modules)

ui <- fluidPage(
    # Application title
    titlePanel("App Modules"),

    sidebarLayout(
        sidebarPanel(
            selectInput("module", label =  "Module choices", choices =
                             c("Module 1"="mod1", "Module 2"="mod1"), 
                         selected = "mod2")
        ),

        mainPanel(
        
            conditionalPanel(condition = "module = 'mod1'",
                #Module 1
                module_ui1('module1_label') ), # connects with the server label
            conditionalPanel(condition = "module = 'mod2'",
                #Module 2
                module_ui2('module2_label') ) # connects with the server label
            
        )
    )
)

# Define server logic required to draw a histogram

server <- function(input, output) {
    
    # If the select input = mod1 call this
 callModule(module_server1, "module1_label")
    # If the select input = mod2 call this
 callModule(module_server2, "module2_label")
    
}


# Run the application 
shinyApp(ui = ui, server = server)

In the case both server modules are displayed. I would like that if the select input = mod1 to display module_server1 and if the select input = mod2 to display module_server2 .

I have tried this and it is not working.

    selected <- reactiveValues()
    observe({input$module})
    
    
    if (selected() == 'mod1') {
        callModule(module_server1, "module1_label")}
    
    else if (selected() == 'mod2') {
        callModule(module_server2, "module2_label")}

I know how to display with if statements insider reactive content, but I need more flexibility with output. Any ideas?

Thanks

Answer 1

Here's a rewrite of your main server and ui functions:

ui <- fluidPage(
  titlePanel("App Modules"),
  sidebarLayout(
    sidebarPanel(
      # Note: you had a typo in the choices list
      selectInput("module", label =  "Module choices", choices =
                    c("Module 1"="mod1", "Module 2"="mod2"), 
                  selected = "mod2")
    ),
    mainPanel(
      uiOutput("ui")
     )
  )
)

server <- function(input, output) {
  output$ui <- renderUI({
    if (input$module == "mod1") module_ui1("mod1")
    else module_ui1("mod2")
  })
  mod1 <- callModule(module_server1, "mod1")
  mod2 <- callModule(module_server2, "mod2")
}

I hope you have taken the time to simplify your real use case to create this MWE (if so thank you.) because you can get the same result with only one (parameterised) module...