如何在纵向数据集中进行winsorize(或删除单变量异常值)

时间:2014-02-21 23:14:15

标签: r

我正在试图弄清楚如何在纵向数据集中对个体分组的观察结果进行评估。

我从这个excellent answer开始,关于如何从变量的平均值中删除数据> 2个标准偏差。作者还有助于展示如何在类别中执行此操作。

我的用例略有不同:我有一个纵向数据集,我想删除随着时间的推移,系统地显示为异常值的个体。我想要完全排除那些个体(修剪数据)或用切割值替换底部和顶部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

如果我想删除个人(points)中name中的极端观察,我的代码将是:

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

但我真正想做的是排除极端的个人(在这种情况下,MJ)。我该怎么做呢?

(P.S。 - 在此插入关于如何不应删除异常值的所有警告。这只是一个稳健性测试!)

3 个答案:

答案 0 :(得分:2)

我只想使用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%,拉里在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))

答案 1 :(得分:0)

以下是我可以采取的措施:

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是您的data.frame。您可以选择所需的upperBound

答案 2 :(得分:0)

这可能不适合您的数据,但我会尝试一般的解决方案让您开始思考。我建议使用强大的统计数据,如中位数和中位绝对偏差(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。