如何解决在 R data.table 中按组修剪平均值
我有一个 data.table,我想在其中按月查找列 performance
的加权平均值。
dat <- structure(list(year = c(2014,2015,2016,2017,2018,2019,2020,2021,2014,2020),month = c(2,2,10,10),performance = c(0.826973794097158,0.61975709469356,0.924350659523548,-0.183133219063708,-0.529913189565746,-0.148531188902535,-0.0773058814083695,1.42862504650241,0.465498268732376,0.148719963224136,0.205614191281359,0.560651497949418,-0.484408605607923,0.875353374774486,0.351469397380814)),row.names = c(NA,-15L),class = c("data.table","data.frame"))
此数据表如下所示 -
year month performance
1: 2014 2 0.82697379
2: 2015 2 0.61975709
3: 2016 2 0.92435066
4: 2017 2 -0.18313322
5: 2018 2 -0.52991319
6: 2019 2 -0.14853119
7: 2020 2 -0.07730588
8: 2021 2 1.42862505
9: 2014 10 0.46549827
10: 2015 10 0.14871996
11: 2016 10 0.20561419
12: 2017 10 0.56065150
13: 2018 10 -0.48440861
14: 2019 10 0.87535337
15: 2020 10 0.35146940
要按月查找加权平均值,我使用了以下代码 -
setDT(dat)[,lapply(.SD,function(x) weighted.mean(x,na.rm = TRUE)),by = .(month),.SDcols = c("performance")]
我得到的结果是 -
month performance
1: 2 0.3576029
2: 10 0.3032712
然而,10
月的加权平均表现应该大于 2
月,因为它有更多的正值。
似乎只有 2021 年的 2
月对其性能产生了严重影响,导致其表现优于 10
月。
实际上,上面的代码只找到了 mean
而不是 weighted.mean
。如果我使用 mean
而不是 weighted.mean
,结果是一样的。
setDT(dat)[,function(x) mean(x,.SDcols = c("performance")]
使用简单均值后的结果如下,与weighted.mean的结果相同。
month performance
1: 2 0.3576029
2: 10 0.3032712
期望的结果应该对每一年的表现给予同等的重视,这样某一特定年份的出色表现不会错误地表明该产品在该月的每一年都卖得很好。
有人能指出我的加权平均计算有什么问题吗?
解决方法
作为一个新的stackoverflow用户,我无法在帖子中添加commnets,所以我会在这里添加我的疑问。
一般来说,您提供的代码会得到一个简单的平均值,但我不清楚您想要什么,因为通常当您想要加权平均值时,您会使用第二个变量作为权重。
在你的情况下,一个简单的平均值返回相同的输出:
library(dplyr)
dat %>%
group_by(month) %>%
summarise(performance = mean(performance))
,
如果您使用 weighted.mean 函数而不指定权重,它只会为您计算平均值。要正确计算它,您可以在 weighted.mean 函数中将您的权重指定为第二个参数。
library(data.table)
dat <- structure(list(year = c(2014,2015,2016,2017,2018,2019,2020,2021,2014,2020),month = c(2,2,10,10),performance = c(0.826973794097158,0.61975709469356,0.924350659523548,-0.183133219063708,-0.529913189565746,-0.148531188902535,-0.0773058814083695,1.42862504650241,0.465498268732376,0.148719963224136,0.205614191281359,0.560651497949418,-0.484408605607923,0.875353374774486,0.351469397380814)),row.names = c(NA,-15L),class = c("data.table","data.frame"))
head(dat)
setDT(dat)
dat[,.(weighted.mean(performance)),by = month]
dat[,.(mean(performance)),by = month]
R 执行
因此,要解决此问题,您可以执行以下操作: 将一列权重添加到您的数据集中。我添加了 wt 变量作为我的权重。在这里,我只是简单地将序列 1 到 15 作为我的权重,您需要用确切的值/权重代替它。然后只需将此参数作为参数添加到您的 weighted.mean 函数中,我认为这应该可以解决您的问题。
dat$wt <- 1:nrow(dat)
weighted.mean(dat$performance,dat$wt) # will give you full column weighted mean
dat[,.(weighted.mean(performance,wt)),by = .(month)] # will give you weighted mean by month
R 结果:
,你可以简单地remove outliers:
remove_outliers <- function(x,na.rm = TRUE,...) {
qnt <- quantile(x,probs=c(.25,.75),na.rm = na.rm,...)
H <- 1.5 * IQR(x,na.rm = na.rm)
y <- x
y[x < (qnt[1] - H)] <- NA
y[x > (qnt[2] + H)] <- NA
y
}
setDT(dat)[,lapply(.SD,function(x) mean(remove_outliers(x))),by = .(month),.SDcols = c("performance")]
month performance
1: 2 0.3576029
2: 10 0.4345511
或者限制异常值,例如第一和第三四分位数:
limit_outliers <- function(x,...)
y <- x
y[x < (qnt[1] )] <- qnt[1]
y[x > (qnt[2] )] <- qnt[2]
y
}
setDT(dat)[,function(x) mean(limit_outliers(x),na.rm = TRUE)),.SDcols = c("performance")]
month performance
1: 2 0.3261458
2: 10 0.3432951
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。