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

Nested loop in R for detecting outliers

我想删除数据集每个集群的离群值。数据集包含 3 个具有不同变量的列和一个指示每个点分配到的集群的列。如果 3 个变量中只有一个是异常值,则整行将被删除。确定异常值确定跨越平均值 plus/minus 三个标准差的区间,但我也可以使用 outlier 函数。

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

   #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,]

但是,考虑到聚类,我无法检测异常值,因此无法确定每个聚类内的间隔,而不是整个群体内的间隔。我想嵌套另一个循环,但我发现很难对其进行编码。 任何帮助将不胜感激。

这是一个 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

基数 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, ]