如何在RMarkdown HTML文档中实现带下拉选择的动态STL时序分解图

核心思路 #

不用Shiny框架的话，我们可以通过批量生成各产品的STL分解可视化图表，再结合原生HTML下拉选择框和JavaScript实现动态切换，彻底避免手动逐个处理子集的重复工作。

步骤1：准备数据集 #

先构造符合要求的2018年起月度销售数据（包含产品A/B/C），如果是自有数据，直接替换这部分即可：

library(tidyverse)
library(tsibble)
library(highcharter)
library(stats)
library(htmltools)

# 生成模拟数据（自有数据可替换此处）
set.seed(123)
date_seq <- seq.Date(as.Date("2018-01-01"), as.Date("2023-12-01"), by = "month")
products <- rep(c("A", "B", "C"), each = length(date_seq))
sales <- c(
  ts(rnorm(length(date_seq), 50, 5) + seq(1, length(date_seq))*0.2, frequency = 12) %>% as.numeric(),
  ts(rnorm(length(date_seq), 40, 6) + seq(1, length(date_seq))*0.15 + sin(seq(1, length(date_seq))*pi/6), frequency = 12) %>% as.numeric(),
  ts(rnorm(length(date_seq), 60, 4) + seq(1, length(date_seq))*0.25 + cos(seq(1, length(date_seq))*pi/4), frequency = 12) %>% as.numeric()
)

sales_data <- tibble(date = rep(date_seq, 3), product = products, sales = sales) %>%
  as_tsibble(key = product, index = date)

步骤2：批量生成STL分解与可视化图表 #

用group_map按产品分组批量处理STL分解，同时为每个产品的图表分配唯一ID，方便后续切换控制：

# 批量生成各产品的STL分解图
stl_plots <- sales_data %>%
  group_by(product) %>%
  group_map(function(data, key) {
    # 转换为时间序列对象
    ts_data <- ts(data$sales, frequency = 12, start = c(2018, 1))
    # STL时序分解
    stl_result <- stl(ts_data, s.window = "periodic")
    # 生成highcharter可视化图表
    hc <- highchart() %>%
      hc_title(text = paste("产品", key$product, "STL时序分解")) %>%
      hc_xAxis(categories = format(data$date, "%Y-%m")) %>%
      hc_add_series(name = "原始序列", data = stl_result$time.series[, "data"], type = "line") %>%
      hc_add_series(name = "趋势项", data = stl_result$time.series[, "trend"], type = "line") %>%
      hc_add_series(name = "季节项", data = stl_result$time.series[, "seasonal"], type = "line") %>%
      hc_add_series(name = "残差项", data = stl_result$time.series[, "remainder"], type = "line") %>%
      hc_yAxis(title = list(text = "销售额")) %>%
      hc_legend(enabled = TRUE)
    # 将图表包裹在带唯一ID的div中
    div(id = paste0("stl-plot-", key$product), hc)
  }) %>%
  tagList()

步骤3：添加下拉选择框与切换逻辑 #

在RMarkdown中插入原生HTML下拉框，搭配JavaScript实现图表的显示/隐藏切换：

<div style="margin: 1em 0;">
  <label for="product-select">选择产品：</label>
  <select id="product-select">
    <option value="A" selected>产品A</option>
    <option value="B">产品B</option>
    <option value="C">产品C</option>
  </select>
</div>

<script>
// 初始状态：只显示产品A的图表，隐藏其他
document.querySelectorAll('[id^="stl-plot-"]').forEach(plot => {
  plot.style.display = plot.id === 'stl-plot-A' ? 'block' : 'none';
});

// 监听下拉框变化，切换对应图表
document.getElementById('product-select').addEventListener('change', function() {
  const selected = this.value;
  document.querySelectorAll('[id^="stl-plot-"]').forEach(plot => {
    plot.style.display = plot.id === `stl-plot-${selected}` ? 'block' : 'none';
  });
});
</script>

完整RMarkdown代码整合 #

将上述内容整合为可直接运行的RMarkdown文档，输出格式设为html_document：

---
title: "动态切换STL时序分解图"
output: html_document
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
library(tidyverse)
library(tsibble)
library(highcharter)
library(stats)
library(htmltools)

# 生成模拟数据（自有数据替换此处）
set.seed(123)
date_seq <- seq.Date(as.Date("2018-01-01"), as.Date("2023-12-01"), by = "month")
products <- rep(c("A", "B", "C"), each = length(date_seq))
sales <- c(
  ts(rnorm(length(date_seq), 50, 5) + seq(1, length(date_seq))*0.2, frequency = 12) %>% as.numeric(),
  ts(rnorm(length(date_seq), 40, 6) + seq(1, length(date_seq))*0.15 + sin(seq(1, length(date_seq))*pi/6), frequency = 12) %>% as.numeric(),
  ts(rnorm(length(date_seq), 60, 4) + seq(1, length(date_seq))*0.25 + cos(seq(1, length(date_seq))*pi/4), frequency = 12) %>% as.numeric()
)

sales_data <- tibble(date = rep(date_seq, 3), product = products, sales = sales) %>%
  as_tsibble(key = product, index = date)

# 批量生成各产品的STL分解图
stl_plots <- sales_data %>%
  group_by(product) %>%
  group_map(function(data, key) {
    ts_data <- ts(data$sales, frequency = 12, start = c(2018, 1))
    stl_result <- stl(ts_data, s.window = "periodic")
    hc <- highchart() %>%
      hc_title(text = paste("产品", key$product, "STL时序分解")) %>%
      hc_xAxis(categories = format(data$date, "%Y-%m")) %>%
      hc_add_series(name = "原始序列", data = stl_result$time.series[, "data"], type = "line") %>%
      hc_add_series(name = "趋势项", data = stl_result$time.series[, "trend"], type = "line") %>%
      hc_add_series(name = "季节项", data = stl_result$time.series[, "seasonal"], type = "line") %>%
      hc_add_series(name = "残差项", data = stl_result$time.series[, "remainder"], type = "line") %>%
      hc_yAxis(title = list(text = "销售额")) %>%
      hc_legend(enabled = TRUE)
    div(id = paste0("stl-plot-", key$product), hc)
  }) %>%
  tagList()

stl_plots

---

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