在 R data.table 中按组修剪平均值

Question

我有一个 data.table，我想在其中按月查找列 performance 的加权平均值。

  dat <- structure(list(year = c(2014, 2015, 2016, 2017, 2018, 2019, 2020, 
                                 2021, 2014, 2015, 2016, 2017, 2018, 2019, 2020), 
                        month = c(2, 
                                  2, 2, 2, 2, 2, 2, 2, 10, 10, 10, 10, 10, 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"))

这个 data.table 看起来像以下 -

    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)[, lapply(.SD, function(x) mean(x, na.rm = TRUE)), by = .(month), .SDcols = c("performance")]

使用简单平均后的结果如下，与weighted.mean的结果相同。

   month performance
1:     2   0.3576029
2:    10   0.3032712

期望的结果应该对每一年的表现给予同等的重视，这样某一年的出色表现就不会错误地表明该产品在每年的那个月销售得非常好。

有人可以指出我的加权平均计算有什么问题吗？

Answer 1

作为一个新的 Whosebug 用户，我无法在 post 上添加 commnets，所以我会在这里添加我的疑问。

一般来说，您提供的代码会得到一个简单的均值，我不清楚您想要什么，因为通常当您需要加权均值时，您会使用第二个变量作为权重。

在你的例子中，一个简单的意思是 return 相同的输出：

library(dplyr)

dat %>% 
  group_by(month) %>% 
  summarise(performance = mean(performance))

Answer 2

如果您使用 weighted.mean 函数而不指定权重，它会简单地为您计算一个平均值。要正确计算它，您可以在 weighted.mean 函数中将权重指定为第二个参数。

library(data.table)
dat <- structure(list(year = c(2014, 2015, 2016, 2017, 2018, 2019, 2020, 
                               2021, 2014, 2015, 2016, 2017, 2018, 2019, 2020), 
                      month = c(2, 
                                2, 2, 2, 2, 2, 2, 2, 10, 10, 10, 10, 10, 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 作为我的权重，你需要用精确的 values/weights 来代替这个。然后只需将此参数作为参数添加到您的 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 结果：

Answer 3

你可以简单地 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, na.rm = TRUE, ...) {
  qnt <- quantile(x, probs=c(.25, .75), na.rm = na.rm, ...)
  y <- x
  y[x < (qnt[1] )] <- qnt[1]
  y[x > (qnt[2] )] <- qnt[2] 
  y
}

setDT(dat)[, lapply(.SD, function(x) mean(limit_outliers(x), na.rm = TRUE)), by = .(month), .SDcols = c("performance")]

month performance
1:     2   0.3261458
2:    10   0.3432951

在 R data.table 中按组修剪平均值

Trimmed mean by group in R data.table

r

weighted-average

data.table