R中的嵌套循环用于检测异常值答案

【问题标题】：Nested loop in R for detecting outliersR中的嵌套循环用于检测异常值
【发布时间】：2018-04-18 10:17:50
【问题描述】：

我想删除数据集的每个集群的异常值。该数据集包含 3 列具有不同变量的列，以及指示每个点分配到的集群的列。如果 3 个变量中只有一个是异常值，则将删除整行。识别出异常值以确定跨越平均值加/减三个标准差的区间，但我也可以使用outlierfunction。

我能够在不考虑集群的情况下删除异常值，使用：

   #data: each row has 3 different variables and the allocating cluster (k)

dat <- cbind.data.frame(v1=c(sample(5:10, 100,replace=T),sample(1:5,5)),
                        v2=c(sample(20:25, 100,replace=T),sample(5:10,5)),
                        v3=c(sample(30:35, 100,replace=T),sample(10:20,5)),
                        k=c(rep(1:5,21)))

###  find outliers without considering clusters
#(obviously only the last 5 samples in this example)

rmv<-c()
for(i in 1:3){
  variable<-dat[,i]
  rmv.tm<-which(variable >= (mean(variable)+sd(variable)*3) 
                | variable <= (mean(variable)-sd(variable)*3))
  rmv<-c(rmv,rmv.tm)
}
rmv<-unique(rmv)
rmv

###  remove outliers 
dat_clean <- dat[-rmv,]

但是，考虑到集群，我无法检测异常值，因此无法确定每个集群内部的区间，而不是整个人口中的区间。我想嵌套另一个循环，但我发现很难编码。任何帮助将不胜感激。

【问题讨论】：

我不明白你所说的在每个集群内而不是在整个人口内是什么意思，你想只删除每列的异常值吗？如果是这样，列的长度可能会变得不同，并且数据集将不再是 data.frame 而是 list。

标签： r loops outliers

【解决方案1】：

这是一个 dplyr 方法：

library(dplyr)
dat %>% 
  group_by(k) %>% 
  filter_all(all_vars((abs(mean(.) - .) < 3*sd(.))))

# # A tibble: 100 x 4
# # Groups:   k [5]
# v1    v2    v3     k
# <int> <int> <int> <int>
#   1     9    20    30     1
# 2     5    24    35     2
# 3     8    20    30     3
# 4     8    23    32     4
# 5     6    23    35     5
# 6     9    24    32     1
# 7     9    22    33     2
# 8     9    23    31     3
# 9     7    21    35     4
# 10     9    23    32     5
# # ... with 90 more rows

【讨论】：

谢谢，您的方法非常优雅。但是，我的真实数据还包含其他列，我不想将它们包含在过滤过程中（例如纬度和经度），但我想保留它们以绘制数据。

【解决方案2】：

基础R：

dat <- cbind.data.frame(v1=c(sample(5:10, 100,replace=T),sample(1:5,5)),
                        v2=c(sample(20:25, 100,replace=T),sample(5:10,5)),
                        v3=c(sample(30:35, 100,replace=T),sample(10:20,5)),
                        k=c(rep(1:5,21)))

get_remove <- function(x, index, a = 3) {
  lower_limit <- tapply(x, index, function(x) mean(x) - a * sd(x))
  upper_limit <- tapply(x, index, function(x) mean(x) + a * sd(x))
  vals <- split(x, index)
  res <- sapply(seq_along(vals), function(i) 
    ((vals[[i]] < lower_limit[i]) | (vals[[i]] > upper_limit[i])))
}
mask <- apply(do.call(cbind, 
                      lapply(dat[ , c("v1", "v2", "v3")], 
                             get_remove, dat$k)),
              MARGIN = 1, any)
dat[!mask, ] 
print("removed:")
dat[mask, ]

【讨论】：