如何处理采样间隔不均的数据，计算两周滚动百分比变化？

针对采样间隔不固定的数据集，我们可以用两种方式解决两周百分比变化的计算问题：

方法一：基于最近的可用历史数据计算 #

直接匹配距离目标日期（当前日期减14天）最近的样本值进行计算，无需插值，逻辑简单高效。

代码实现 #

library(dplyr)
library(lubridate)
library(purrr)

# 加载并预处理数据
dat.N1 <- structure(list(date = c("2022-04-27", "2022-04-29", "2022-05-02", 
"2022-05-04", "2022-05-06", "2022-05-17", "2022-05-19", "2022-05-24", 
"2022-05-26", "2022-05-30", "2022-06-02", "2022-06-07", "2022-06-09", 
"2022-06-14", "2022-06-17", "2022-06-21", "2022-06-28", "2022-06-30", 
"2022-07-05", "2022-07-07", "2022-07-12"), copies_liter = c(168649.864, 
62449.256, 464682.88, 127620.624, 2110.27168, 20384.6968, 6817.724, 
145.2679712, 0.3792992, 51.4470568, 0.01, 30094.404, 42225.784, 
37688.632, 30730.0368, 8108.9016, 6142.6856, 7411.6464, 77131.912, 
23668.7056, 11973.198)), row.names = 210:230, class = "data.frame")

dat.N1 <- dat.N1 %>% mutate(date = as.Date(date))

# 计算两周百分比变化
dat.N1 <- dat.N1 %>%
  mutate(target_date = date - days(14)) %>%
  # 为每个target_date匹配最近的样本值
  mutate(past_copies = map_dbl(target_date, ~{
    dat.N1 %>%
      mutate(diff_days = abs(date - .x)) %>%
      arrange(diff_days) %>%
      slice(1) %>%
      pull(copies_liter)
  })) %>%
  mutate(
    prop = copies_liter / past_copies,
    perc_change = 100 - prop * 100
  )

说明 #

• 对每个日期，计算date-14作为目标日期
• 在数据集中找到与目标日期间隔最小的样本，用其copies_liter作为历史值
• 最终计算比例（当前值/历史值）和百分比变化（100 - 比例*100）

方法二：通过线性插值补全目标日期值后计算 #

先补全所有日期的copies_liter值（线性插值），再匹配date-14对应的插值结果，适合需要更贴合趋势的场景。

代码实现 #

library(dplyr)
library(lubridate)
library(zoo)

# 加载并预处理数据
dat.N1 <- structure(list(date = c("2022-04-27", "2022-04-29", "2022-05-02", 
"2022-05-04", "2022-05-06", "2022-05-17", "2022-05-19", "2022-05-24", 
"2022-05-26", "2022-05-30", "2022-06-02", "2022-06-07", "2022-06-09", 
"2022-06-14", "2022-06-17", "2022-06-21", "2022-06-28", "2022-06-30", 
"2022-07-05", "2022-07-07", "2022-07-12"), copies_liter = c(168649.864, 
62449.256, 464682.88, 127620.624, 2110.27168, 20384.6968, 6817.724, 
145.2679712, 0.3792992, 51.4470568, 0.01, 30094.404, 42225.784, 
37688.632, 30730.0368, 8108.9016, 6142.6856, 7411.6464, 77131.912, 
23668.7056, 11973.198)), row.names = 210:230, class = "data.frame")

dat.N1 <- dat.N1 %>% mutate(date = as.Date(date))

# 1. 生成完整日期序列并线性插值补全
dat_sorted <- dat.N1 %>% arrange(date)
full_dates <- data.frame(date = seq(min(dat_sorted$date), max(dat_sorted$date), by = "day"))
dat_interpolated <- full_dates %>%
  left_join(dat_sorted, by = "date") %>%
  mutate(copies_liter = na.approx(copies_liter, na.rm = FALSE))

# 2. 匹配目标日期的插值结果并计算百分比变化
dat.N1 <- dat.N1 %>%
  mutate(target_date = date - days(14)) %>%
  left_join(
    dat_interpolated %>% select(target_date = date, past_copies = copies_liter),
    by = "target_date"
  ) %>%
  mutate(
    prop = copies_liter / past_copies,
    perc_change = 100 - prop * 100
  )

说明 #

• 先按日期排序原始数据，生成从最早到最晚的完整日期序列
• 用na.approx对缺失日期的copies_liter进行线性插值
• 匹配每个日期对应的date-14插值结果，再计算比例和百分比变化

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