代码之家 › 专栏 › 技术社区 › Adela Iliescu

如何根据Shiny中的选择输入调用不同的模块?

module shiny r

Adela Iliescu · 技术社区 · 5 年前

我正在尝试创建一个闪亮的应用程序,其中每个模块都是完全独立的。我有两个模块,应该保存在不同的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) })
}

模块2-这两个函数都应保存在单独的R脚本中,作为“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) })
}

在本例中,除了绘图标题(Mod 1或Mod2),它们将产生相同的输出。

应用程序看起来像这样


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)

在这种情况下,将显示两个服务器模块。如果选择input=mod1显示 module_server1 如果选择input=mod2显示 module_server2 .

我试过这个,但不起作用。

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

我知道如何使用if语句显示内容,但我需要更灵活的输出。

0 回复 | 直到 5 年前

Limey 5 年前

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