Winsorize数据帧

时间:2011-06-03 16:19:14

标签: r transformation

我想在像这样的数据框中执行winsorization:

event_date  beta_before     beta_after
2000-05-05  1.2911707054    1.3215648954
1999-03-30  0.5089734305    0.4269575657
2000-05-05  0.5414700258    0.5326762272
2000-02-09  1.5491034852    1.2839988507
1999-03-30  1.9380674599    1.6169735009
1999-03-30  1.3109909155    1.4468207148
2000-05-05  1.2576420753    1.3659492507
1999-03-30  1.4393018341    0.7417777965
2000-05-05  0.2624037804    0.3860641307
2000-05-05  0.5532216441    0.2618245169
2000-02-08  2.6642931822    2.3815576738
2000-02-09  2.3007578964    2.2626960407
2001-08-14  3.2681270302    2.1611010935
2000-02-08  2.2509121123    2.9481325199
2000-09-20  0.6624503316    0.947935581
2006-09-26  0.6431111805    0.8745333151

通过winsorization我的意思是找到beta_before的最大值和最小值。该值应替换为同一列中的第二个最高值或第二个最低值,而不会丢失观察中的其余细节。例如。在这种情况下,在beta_before之前,最大值为3.2681270302,应替换为3.2681270302。对于min,然后是beta_after变量,将遵循相同的过程。因此,每列只有2个值会发生变化,最高值和最小值,其余值将保持不变。

有什么建议吗?我在plyr尝试了不同的方法,但我最终取代了整个观察,我不想这样做。我想创建2个新变量,例如beta_before_winsorized和beta _after_winsorized

5 个答案:

答案 0 :(得分:7)

我认为winsorizing通常从有序列表的底部找到值x%(通常为10%,15%或20%),并用该值替换它下面的所有值。与顶部相同。在这里,您只需选择顶部和底部值,但是winsorizing通常涉及指定顶部和底部的值的百分比来替换。

答案 1 :(得分:5)

这是一个执行你描述的winsorzation的函数:

winsorize <- function(x) {
    Min <- which.min(x)
    Max <- which.max(x)
    ord <- order(x)
    x[Min] <- x[ord][2]
    x[Max] <- x[ord][length(x)-1]
    x
}

如果您的数据位于数据框dat中,那么我们可以使用您的程序通过以下方式对数据进行风口化:

dat2 <- dat
dat2[, -1] <- sapply(dat[,-1], winsorize)

导致:

R> dat2
   event_date beta_before beta_after
1  2000-05-05   1.2911707  1.3215649
2  1999-03-30   0.5089734  0.4269576
3  2000-05-05   0.5414700  0.5326762
4  2000-02-09   1.5491035  1.2839989
5  1999-03-30   1.9380675  1.6169735
6  1999-03-30   1.3109909  1.4468207
7  2000-05-05   1.2576421  1.3659493
8  1999-03-30   1.4393018  0.7417778
9  2000-05-05   0.5089734  0.3860641
10 2000-05-05   0.5532216  0.3860641
11 2000-02-08   2.6642932  2.3815577
12 2000-02-09   2.3007579  2.2626960
13 2001-08-14   2.6642932  2.1611011
14 2000-02-08   2.2509121  2.3815577
15 2000-09-20   0.6624503  0.9479356
16 2006-09-26   0.6431112  0.8745333

我不确定你在哪里得到的价值应该替换beta_before中的最大值,因为在提供的数据片段中,第二个最高值是2.6642932,这是我的功能已经用于用./替换最大值。

请注意,只有在每列中分别有一个最小值和最大值时,该功能才有效,因为which.min()which.max()的记录方式有效。如果您有多个条目采用相同的最大值或最小值,那么我们需要不同的东西:

winsorize2 <- function(x) {
    Min <- which(x == min(x))
    Max <- which(x == max(x))
    ord <- order(x)
    x[Min] <- x[ord][length(Min)+1]
    x[Max] <- x[ord][length(x)-length(Max)]
    x
}

应该这样做(后者没有经过测试)。

答案 2 :(得分:2)

严格来说,&#34; winsorization&#34;是用可接受的百分位替换最极端数据点的行为(如其他一些答案中所述)。执行此操作的一个相当标准的R函数是来自winsor包的psych。尝试:

dat$beta_before = psych::winsor(dat$beta_before, trim = 0.0625)
dat$beta_after  = psych::winsor(dat$beta_after , trim = 0.0625)

我选择trim =为0.0625(第6.25百分位数和第93.75百分位数),因为您只有16个数据点并且您希望&#34;遏制&#34;顶部和底部:1/16 = 0.0625

请注意,这可能会使极端数据等于您的数据集中可能存在或可能不存在的百分位数:数据的理论第n个百分点。

答案 3 :(得分:1)

\002\372i\002\351\036\022}m4\020\366\253\302q\247\232\342@)\007\234\252\015\265\201\227W\343\301\301\305\244包对此非常有用。从自述文件中复制相关代码段:

statar

https://github.com/matthieugomez/statar

答案 4 :(得分:0)

从我之前的观点开始跟进实际用修剪位置的值替换待修剪的值:

winsorized.sample<-function (x, trim = 0, na.rm = FALSE, ...) 
{
  if (!is.numeric(x) && !is.complex(x) && !is.logical(x)) {
    warning("argument is not numeric or logical: returning NA")
    return(NA_real_)
  }
  if (na.rm) 
    x <- x[!is.na(x)]
  if (!is.numeric(trim) || length(trim) != 1L) 
    stop("'trim' must be numeric of length one")
  n <- length(x)
  if (trim > 0 && n) {
    if (is.complex(x)) 
      stop("trimmed sample is not defined for complex data")
    if (any(is.na(x))) 
      return(NA_real_)
    if (trim >= 0.5) { 
      warning("trim >= 0.5 is odd...trying it anyway")
    }
    lo <- floor(n * trim) + 1
    hi <- n + 1 - lo
    #this line would work for just trimming 
    #  x <- sort.int(x, partial = unique(c(lo, hi)))[lo:hi]
    #instead, we're going to replace what would be trimmed
    #with value at trim position using the next 7 lines
    idx<-seq(1,n)
    myframe<-data.frame(idx,x)
    myframe<-myframe[ order(x,idx),]
    myframe$x[1:lo]<-x[lo]
    myframe$x[hi:n]<-x[hi]
    myframe<-myframe[ order(idx,x),]
    x<-myframe$x
  }
  x
}
#test it
mydist<-c(1,20,1,5,2,40,5,2,6,1,5)
mydist2<-winsorized.sample(mydist, trim=.2)
mydist
mydist2
descStat(mydist)
descStat(mydist2)