Nested loop in R for detecting outliers - r

Question

I would like to remove outliers for each cluster of a dataset. The dataset contains 3 columns with different variables and a column indicating the cluster to which each point is allocated. If only one of the 3 variables is an outlier, the entire row will be removed. Outliers are identified determining the interval spanning over the mean plus/minus three standard deviations but I can also use the outlierfunction.
I am able to remove outliers without considering clusters, using:
#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,]
However, I am not able to detect outliers CONSIDERING clusters and thus determining intervals inside each cluster and not inside the entire population. I thought to nest another loop, but I am finding difficult coding it.
Any help would be much appreciated.

Answer 1

Here's a dplyr-approach:
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

Answer 2

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