如何根据R中的分类变量删除数据框中的异常值

how to remove outliers in a dataframe based on a categorical variable in R

我有如下交易数据的数据集:

 prodid  priceperitem       date
   62420         18.9  2014-10-09
   62420         29.9  2014-09-20
   62420         18.9  2014-10-11
   62420         27.9  2014-07-04
   62420         18.9  2014-08-25
   62420         18.9  2014-11-01

我想删除每种产品的价格异常值。

我尝试了以下代码,它已将每个产品的异常值价格替换为 NA。但这是一个单独的列表,按 prodid 分组,我希望数据变量保留在数据框中而不是有一个新列表。

remove.outliers <- tapply(priceperitem, prodid, function(x) {
     qnt <- quantile(x, probs=c(.25, .75))
      H <- 1.5 * IQR(x)
      y <- x
      y[x < (qnt[1] - H)] <- NA
      y[x > (qnt[2] + H)] <- NA
      y
})

这段代码会给我一些输出,如下所示:

$205780229

 [1]   NA 10.9 10.5 10.9 10.9   NA ....

这是一个新数组,但我想要的是这样的:

     prodid       priceperitem    date
    205780229    NA              2014-10-03
    205780229    10.9            2014-10-20
    205780229    10.5            2014-10-30
    205780229    10.9            2014-5-23
    205780229    10.9            2014-11-20
....

您可以使用 by 函数将数据帧分组为更小的子集,然后对各个子组执行函数调用。在这些函数调用期间,您可以轻松地从每个子集中删除异常值并 return 结果。接下来,您可以通过将子结果合并在一起来获得结果数据帧。

我将使用以下数据框来举例说明:

prodid <- c(rep(62420,5),rep(62421,5))
pricePerItem <- c(18,18.1,23,17.9,18.0,51.7,22,51,52,52.2)
dates <- rep(Sys.time(),10)
products <- data.frame(prodid,pricePerItem,dates)
products
   prodid pricePerItem               dates
1   62420         18.0 2015-07-06 01:51:31
2   62420         18.1 2015-07-06 01:51:31
3   62420         23.0 2015-07-06 01:51:31
4   62420         17.9 2015-07-06 01:51:31
5   62420         18.0 2015-07-06 01:51:31
6   62421         51.7 2015-07-06 01:51:31
7   62421         22.0 2015-07-06 01:51:31
8   62421         51.0 2015-07-06 01:51:31
9   62421         52.0 2015-07-06 01:51:31
10  62421         52.2 2015-07-06 01:51:31

我们按 prodid 对数据帧进行分组并过滤掉相关的异常值。我们通过合并结果来完成:

   result <- by(products,products$prodid,function(product) {
      qnt <- quantile(product$pricePerItem, probs=c(.25, .75))
      H <- 1.5 * IQR(product$pricePerItem)
      outlierCheck <- (product$pricePerItem) > qnt[1]-H & (product$pricePerItem<qnt[2]+H)
      noOutliers <- product[outlierCheck,]
    })

    filteredFrame <- do.call("rbind",result)
    filteredFrame
             prodid pricePerItem               dates
    62420.1   62420         18.0 2015-07-06 01:51:31
    62420.2   62420         18.1 2015-07-06 01:51:31
    62420.4   62420         17.9 2015-07-06 01:51:31
    62420.5   62420         18.0 2015-07-06 01:51:31
    62421.6   62421         51.7 2015-07-06 01:51:31
    62421.8   62421         51.0 2015-07-06 01:51:31
    62421.9   62421         52.0 2015-07-06 01:51:31
    62421.10  62421         52.2 2015-07-06 01:51:31

小幅编辑 我注意到您想用 NA 值替换异常值而不是完全删除它们。您显然可以用类似的方式完成此行为。例如:

result <- by(products,products$prodid,function(product) {
  qnt <- quantile(product$pricePerItem, probs=c(.25, .75))
  H <- 1.5 * IQR(product$pricePerItem)

  outliers <- (product$pricePerItem) < qnt[1]-H | (product$pricePerItem > qnt[2]+H)
  product[outliers,2] <- NA
  product
})

filteredFrame <- do.call("rbind",result)
filteredFrame
         prodid pricePerItem               dates
62420.1   62420         18.0 2015-07-06 02:14:06
62420.2   62420         18.1 2015-07-06 02:14:06
62420.3   62420           NA 2015-07-06 02:14:06
62420.4   62420         17.9 2015-07-06 02:14:06
62420.5   62420         18.0 2015-07-06 02:14:06
62421.6   62421         51.7 2015-07-06 02:14:06
62421.7   62421           NA 2015-07-06 02:14:06
62421.8   62421         51.0 2015-07-06 02:14:06
62421.9   62421         52.0 2015-07-06 02:14:06
62421.10  62421         52.2 2015-07-06 02:14:06

最直接的方法是使用基于检测异常值的函数的逻辑索引替换要 NAed 的变量的索引。在下面的代码中,我用两个离群值(一低一高)扩充了您的原始示例数据集。

myData <- read.table(text = "prodid  priceperitem       date
   62420         18.9  2014-10-09
   62420         29.9  2014-09-20
   62420         18.9  2014-10-11
   62420         27.9  2014-07-04
   62420         18.9  2014-08-25
   62420         18.9  2014-11-01
   62420         3     2014-11-01
   62420         50    2014-11-01", header=TRUE)

# function to return a logical for outlier status, from a numeric vector
identifyOutliers <-  function(x) {
    qnt <- quantile(x, probs=c(.25, .75))
    H <- 1.5 * IQR(x)
    outlier <- (x < (qnt[1] - H)) | (x > qnt[2] + H)
    outlier
}

# so:
which(identifyOutliers(myData$priceperitem))
## [1] 7 8

# copy the data to a new object
myDataNew <- myData
# replace the priceperitem with NA using the index
myDataNew$priceperitem[identifyOutliers(myData$priceperitem)] <- NA
myDataNew
##   prodid priceperitem       date
## 1  62420         18.9 2014-10-09
## 2  62420         29.9 2014-09-20
## 3  62420         18.9 2014-10-11
## 4  62420         27.9 2014-07-04
## 5  62420         18.9 2014-08-25
## 6  62420         18.9 2014-11-01
## 7  62420           NA 2014-11-01
## 8  62420           NA 2014-11-01