Просматривайте переменные, используя mutate_at / ifelse, создавая новые переменные

Question

У меня есть этот код, проверяющий на выбросы (псевдо-выбросы в этих данных - только 1,25sd плюс среднее значение в этом примере) с использованием функции, но для масштабирования ее для многих переменных без указания каждой ifelse будет ли способ?

library(tidyverse)

meanplusd <- function (var){mean(var, na.rm  = TRUE)+(1.25*(sd(var, na.rm  = TRUE)))}

mtcars%>% 
  mutate_at(vars(drat:qsec), .funs = list(meanplus = ~ meanplusd(.))) %>% 
  mutate(outlier_drat = ifelse(drat   > drat_meanplus,1,0),
         outlier_wt   = ifelse(wt     > wt_meanplus,1,0),
         outlier_qsec = ifelse(qsec   > qsec_meanplus ,1,0)) %>%
  filter_at(vars(outlier_drat:outlier_qsec), any_vars (.== 1)) %>% 
  select(-c(drat_meanplus:qsec_meanplus))


mpg cyl  disp  hp drat    wt  qsec vs am gear carb outlier_drat outlier_wt outlier_qsec
1 18.1   6 225.0 105 2.76 3.460 20.22  1  0    3    1            0          0            1
2 22.8   4 140.8  95 3.92 3.150 22.90  1  0    4    2            0          0            1
3 10.4   8 472.0 205 2.93 5.250 17.98  0  0    3    4            0          1            0
4 10.4   8 460.0 215 3.00 5.424 17.82  0  0    3    4            0          1            0
5 14.7   8 440.0 230 3.23 5.345 17.42  0  0    3    4            0          1            0
6 30.4   4  75.7  52 4.93 1.615 18.52  1  1    4    2            1          0            0
7 26.0   4 120.3  91 4.43 2.140 16.70  0  1    5    2            1          0            0
> 

Открыто и для неинтервальных способов в учебных целях.

Answer 1

Вы можете определить выбросы все в одной функции:

is_outlier <- function(var) {
  as.numeric(var > na.omit(var) %>% {mean(.) + 1.25*sd(.)})
}

mtcars %>% 
  mutate_at(vars(drat:qsec), .funs = list(outlier = ~ is_outlier(.))) %>%
  filter_at(vars(drat_outlier:qsec_outlier), any_vars (.== 1))

   mpg cyl  disp  hp drat    wt  qsec vs am gear carb drat_outlier wt_outlier qsec_outlier
1 18.1   6 225.0 105 2.76 3.460 20.22  1  0    3    1            0          0            1
2 22.8   4 140.8  95 3.92 3.150 22.90  1  0    4    2            0          0            1
3 10.4   8 472.0 205 2.93 5.250 17.98  0  0    3    4            0          1            0
4 10.4   8 460.0 215 3.00 5.424 17.82  0  0    3    4            0          1            0
5 14.7   8 440.0 230 3.23 5.345 17.42  0  0    3    4            0          1            0
6 30.4   4  75.7  52 4.93 1.615 18.52  1  1    4    2            1          0            0
7 26.0   4 120.3  91 4.43 2.140 16.70  0  1    5    2            1          0            0

Answer 2

Если вы хотите фильтровать только строки, вы можете напрямую использовать filter_at и применить meanplusd функцию

library(dplyr)

mtcars %>% filter_at(vars(drat:qsec), any_vars(. > meanplusd(.)))

#   mpg cyl  disp  hp drat    wt  qsec vs am gear carb
#1 18.1   6 225.0 105 2.76 3.460 20.22  1  0    3    1
#2 22.8   4 140.8  95 3.92 3.150 22.90  1  0    4    2
#3 10.4   8 472.0 205 2.93 5.250 17.98  0  0    3    4
#4 10.4   8 460.0 215 3.00 5.424 17.82  0  0    3    4
#5 14.7   8 440.0 230 3.23 5.345 17.42  0  0    3    4
#6 30.4   4  75.7  52 4.93 1.615 18.52  1  1    4    2
#7 26.0   4 120.3  91 4.43 2.140 16.70  0  1    5    2

Или в базе R мы можем использовать sapply для выбранных столбцов и использовать rowSums

mtcars[rowSums(sapply(mtcars[5:7], function(x) x > meanplusd(x))) > 0, ]

---

Однако, если вам нужны новые столбцы со значением выброса, вы можете сделать что-то вроде

df <- mtcars
cols <- names(df)[5:7]
df[paste0(cols, "_outlier")] <- lapply(mtcars[cols],function(x) +(x > meanplusd(x)))
df[rowSums(df[paste0(cols, "_outlier")]) > 0, ]