在 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

data.table data.table r r weighted-average