app.R 无法识别 shinyApp 中的模块

Question

我想让我的 shinyApp 模块化。

为此，我从基础开始，我只有基础 app.R 和一个模块 plot.R 来绘制数据。

但是，即使没有错误信息，模块部分也没有正确执行，因为在选择数据并执行分析后没有得到图。

# Shiny
library(shiny)
library(shinyWidgets)
library(shinyjqui)
library(bslib)
library(shinybusy) # For busy spinners
library(shinyjs)

# Data
library(readxl)
library(dplyr)

# Plots
library(ggplot2)

# Stats
library(stats)   #fisher.test, wilcox.test
library(effsize) #Cohen.d

# Sources
source("plot.R")


not_sel <- "Not Selected"

# User interface
ui <- navbarPage(
  title = "Plotter",
  windowTitle = "Plotter",
  tabPanel(
    useShinyjs(),
    title = "Plotter",
    titlePanel(""),
    sidebarLayout(
      sidebarPanel(
        title = "Inputs",
        fileInput("xlsx_input", "Select XLSX file to import", accept = c(".xlsx")),
        selectInput("num_var_1", "Variable X axis", choices = c(not_sel)),
        selectInput("num_var_2", "Variable Y axis", choices = c(not_sel)),
        actionButton("run_button", "Run Analysis", icon = icon("play"))
      ),
      mainPanel(
        tabsetPanel(
          tabPanel(
            title = "Plot",
            value = 1,
            
            # UI from the plot module
            plotUI("Plot1")
          )
        )
      )
    )
  )
)

# Server

server <- function(input, output, session){
  
  # Dynamic selection of the data
  data_input <- reactive({
    #req(input$xlsx_input)
    #inFile <- input$xlsx_input
    #read_excel(inFile$datapath, 1)
    iris
  })
  
  # We update the choices available for each of the variables
  observeEvent(data_input(),{
    choices <- c(not_sel, names(data_input()))
    updateSelectInput(inputId = "num_var_1", choices = choices)
    updateSelectInput(inputId = "num_var_2", choices = choices)
  })
  
  num_var_1 <- eventReactive(input$run_button, input$num_var_1)
  num_var_2 <- eventReactive(input$run_button, input$num_var_2)
  
  
  # Server part of the love plot module
  plotServer("Plot1")
  
}


# Connection for the shinyApp
shinyApp(ui = ui, server = server)

plotUI <- function(id, label="Plot") {
  ns <- NS(id)
  tagList(
    plotOutput("sel_graph")
  )
}
  
plotServer <- function(id) {
  moduleServer(id, function(input, output, session) {
    
      draw_boxplot <- function(data_input, num_var_1, num_var_2){
        
        if(num_var_1 != not_sel & num_var_2 != not_sel){
          ggplot(data = data_input, aes(x = .data[[num_var_1]], y = .data[[num_var_2]])) +
            geom_boxplot(fill = c("#16558F","#61B0B7","#B8E3FF")) + 
            theme_bw()
        }
      }
      
      ## BoxPlot -------------------------------------------------------------------
      
      plot_1 <- eventReactive(input$run_button,{
        req(data_input())
        draw_boxplot(data_input(), num_var_1(), num_var_2())
      })
      
      
      output$sel_graph <- renderPlot(
        plot_1()
      )
    }
  )
}

Answer 1

主要问题是模块找不到 input$run_button，因为它有不同的命名空间。我们需要的是一种与模块通信的方式，即传递额外的参数给模块调用。

注意：在模块内传递给 ggplot 的 fill 参数将导致绘图仅适用于 Species 变量。

应用代码：

# Shiny
library(shiny)
library(shinyWidgets)
library(shinyjqui)
library(bslib)
library(shinybusy) # For busy spinners
library(shinyjs)

# Data
library(readxl)
library(dplyr)

# Plots
library(ggplot2)

# Stats
library(stats) # fisher.test, wilcox.test
library(effsize) # Cohen.d

# Sources
# source("plot.R")

plotUI <- function(id, label = "Plot") {
  tagList(
    plotOutput(NS(id, "sel_graph"))
  )
}

plotServer <- function(id, data, num_var_1, num_var_2, bttn) {
  moduleServer(id, function(input, output, session) {
    observe(print(num_var_1()))


    plot_1 <- eventReactive(bttn(), {
      req(data())
      if (isolate(num_var_1()) != not_sel & isolate(num_var_2()) != not_sel) {
        ggplot(data = data(), aes(x = get(isolate(num_var_1())), y = get(isolate(num_var_2())))) +
          geom_boxplot(fill = c("#16558F", "#61B0B7", "#B8E3FF")) +
          theme_bw()
      }
    })

    ## BoxPlot -------------------------------------------------------------------



    output$sel_graph <- renderPlot(
      plot_1()
    )
  })
}

not_sel <- "Not Selected"

# User interface
ui <- navbarPage(
  title = "Plotter",
  windowTitle = "Plotter",
  tabPanel(
    useShinyjs(),
    title = "Plotter",
    titlePanel(""),
    sidebarLayout(
      sidebarPanel(
        title = "Inputs",
        fileInput("xlsx_input", "Select XLSX file to import", accept = c(".xlsx")),
        selectInput("num_var_1", "Variable X axis", choices = c(not_sel)),
        selectInput("num_var_2", "Variable Y axis", choices = c(not_sel)),
        actionButton("run_button", "Run Analysis", icon = icon("play"))
      ),
      mainPanel(
        tabsetPanel(
          tabPanel(
            title = "Plot",
            value = 1,

            # UI from the plot module
            plotUI("Plot1")
          )
        )
      )
    )
  )
)

# Server

server <- function(input, output, session) {

  # Dynamic selection of the data
  data_input <- reactive({
    # req(input$xlsx_input)
    # inFile <- input$xlsx_input
    # read_excel(inFile$datapath, 1)
    iris
  })

  # We update the choices available for each of the variables
  observeEvent(data_input(), {
    choices <- c(not_sel, names(data_input()))
    updateSelectInput(inputId = "num_var_1", choices = choices)
    updateSelectInput(inputId = "num_var_2", choices = select(data_input(), where(is.factor)) %>% names())
  })

  num_var_1 <- eventReactive(input$run_button, input$num_var_1)
  num_var_2 <- eventReactive(input$run_button, input$num_var_2)


  # Server part of the love plot module
  plotServer("Plot1", data_input, reactive(input$num_var_1), reactive(input$num_var_2), reactive(input$run_button))
}


# Connection for the shinyApp
shinyApp(ui = ui, server = server)

app.R 无法识别 shinyApp 中的模块

Module in shinyApp not recognize by app.R

module

r

shiny