Shiny中Base R多DataFrame同列绘图仅显示首个数据问题求助

问题背景 #

我有n个DataFrame，每个均包含A、B、C列，首行是列名，第二行是对应的小写列名（a、b、c），实际数据从第三行开始。希望在Shiny应用中使用base R，将通过radioButtons组件选中的列（A、B、C中的一个），在同一坐标轴上绘制所有通过file_num_2复选框选中的DataFrame的对应数据。但目前选中多个DataFrame时，仅首个选中的DataFrame数据会被绘制。

问题分析 #

原代码存在以下关键问题：

• 第一个for循环中使用break直接跳出，导致仅处理首个选中的文件
• 错误使用p = p+points()的方式添加数据点，base R的绘图是操作绘图设备，而非对象赋值
• 图例标签赋值错误，误将文件索引作为标签，且索引获取逻辑混乱
• 未初始化关键变量，当无选中文件时会引发报错

修正后的完整代码 #

library(shiny)
library(readxl)

ui <- fluidPage(
  titlePanel("Test App "),
  mainPanel(
    tabsetPanel(
      tabPanel(
        "Sample Data",
        fluidRow(
          column(
            width = 9,
            fileInput("file_1", "Please choose Excel file", multiple = TRUE, accept = ".xlsx", buttonLabel = "Browse")
          )
        )
      ),
      tabPanel(
        "Comparison Panel",
        uiOutput("Variables_2"),
        plotOutput(
          outputId = "live_plot_3",
          height = '250px',
          width = '250px',
          click = "plot_click_3",
          brush = brushOpts(id = "plot3_brush_3", resetOnNew = TRUE)
        )
      )
    )
  )
)

server <- function(input, output, session){
  files_list_creator_1 <- reactive({
    files_list <- list()
    for (paths in input$file_1$datapath){ 
      file_to_add <- as.data.frame(read_excel(paths))
      files_list <- append(files_list, list(file_to_add))
    }
    files_list
  })

  output$Variables_2 <- renderUI({
    req(files_list_creator_1())
    file_count <- length(files_list_creator_1())
    
    if (file_count == 0) {
      tagList(
        checkboxGroupInput(
          inputId = "file_num_2", 
          label ="选择要对比的文件", 
          choices = c("请先上传文件")
        ),
        radioButtons(
          inputId = "variable_to_plot",
          label = "选择要绘制的变量",
          choices = c("请先上传文件")
        )
      )
    } else {
      # 收集所有唯一的变量选项（列名+小写别名）
      all_vars <- lapply(files_list_creator_1(), function(df) {
        paste0(colnames(df), "  ", df[1,])
      }) %>% unlist() %>% unique()
      all_var_values <- lapply(files_list_creator_1(), colnames) %>% unlist() %>% unique()
      
      tagList(
        checkboxGroupInput(
          inputId = "file_num_2", 
          label ="选择要对比的文件", 
          choiceNames = input$file_1$name,
          choiceValues = as.character(1:file_count), 
          selected = as.character(1)
        ),
        radioButtons(
          inputId = "variable_to_plot",
          label = "选择要绘制的变量",
          choiceNames = all_vars,
          choiceValues = all_var_values,
          selected = colnames(files_list_creator_1()[[1]])[1]
        )
      )
    }
  })

  shifted_df = reactiveValues()
  observeEvent(input$file_1,{
    file_count <- length(files_list_creator_1())
    for (i in 1:file_count){
      shifted_df[[paste0(i)]] = files_list_creator_1()[[i]]
    }
  })

  output$live_plot_3 = renderPlot({
    req(input$file_num_2, input$variable_to_plot)
    
    selected_files <- as.integer(input$file_num_2)
    legend_labels <- input$file_1$name[selected_files]
    point_size <- 0.5
    point_type <- 19
    
    # 处理第一个选中的文件，绘制基础图
    first_file <- selected_files[1]
    df_first <- shifted_df[[paste0(first_file)]]
    x_col <- colnames(df_first)[1]
    y_col <- input$variable_to_plot
    
    # 提取实际数据（跳过前两行的列名和别名）并转换为数值型
    x_data <- as.numeric(df_first[-c(1,2), x_col])
    y_data <- as.numeric(df_first[-c(1,2), y_col])
    
    plot(x_data, y_data, 
         xlab = paste0(x_col, "  ", df_first[1, x_col]), 
         ylab = paste0(y_col, "  ", df_first[1, y_col]), 
         col = 1, pch= point_type, cex = point_size)
    
    # 处理剩余选中的文件，添加数据点
    if(length(selected_files) > 1){
      for(i in 2:length(selected_files)){
        current_file <- selected_files[i]
        df_current <- shifted_df[[paste0(current_file)]]
        
        if(y_col %in% colnames(df_current)){
          x_current <- as.numeric(df_current[-c(1,2), x_col])
          y_current <- as.numeric(df_current[-c(1,2), y_col])
          
          points(x_current, y_current, col = i, pch = point_type, cex = point_size)
        }
      }
      legend("topright", legend = legend_labels, col = 1:length(selected_files), pch = point_type)
    }
  })
  
  ranges_3 <- reactiveValues(x_3 = NULL, y_3 = NULL)
}

shinyApp(ui= ui, server = server)

关键修改说明 #

1. 移除break语句：原代码中第一个for循环的break导致仅处理首个文件，现在改为先绘制第一个文件的基础图，再循环处理剩余文件
2. 修正base R绘图逻辑：base R的plot和points是直接操作绘图设备，不需要赋值给变量，直接依次调用即可
3. 正确获取图例标签：使用input$file_1$name[selected_files]获取选中文件的原始名称，而非索引
4. 数据类型转换：跳过前两行的列名和别名，将实际数据转换为数值型，避免文本干扰绘图
5. 增加输入检查：在renderPlot开头添加req()确保输入存在后再执行绘图逻辑，避免空值报错
6. 简化变量收集逻辑：优化radioButtons的选项生成代码，更简洁高效

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