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

Posted 2023-02-19

【中文标题】shinyApp 中的模块无法被 app.R 识别

【英文标题】：Module in shinyApp not recognize by app.R

【发布时间】：2022-01-23 19:35:02

【问题描述】：

我希望我的 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()
      )
    
  )
 

【问题讨论】：

试试plotOutput(ns("sel_graph"))，因为你缺少ns（命名空间）。

【参考方案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)