记住序列的最后“正确”值(用于删除异常值)

时间:2015-03-03 16:34:06

标签: r function outliers

我在函数中有一点问题。 它的目的是删除我在data.frame中检测到的异常值。当与先前的正确值存在太大差异时检测到它们(例如c(1,2,3,20,30,4,5,6):“20”和“30”是异常值)。但是我的数据比这复杂得多。

我的想法是将我的列的前两个数值视为“正确”。然后,我想测试每个下一个值:

  • 如果测试值与前一个值之间的差值<20,那么它是一个新的正确值,测试必须从这个新的正确值开始(而不是从之前正确的值开始)
  • 如果相同的差异> 20,那么它是错误的。索引必须放在错误的值旁边,测试必须仍然从这个相同的正确值继续,直到检测到新的正确值

以下是我的功能和假DF的示例:

myts <- data.frame(x=c(12,12,35,39,46,45,33,5,26,28,29,34,15,15),z=NA) 

test <- function(x){
st1 = NULL
temp <- st1[1] <- x[1]
st1 <- numeric(length(x))
for (i in 2:(length(x))){ 
    if((!is.na(x[i])) & (!is.na(x[i-1]))& (abs((x[i])-(temp)) > 20)){
st1[i] <- 1
} } 
return(st1)
}

myts[,2] <- apply(as.data.frame(myts[,1]),2,test)  
myts[,2] <- as.numeric(myts[,2]) 

它几乎完成了这项工作,但问题是没有记住最后一个正确的值。它仍然从第一个正确的值进行测试。 因此,我的示例中的行9到11未被检测到。我让你想象一下500,000行data.frame上的问题。

我该如何解决这个小问题?功能的其余部分可能没问题。

1 个答案:

答案 0 :(得分:1)

您只需更新temp以查找不是异常值的指数:

test <- function(x) {
  temp <- x[1]
  st1 <- numeric(length(x))
  for (i in 2:(length(x))){ 
    if(!is.na(x[i]) & !is.na(x[i-1]) & abs(x[i]-temp) > 20) {
      st1[i] <- 1
    } else {
      temp <- x[i]
    }
  } 
  return(st1)
}

myts[,2] <- apply(as.data.frame(myts[,1]),2,test)  
myts[,2] <- as.numeric(myts[,2])
myts
#     x z
# 1  12 0
# 2  12 0
# 3  35 1
# 4  39 1
# 5  46 1
# 6  45 1
# 7  33 1
# 8   5 0
# 9  26 1
# 10 28 1
# 11 29 1
# 12 34 1
# 13 15 0
# 14 15 0

需要注意的一点是,与向量化函数相比,R中的for循环会非常慢。但是,因为向量中的每个元素都依赖于前一个元素的复杂方式,所以使用R的内置向量化函数来高效地计算向量是很困难的。您可以将此代码几乎逐字地转换为C ++,并使用Rcpp包重新获得效率:

library(Rcpp)
test2 <- cppFunction(
"IntegerVector test2(NumericVector x) {
  const int n = x.length();
  IntegerVector st1(n, 0);
  double temp = x[0];
  for (int i=1; i < n; ++i) {
    if (!R_IsNA(x[i]) && !R_IsNA(x[i]) && fabs(x[i] - temp) > 20.0) {
      st1[i] = 1;
    } else {
      temp = x[i];
    }
  }
  return st1;
}")
all.equal(test(myts[,1]), test2(myts[,1]))
# [1] TRUE

# Benchmark on large vector with some NA values:
set.seed(144)
large.vec <- c(0, sample(c(1:50, NA), 1000000, replace=T))
all.equal(test(large.vec), test2(large.vec))
# [1] TRUE
library(microbenchmark)
microbenchmark(test(large.vec), test2(large.vec))
# Unit: milliseconds
#              expr         min          lq       mean     median         uq        max neval
#   test(large.vec) 2343.684164 2468.873079 2667.67970 2604.22954 2747.23919 3753.54901   100
#  test2(large.vec)    9.596752    9.864069   10.97127   10.23011   11.68708   16.67855   100

对于长度为100万的向量,Rcpp代码快约250倍。根据您的使用情况,此加速可能重要,也可能不重要。