在R Shiny中基于上传Excel文件生成带季度刻度的时序图

背景与现状 #

• 上传Excel文件
• 选择文件中的指定数据行，示例数据如下：
  
• 尝试根据选中行生成图表，当前生成的结果如下：
  

当前实现代码 #

library(shiny)
library(readxl)

ui <- fluidPage(
  titlePanel("AFSI Data Reformat"),
  sidebarLayout(
    sidebarPanel(
      fileInput("file1", "Choose xlsx file", accept = c(".xlsx")),
      numericInput("selected_row", "Select Row Number", value = 1, min = 1, step = 1),
      actionButton("generate_plot", "Generate Plot")
    ),
    mainPanel(
      tableOutput("selected_row_data"),
      plotOutput("selected_row_plot")
    )
  )
)

server <- function(input, output) {
  uploaded_data <- reactiveVal(NULL)
  selected_data <- reactiveVal(NULL)

  observe({
    inFile <- input$file1
    if (!is.null(inFile)) {
      uploaded_data(readxl::read_excel(inFile$datapath))
    }
  })

  output$selected_row_data <- renderTable({
    req(uploaded_data())
    selected_row <- input$selected_row

    if (selected_row <= nrow(uploaded_data())) {
      selected_data(uploaded_data()[selected_row, , drop = FALSE])
    } else {
      NULL
    }
  })

  output$selected_row_plot <- renderPlot({
    req(selected_data())
    plot_data <- selected_data()

    if (!is.null(plot_data) && all(sapply(plot_data, is.numeric))) {
      plot(
        x = plot_data[, 1], y = plot_data[, 2],
        xlab = colnames(plot_data)[1], ylab = colnames(plot_data)[2],
        main = paste("Row", input$selected_row, "Data"),
        xlim = range(plot_data[, 1], na.rm = TRUE),
        ylim = range(plot_data[, 2], na.rm = TRUE)
      )
    } else {
      # If data cannot be plotted, show a placeholder message
      plot(NULL,
        xlim = c(0, 1), ylim = c(0, 1),
        main = paste("Row", input$selected_row, "Data (Cannot be Plotted)")
      )
      text(0.5, 0.5, "Data cannot be plotted", col = "red", cex = 1.5)
    }
  })
}

shinyApp(ui, server)

具体需求 #

• 每行含128个数值，分别对应1993Q1至2023Q4的季度数据
• 生成能展示数值对应季度的图表（部分行仅含3个有效数值仍需生成图表，无有效数值时提示"Cannot generate plot due to missing values"）
• 优化图表外观

针对需求，从季度轴生成、缺失值处理、图表美化三个维度修改代码，以下是完整实现：

核心改动说明 #

1. 预先生成1993Q1到2023Q4的季度标签，作为图表X轴，匹配每行128个数据的顺序
2. 新增有效数值计数逻辑，无有效数值时显示指定提示，少量有效数值仍正常绘图
3. 使用ggplot2替代基础绘图系统，优化线条、点样式、坐标轴布局和主题风格

修改后的完整代码 #

library(shiny)
library(readxl)
library(ggplot2)
library(zoo) # 用于生成标准季度序列

# 预先生成1993Q1至2023Q4的季度标签
quarter_labels <- as.yearqtr(seq(from = as.Date("1993-01-01"), 
                                 to = as.Date("2023-10-01"), 
                                 by = "quarter"))
quarter_labels <- format(quarter_labels, "%YQ%q")

ui <- fluidPage(
  titlePanel("AFSI Data Reformat"),
  sidebarLayout(
    sidebarPanel(
      fileInput("file1", "选择Excel文件", accept = c(".xlsx")),
      numericInput("selected_row", "选择行号", value = 1, min = 1, step = 1),
      actionButton("generate_plot", "生成图表")
    ),
    mainPanel(
      tableOutput("selected_row_data"),
      plotOutput("selected_row_plot")
    )
  )
)

server <- function(input, output) {
  uploaded_data <- reactiveVal(NULL)
  selected_data <- reactiveVal(NULL)

  # 读取上传的Excel文件
  observe({
    inFile <- input$file1
    if (!is.null(inFile)) {
      uploaded_data(readxl::read_excel(inFile$datapath))
    }
  })

  # 展示选中行的数据
  output$selected_row_data <- renderTable({
    req(uploaded_data())
    selected_row <- input$selected_row

    if (selected_row <= nrow(uploaded_data())) {
      selected_data(uploaded_data()[selected_row, , drop = FALSE])
    } else {
      NULL
    }
  })

  # 生成图表
  output$selected_row_plot <- renderPlot({
    req(selected_data())
    plot_data <- selected_data()
    
    # 将单行数据转换为匹配季度标签的数据框
    plot_df <- data.frame(
      Quarter = quarter_labels,
      Value = as.numeric(plot_data)
    )
    
    # 统计有效数值数量
    valid_count <- sum(!is.na(plot_df$Value))
    
    if (valid_count == 0) {
      # 无有效数值时显示提示
      plot(NULL,
           xlim = c(0, 1), ylim = c(0, 1),
           main = paste("第", input$selected_row, "行数据"),
           xlab = "", ylab = "", axes = FALSE)
      text(0.5, 0.5, "Cannot generate plot due to missing values", 
           col = "red", cex = 1.5)
    } else {
      # 使用ggplot2绘制优化后的折线图
      ggplot(plot_df, aes(x = Quarter, y = Value, group = 1)) +
        geom_line(color = "#2c3e50", linewidth = 1.2) +
        geom_point(color = "#e74c3c", size = 2.5) +
        labs(
          title = paste("第", input$selected_row, "行季度数据"),
          x = "季度",
          y = "数值"
        ) +
        theme_minimal() +
        theme(
          plot.title = element_text(hjust = 0.5, size = 16, face = "bold"),
          axis.title = element_text(size = 14),
          axis.text.x = element_text(angle = 45, hjust = 1, size = 10),
          panel.grid.major = element_line(color = "#ecf0f1"),
          panel.grid.minor = element_blank()
        ) +
        # 可选：仅显示存在有效数据的季度，注释此行则显示全部季度
        scale_x_discrete(limits = plot_df$Quarter[!is.na(plot_df$Value)])
    }
  })
}

shinyApp(ui, server)

关键细节解释 #

• 季度序列生成：用zoo包的as.yearqtr快速生成标准季度标签，确保与128列数据完全对应
• 缺失值处理：通过sum(!is.na(...))精准统计有效数值，为0时触发提示，3个及以上有效数值正常绘图
• 图表美化：
  • 采用theme_minimal基础主题，风格简洁清爽
  • 折线和点使用高对比配色，提升数据辨识度
  • X轴标签旋转45度，避免密集重叠
  • 调整标题、坐标轴文字的大小和样式，增强可读性
  • 可选隐藏无数据的季度，减少空白区域干扰

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