我的R语言月度SMAPE计算函数异常，求技术排查

问题描述 #

作为R语言函数编写新手，尝试为模型按月份计算SMAPE，但基础函数仅算出单一值，无法得到每个月份的不同结果。

原代码问题分析 #

原代码存在两个核心问题：

• smape1函数中的for循环无效，第一次迭代就执行return直接返回结果，且函数依赖全局变量data$month，未利用传入的参数
• 使用by函数时，匿名函数未使用分组后的子集数据，始终调用全局的data$actual和data$consensus2，导致所有月份返回相同的整体SMAPE值

修正方案 #

方案1：使用tidyverse分组计算（推荐） #

利用dplyr的分组功能，直接按月份聚合计算SMAPE，代码简洁易读：

# 加载包
library(lubridate)
library(tidyverse)

# 可直接运行的数据集
data <- structure(list(date = structure(c(18948, 18949, 18950, 18951, 
18952, 18953, 18954, 18955, 18956, 18957, 18958, 18959, 18960, 
18961, 18962, 18963, 18964, 18965, 18966, 18967, 18968, 18969, 
18970, 18971, 18972, 18973, 18974, 18975, 18976, 18977, 18978, 
18979, 18980, 18981, 18982, 18983, 18984, 18985, 18986, 18987, 
18988, 18989, 18990, 18991, 18992, 18993, 18994, 18995, 18996, 
18997, 18998, 18999, 19000, 19001, 19002, 19003, 19004, 19005, 
19006, 19007, 19008, 19009, 19010, 19011, 19012, 19013, 19014, 
19015, 19016, 19017, 19018, 19019, 19020, 19021, 19022, 19023, 
19024, 19025, 19026, 19027, 19028, 19029, 19030, 19031, 19032, 
19033, 19034, 19035, 19036, 19037, 19038, 19039, 19040, 19041, 
19042, 19043), class = "Date"), actual = c(2875, 2755, 2440, 
2220, 1378, 1352, 2616, 1709, 1475, 2315, 2223, 4357, 3037, 1725, 
2332, 2358, 3135, 3232, 3497, 2876, 2971, 3530, 4268, 4692, 3589, 
3496, 4233, 4336, 5810, 6943, 8921, 7491, 8607, 10450, 11309, 
13367, 18607, 23426, 19244, 29256, 21001, 27023, 29346, 39840, 
41210, 37503, 38473, 35618, 40713, 39363, 43142, 44309, 38706, 
34988, 33483, 28847, 32719, 31248, 31502, 19896, 19025, 23586, 
20977, 22323, 23900, 22966, 15038, 14283, 15827, 13900, 18274, 
18325, 17514, 10616, 8828, 10580, 8888, 15072, 14208, 14426, 
7815, 6841, 7257, 8003, 11034, 10637, 10189, 6143, 4401, 5911, 
6164, 8030, 10151, 4180, 6929, 3377), consensus2 = c(2899, 2735, 
2485, 2199, 1297, 1414, 3026, 1535, 1588, 2435, 2341, 3095, 2241, 
2480, 3098, 2513, 2886, 3289, 3427, 3060, 3050, 3564, 3803, 4204, 
3188, 3184, 4071, 4063, 4974, 5839, 6641, 6146, 6620, 8446, 11112, 
13071, 14963, 18807, 20670, 21149, 22824, 28484, 29376, 31969, 
37669, 37706, 42511, 39104, 41362, 44855, 48043, 46670, 40384.96296, 
42612.53704, 37730, 38351, 33813, 35651, 31475, 19364, 19364, 
19892, 20436, 21114, 21221, 23002, 18035, 15320, 16292, 15735, 
14726, 17844, 17635.77778, 11904.48148, 10763.7037, 9986.611111, 
9986.611111, 10604.22222, 14246.90741, 14113.55556, 9113.425926, 
8236.5, 8759.888889, 7436.462963, 10489.37037, 10507.09259, 9969.5, 
5272.111111, 5729.092593, 5989.055556, 6245, 8267.314815, 7844.481481, 
3176.703704, 8661.944444, 3320.055556)), row.names = c(NA, -96L
), class = c("tbl_df", "tbl", "data.frame"))

# 按月份计算SMAPE
data %>%
  mutate(month = lubridate::month(date, label = TRUE)) %>%
  group_by(month) %>%
  summarise(
    smape = 1/n() * sum(2 * abs(consensus2 - actual) / (abs(actual) + abs(consensus2)) * 100),
    .groups = "drop"
  )

方案2：修正原函数和by的用法 #

如果坚持使用by函数，需修改函数使其仅依赖传入参数，并正确调用分组后的子集：

# 加载包
library(lubridate)
library(tidyverse)

# 数据同上，省略重复代码

# 修正SMAPE函数：仅接收实际值和预测值参数
smape1 <- function(a, f) {
  if (length(a) != length(f)) stop("实际值和预测值长度不一致")
  1/length(a) * sum(2 * abs(f - a) / (abs(a) + abs(f)) * 100)
}

# 生成月份列
data$month <- lubridate::month(data$date, label = TRUE)

# 使用by分组计算：匿名函数调用分组后的子集数据
SMAPE_bymonth <- by(data, data$month, function(x) {
  smape1(x$actual, x$consensus2)
})

# 查看结果
SMAPE_bymonth

结果说明 #

两种方案都会输出每个月份对应的SMAPE值，解决了原代码所有月份返回相同结果的问题。其中tidyverse分组计算更符合现代R编码风格，可读性和可维护性更高。

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