Shiny模块双文件上传与叠加绘图问题求助

关键错误点梳理 #

1. 上传模块中模拟数据读取了错误的文件输入（误用input$file1而非input$file2）
2. 上传模块返回值格式错误：Shiny模块仅能返回单个对象，无法直接返回两个独立reactive
3. 主服务器传参错误：未从上传模块的返回结果中分别提取观测和模拟数据
4. 绘图模块中未调用reactive对象的取值方法（需加()获取实际数据集）

1. 修复上传模块（UploadServer） #

修正模拟数据的读取源，并将两个数据集封装为列表返回：

UploadServer <- function(id) {
  moduleServer(id, function(input, output, session) {
    ns <- session$ns

    # 读取观测数据
    observed_data <- reactive({
      req(input$file1)
      inFile <- input$file1
      read.csv(inFile$datapath,
               header = input$header, sep = input$sep,
               quote = input$quote
      )
    })

    # 读取模拟数据（修复：改为读取file2）
    simulated_data <- reactive({
      req(input$file2)
      inFile <- input$file2
      read.csv(inFile$datapath,
               header = input$header, sep = input$sep,
               quote = input$quote
      )
    })

    output$contents <- renderTable({
      observed_data()
    })

    output$contents_2 <- renderTable({
      simulated_data()
    })

    # 返回包含两个reactive的列表
    list(
      observed = observed_data,
      simulated = simulated_data
    )
  })
}

2. 修复主服务器参数传递 #

从上传模块返回的列表中分别提取两个数据集传入绘图模块：

server <- shinyServer(function(input, output, session) {
  upload_data <- UploadServer("upload")
  PlotServer("plot", df = upload_data$observed, df_2 = upload_data$simulated )
})

3. 修复绘图模块的数据集调用 #

在ggplot中调用reactive对象时需加()获取实际数据：

plot_1<-reactive({
  graph2 <- ggplot() +
    # 修复：使用df()而非df
    geom_point(data = df(), aes(.data[[input$obsxcol]], .data[[input$obsycol]]), size=1) +
    # 修复：使用df_2()而非df_2
    geom_line(data = df_2(), aes(.data[[input$simxcol1]]/60, .data[[input$simycol1]])) +
    theme_bw()

  if(input$logyobs){
    graph2 <- graph2 + scale_y_log10()
  }

  if(input$logxobs){
    graph2 <- graph2 +  scale_x_log10()
  }

  graph2
}) |> bindEvent(input$plot_vis_1)

完整修正后代码 #

UploadUI <- function(id) {
  ns <- NS(id)
  tabPanel(
    "Upload File",
    titlePanel("Uploading Files"),
    sidebarLayout(
      sidebarPanel(
        fileInput(ns("file1"), "Observed data",
                  accept = c(
                    "text/csv",
                    "text/comma-separated-values,text/plain",
                    ".csv"
                  )
        ),
        fileInput(ns("file2"), "sim data",
                  accept = c(
                    "text/csv",
                    "text/comma-separated-values,text/plain",
                    ".csv"
                  )

        ),
        tags$br(),
        checkboxInput(ns("header"), "Header", TRUE),
        radioButtons(
          ns("sep"),
          "Separator",
          c(
            Comma = ",",
            Semicolon = ";",
            Tab = "\t"
          ),
          ","
        ),
        radioButtons(
          ns("quote"),
          "Quote",
          c(
            None = "",
            "Double Quote" = '"',
            "Single Quote" = "'"
          ),
          '"'
        )
      ),
      mainPanel(
        tableOutput(ns("contents")),
        br(),
        tableOutput(ns("contents_2"))
      )
    )
  )
}

UploadServer <- function(id) {
  moduleServer(id, function(input, output, session) {
    ns <- session$ns

    observed_data <- reactive({
      req(input$file1)
      inFile <- input$file1
      read.csv(inFile$datapath,
               header = input$header, sep = input$sep,
               quote = input$quote
      )
    })

    simulated_data <- reactive({
      req(input$file2)
      inFile <- input$file2
      read.csv(inFile$datapath,
               header = input$header, sep = input$sep,
               quote = input$quote
      )
    })

    output$contents <- renderTable({
      observed_data()
    })

    output$contents_2 <- renderTable({
      simulated_data()
    })

    list(
      observed = observed_data,
      simulated = simulated_data
    )
  })
}

###############################################

PlotUI <- function(id) {
  ns <- NS(id)

  tabPanel("Visualisation",

           sidebarLayout(
             sidebarPanel(
               p("Observed data"),
               fluidRow(
                 column(6,
                        selectInput(ns('obsxcol'), 'X Variable', "",width=140)

                 ),
                 column(6,
                        selectInput(ns('obsycol'), 'Y Variable', "", selected = "",width=140)

                 )

               ),
               p("Simulated data"),
               fluidRow(
                 column(6,
                        selectInput(ns('simxcol1'), 'X Variable', "",width=140)


                 ),
                 column(6,
                        selectInput(ns('simycol1'), 'Y Variable', "", selected = "",width=140),

                 )

               ),
               fluidRow(
                 column(6,
                        checkboxInput(ns("logxobs"), "logX", FALSE, width=140)
                 ),
                 column(6,
                        checkboxInput(ns("logyobs"), "logY", FALSE, width=140)


                 )

               ),
               hr(),
               fluidRow(
                 actionButton(ns("plot_vis_1"), "Plot!")

               )

             ),
             mainPanel(
               plotOutput(ns('plotsim_1'))
             )

           )

  )
}

PlotServer <- function(id, df, df_2) {
  stopifnot(is.reactive(df))
  stopifnot(is.reactive(df_2))

  moduleServer(id, function(input, output, session) {
    ns <- session$ns

    observeEvent(df(),{
      updateSelectInput(session, inputId = 'obsxcol', label ='X variable',
                        choices = names(df()), selected = names(df()))

      updateSelectInput(session, inputId = 'obsycol', label ='Y variable',
                        choices = names(df()), selected = names(df())[2])
    })

    observeEvent(df_2(),{
      updateSelectInput(session, inputId = 'simxcol1', label ='X variable',
                        choices = names(df_2()), selected = names(df_2()))

      updateSelectInput(session, inputId = 'simycol1', label ='Y variable',
                        choices = names(df_2()), selected = names(df_2())[2])
    })

    plot_1<-reactive({
      graph2 <- ggplot() +
        geom_point(data = df(), aes(.data[[input$obsxcol]], .data[[input$obsycol]]), size=1) +
        geom_line(data = df_2(), aes(.data[[input$simxcol1]]/60, .data[[input$simycol1]])) +
        theme_bw()

      if(input$logyobs){
        graph2 <- graph2 + scale_y_log10()
      }

      if(input$logxobs){
        graph2 <- graph2 +  scale_x_log10()
      }

      graph2
    }) |> bindEvent(input$plot_vis_1)

    output$plotsim_1 <-renderPlot({
      plot_1()
    })
  })
}

ui <- shinyUI(fluidPage(
  titlePanel("Column Plot"),
  tabsetPanel(
    UploadUI("upload"),
    PlotUI("plot")
  )
))

server <- shinyServer(function(input, output, session) {
  upload_data <- UploadServer("upload")
  PlotServer("plot", df = upload_data$observed, df_2 = upload_data$simulated )
})

shinyApp(ui, server)

内容的提问来源于stack exchange，提问作者EnriqueGG