在R语言中按周聚合每日栅格数据并保留日期信息

我拥有NOAA提供的2022年每日冰雪范围栅格文件，需要计算该年度每周的最大冰范围。已用terra的tapp函数实现按周聚合，但希望将新生成的周度栅格命名为YYYYDDDYYYYDDD_ice格式（包含每周起止日期），确保能和其他周度栅格数据匹配作为掩膜。当前代码生成的栅格名称仅为周编号（如X00、X01），需要改进命名逻辑，也想了解rts或tidyterra是否能提供解决方案。

无需额外依赖rts，用terra+dplyr即可实现需求；tidyterra则能提供更贴合tidyverse风格的处理方式，以下是两种实现方案：

方案1：基于terra+dplyr的基础实现 #

核心思路是先建立周分组与起止日期的对应关系，再给聚合后的栅格重命名：

library(terra)
library(dplyr)

# 读取栅格（需提前定义ICE_path路径）
ICE_dat <- list.files(ICE_path, full.names = TRUE, pattern = ".tif$")
ICE_stack <- rast(ICE_dat)

# 提取日期信息
n <- names(ICE_stack)
year <- as.numeric(substr(n, 4, 7))
doy <- as.numeric(substr(n, 8, 10))
date <- as.Date(doy, origin = paste(year-1, "-12-31", sep = ""))

# 沿用原逻辑定义周分组
week <- floor(doy / 7) + 1
newweek <- c(0, 1, week[-c(364,365)])
myweek <- formatC(newweek, width=2, flag=0)

# 生成周分组与起止日期的映射表
date_week_map <- tibble(date = date, doy = doy, year = year, week_group = myweek) %>%
  group_by(week_group) %>%
  summarise(
    start_doy = min(doy),
    end_doy = max(doy),
    start_year = first(year),
    end_year = last(year)
  ) %>%
  mutate(
    # 生成目标格式的栅格名称
    raster_name = paste0(start_year, sprintf("%03d", start_doy), end_year, sprintf("%03d", end_doy), "_ice")
  )

# 为栅格设置时间属性
terra::time(ICE_stack) <- date

# 按周聚合求最大冰范围
wk <- tapp(ICE_stack, myweek, max, na.rm = TRUE)

# 重命名聚合后的栅格
names(wk) <- date_week_map$raster_name

# 查看最终命名结果
names(wk)

方案2：基于tidyterra的tidyverse风格实现 #

如果习惯管道语法，tidyterra可以将栅格数据转换为整洁数据框，更直观地完成分组计算：

library(tidyterra)
library(tidyverse)

# 读取栅格并转换为整洁格式
ice_tidy <- ICE_stack %>%
  as_tibble(xy = FALSE, na.rm = FALSE) %>%
  pivot_longer(cols = starts_with("ims"), names_to = "raster_name", values_to = "ice_value") %>%
  mutate(
    year = as.numeric(substr(raster_name, 4, 7)),
    doy = as.numeric(substr(raster_name, 8, 10)),
    date = as.Date(doy, origin = paste(year-1, "-12-31", sep = "")),
    week_group = myweek # 复用之前定义的周分组
  )

# 按周分组计算最大冰范围，并生成目标名称
ice_weekly <- ice_tidy %>%
  group_by(week_group) %>%
  mutate(
    start_doy = min(doy),
    end_doy = max(doy),
    start_year = first(year),
    end_year = last(year),
    raster_name = paste0(start_year, sprintf("%03d", start_doy), end_year, sprintf("%03d", end_doy), "_ice")
  ) %>%
  group_by(raster_name) %>%
  summarise(ice_value = max(ice_value, na.rm = TRUE))

# 将整洁数据框转换回SpatRaster格式
wk_tidy <- ice_weekly %>%
  pivot_wider(names_from = raster_name, values_from = ice_value) %>%
  as_spatraster()

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