如何在纵向数据集中进行Winsorize处理（或删除单变量异常值）

Question

我正在尝试找出如何对纵向数据集中的个体分组进行Winsorize处理。

我最初看到这篇关于如何从变量的平均值中去除>2个标准差的数据的优秀答案。作者还有帮助性地演示了如何在类别内完成此操作。

我的用例略有不同：我有一个纵向数据集，我想删除随时间系统性显示为离群值的个体。我不想在主题内部取出极端观察值，而是要么完全排除这些个体（修剪数据），要么用截断值（Winsorizing）替换底部和顶部2.5％的值 (参见：http://en.wikipedia.org/wiki/Winsorising)。

例如，我的长格式数据可能如下所示：

name time points
MJ   1    998
MJ   2    1000
MJ   3    998
MJ   4    3000
MJ   5    998
MJ   5    420
MJ   6    999
MJ   7    998
Lebron   1    9
Lebron   2    1
Lebron   3    3
Lebron   4    900
Lebron   5    4
Lebron   5    4
Lebron   6    3
Lebron   7    8
Kobe   1    2
Kobe   2    1
Kobe   3    4
Kobe   4    2
Kobe   5    1000
Kobe   5    4
Kobe   6    7
Kobe   7    9
Larry   1    2
Larry   2    1
Larry   3    4
Larry   4    2
Larry   5    800
Larry   5    4
Larry   6    7
Larry   7    9

如果我想在个体（name）中删除points的极端值，我的代码应该是：

do.call(rbind,by(df,df$name,function(x) x[!abs(scale(x$points)) > 2,]))

但是我真正想做的是排除那些极端的个体（在这种情况下，MJ）。我该如何做到呢？

（附注：请注意不要删除异常值的所有警告。这只是一个健壮性测试！）

- roody

---

首先，作为第一步，您需要定义基于哪个摘要统计量来识别某人是否为异常值。那个统计量是什么，它与其他值的距离应该有多远才能被视为异常值？ - Josh O'Brien

是的，这应该不是什么问题，除非我们不知道您用什么指标来定义MJ是极端的。 - stanekam

@JoshO'Brien 谢谢你指出这一点，我会在我的问题上添加澄清。最初的目标是进行95％的Winsor化，其中底部2.5％和顶部2.5％个体的观察值将被替换为截断值。（参见：http://en.wikipedia.org/wiki/Winsorising）。然而，一个只“修剪”这些观察值的答案同样有用，因为问题在于识别而不是删除。 - roody

Answer 1

我会使用dplyr：

test <- read.csv("test.csv", header=TRUE)
library(dplyr)

test <- test %.% 
  group_by(name) %.% 
  mutate(mean_points=mean(points))

cut_point_top <- quantile(test$mean_points, 0.95)
cut_point_bottom <- quantile(test$mean_points, 0.05)

test <- test %.% 
  group_by(name) %.% 
  mutate(outlier_top = (mean_points >= cut_point_top), 
         outlier_bottom = mean_points <= cut_point_bottom) %.%
  filter(!outlier_top & ! outlier_bottom)

这将过滤掉MJ的平均分在前2.5％之内，而Larry则处于最低的2.5％。如果您想使用2.5％分位数的截断点替换points变量，只需删除最后一个过滤语句，如下所示：

test <- test %.% 
  group_by(name) %.% 
  mutate(outlier_top = (mean_points >= cut_point_top), 
         outlier_bottom = mean_points <= cut_point_bottom) 

test$points <- ifelse(test$outlier_top, cut_point_top, 
                      ifelse(test$outlier_bottom, cut_point_bottom, test$points))

- user2987808

---

我喜欢你的回答，但是你会怎样用截点替换掉最高和最低的2.5%？ - roody

谢谢。我已经修改了我的答案来处理这种情况。 - user2987808

第二种解决方案可以更容易地使用 pmin 和 pmax。 - hadley

你对如何使用pmin或pmax进行Winsorizing有什么想法吗？我在考虑使用pmax(pmin(points, quantile(points, .95)), quantile(points, .05))。但是关键是将其作为新列插入数据框中。你有什么想法吗？ - rajvijay

Answer 2

这是我可能会采取的方法：

means <- ddply(df, .(name), summarize, mean=mean(points))$mean
means <- mean(means)

upperBound <- 2

outlierTest <- ddply(df, .(name), summarize, outlier=ifelse(sum(points) / means > upperBound, 
TRUE, FALSE))

keep <- outlierTest$name[!outlierTest$outlier]

df <- df[df$name %in% keep, ]

其中 df 是您的数据框。您可以选择任何您想要的 upperBound。

- stanekam

Answer 3

这可能不适用于您的数据，但我将尝试提供一般解决方案，以帮助您开始思考。我建议使用强健统计量，例如中位数和中位数绝对离差（MAD）来定义您的异常值。您可以从每个个体的异常点比例（与所有点相比）入手：

让df成为您的数据框

library(plyr)

med <- median(df$points)
md <- mad(df$points)
outlier.factor <- 2
daply(df, .(name), function(x) {sum(abs(x$points - m) > md * outlier.factor) / nrow(x)})

最后一行输出以下内容（针对您的示例数据）：

 Kobe  Larry Lebron     MJ
0.125  0.125  0.125  1.000

因此，MJ的所有点都是异常值，而其他个体中有12.5%是异常值。

现在，您可以使用阈值选择要删除的个体。例如，对于正态分布的数据，您预计约有4.55%的数据会落在中位数±2 x MAD的范围之外。

- ALiX