Filtrer plusieurs colonnes de table de données R pour éliminer les valeurs aberrantes

Question

Je souhaite éliminer les valeurs aberrantes supérieures ou inférieures à 2 écarts-types, pour de nombreuses variables ayant des noms similaires (trop nombreuses pour être spécifiées individuellement dans le code).

library(data.table) 

irisdt <- data.table(iris) 
myCols <- grep("Sepal", colnames(irisdt), value=TRUE) 

# This works if I specify one column, 
# but I have too many columns to specify, so need to use grep approach. 
irisdt[, Sepal.Length.Outlier := (scale(Sepal.Length) < -2 | scale(Sepal.Length) > 2)] 

# This does not work 
irisdt[, (myCols) := lapply(myCols, function(x) {(scale(x) < -2 | scale(x) > 2)})] 

# This partially works, but changes in place 
irisdt[, (myCols) := lapply(myCols, function(x) {(scale(irisdt[[x]]) < -2 | scale(irisdt[[x]]) > 2)})] 
# How do I make new variables, for example "Sepal.Length.Outlier"? 

myOutlierCols <- grep(".Outlier", colnames(irisdt), value=TRUE) 

# How do I select rows matching multiple columns (&)? 
irisdt[myOutlierCols=="FALSE"] # does not work 
irisdt[, hasOutlier := lapply(myCols, myCols==TRUE)] # does not work 
irisdt[hasOutlier=="FALSE"] # relies on line above, which doesn't work 

peut-être une fonction peut prendre une colonne data.table et dépouiller des valeurs supérieures ou inférieures à un seuil de score z. Cela pourrait être utilisé avec lapply.

# This does not work 
removeOutliers <- function(myColumn, cutoff = 3) { 
    lapply(myColumn, function (x) { 
    if (scale(myColumn[[x]]) < -cutoff | scale(myColumn[[x]]) > cutoff) { 
     x <- NA #specify individual value instead of column? 
    } 
    }) 
} 
removeOutliers(irisdt[,Sepal.Length]) # for testing 
trimmedIrisdt <- irisdt[,lapply(.SD, removeOutliers(.SD)), .SDcols = myCols] # could do by = grouping variable 

# Once outliers are made NA, this would work: 
trimmedIrisdt <- complete.cases(trimmedIrisdt) 

Answer 1

Je suppose que cela atteint l'objectif:

irisdt[, keep := 
    as.logical(do.call(pmin, lapply(.SD, function(x) abs(scale(x)) <= 2))) 
, .SDcols = myCols] 

res = irisdt[(keep), !"keep"] 

    Sepal.Length Sepal.Width Petal.Length Petal.Width Species 
    1:   5.1   3.5   1.4   0.2 setosa 
    2:   4.9   3.0   1.4   0.2 setosa 
    3:   4.7   3.2   1.3   0.2 setosa 
    4:   4.6   3.1   1.5   0.2 setosa 
    5:   5.0   3.6   1.4   0.2 setosa 
---                
135:   6.7   3.0   5.2   2.3 virginica 
136:   6.3   2.5   5.0   1.9 virginica 
137:   6.5   3.0   5.2   2.0 virginica 
138:   6.2   3.4   5.4   2.3 virginica 
139:   5.9   3.0   5.1   1.8 virginica 

Cela devrait également fonctionner très bien s'il y a des variables de regroupement. Je ne connais pas sa solidité statistique.

---

Comment ça marche:

1. Testez chaque cellule pour abs(scale(x)) <= 2.
2. Si le résultat minimal sur les colonnes est TRUE, conservez la ligne.

Pour voir comment cela fonctionne cellule par cellule ...

library(data.table) 

mynewCols = paste0(myCols,"_outly") 
irisdt[, (mynewCols) := 
    lapply(.SD, function(x) replace(x, abs(scale(x)) <= 2, NA)) 
, .SDcols = myCols] 

Puis parcourir comme View(irisdt[rowSums(!is.na(irisdt[, ..mynewCols])) > 0]).