Как я могу удалить выбросы (числа 3 стандартных отклонения от среднего значения) в каждом столбце фрейма данных

Question

У меня есть набор данных с ID участника и 17 различных показателей для каждого участника.

Мне нужно удалить выбросы - числа, которые на 3 стандартных отклонения от среднего значения с обеих сторон. Это должно происходить для каждого столбца в отдельности.

До сих пор, используя приведенный ниже код, мне удалось добавить NA в столбец выбросов для каждого столбца, но это мне мало помогает, так как мне нужно иметь возможность добавить NA в столбец с остальными из чисел или просто удалить выпадающий номер

В идеале я хочу получить файл, который выглядит следующим образом:

ID measure1 measure2 ....measure17
1  10897                  64436
2  184658    1739473
3            75758
4  746483    4327349      3612638
5  6444      36363        46447

Код, который я использовал до сих пор:

phenotypes <- colnames(imaging_data_kept[,2:ncol(imaging_data_kept)])

 for (i in phenotypes){
  Min <- mean(imaging_data_kept[[i]]) - (3*sd(imaging_data_kept[[i]]))
  Max <- mean(imaging_data_kept[[i]]) + (3*sd(imaging_data_kept[[i]]))  
  imaging_data_kept[[paste0(i,"_outliers")]] <- imaging_data_kept[[i]] < 
  Min | imaging_data_kept[[i]] > Max
 }

Пример данных:

SubjID M1 M2 M3 M4 M5 
1000496 14898.1 9172 4902 5921.9 1428.2 
1001121 5420.7 2855.5 4144 732.1 4960.2 
1001468 7478.8 3401.4 5143.6 1106.5 4355.5 
1004960 11316.4 8460.1 3953.4 5682.2 1717 
1005040 15052.7 6362.8 3145.2 4593 1214.5  
1005677 17883.3 6705.1 3943.5 4993.1 1373.1 
1006128 6260.8 4274.6 5865 2002.3 4727.1 
1006694 9292.8 3389.9 5141.6 1246.6 4135.7 
1009080 10391.3 8372.1 2921.8 4008.6 860.4 
1010482 9381.5 2743.4 4526.5 1160.4 3655.1 
1011508 15598.5 7365.7 4279.4 6274.1 1757.1 

Answer 1

Я рекомендую использовать функцию boxplot() -, которая вычисляет выбросы. Вы можете получить к ним доступ в вашем boxplot -объекте через boxplot$out или получить квантили через boxplot$stats. Что я и делаю дальше.

Но имейте в виду, что блокпост не рассчитывает выбросы с точки зрения 3 стандартных отклонений, а с Q1 - 1.5*IQR и Q3 + 1.5*IQR соответственно.

library(dplyr) # for the pipe operators

#creating sample data 
df <- data.frame("var1" = c(-20.32, -15.29, rnorm(5,1,1), 11.23, 20.45),
                 "var2" = c(-12.43, -3.12, rnorm(5, 1,1), 10.75, 18.11))

#looks like that
> df
         var1        var2
1 -20.3200000 -12.4300000
2 -15.2900000  -3.1200000
3   0.9950276   1.2645415
4   1.7022687   0.8313770
5   1.8828154  -0.7459769
6   1.2299670   0.5053378
7   0.2749259   2.0239793
8  11.2300000  10.7500000
9  20.4500000  18.1100000

#remove outliers
nooutliers <- lapply(df, function(x) boxplot(df, plot = FALSE)) %>%
                lapply(`[`, "stats") %>% 
                  lapply(range) %>%
                    mapply(function (x,y) !between(x, y[1], y[2]), df, .) %>%
                      as.data.frame %>%
                        mapply(function(x,y) {y[x] <- NA; y},  
                               y = df, x = .)

#looks like this now
> nooutliers
           var1       var2
 [1,]        NA         NA
 [2,]        NA -3.1200000
 [3,] 0.9950276  1.2645415
 [4,] 1.7022687  0.8313770
 [5,] 1.8828154 -0.7459769
 [6,] 1.2299670  0.5053378
 [7,] 0.2749259  2.0239793
 [8,]        NA         NA
 [9,]        NA         NA

Этот код вычисляет диапазон в пределах усов для каждого столбца, присваивает NA всем значениям за пределами этого диапазона и возвращает матрицу.

Полагаю, это то, что вы ищете.

ОБНОВЛЕНИЕ: с 3 стандартными отклонениями:

df <- data.frame("var1" = c(-210.32, rnorm(20,1,1), 234.45),
                 "var2" = c(-230.43, rnorm(20, 1,1), 213.11))


phenotypes <- colnames(df)

for (i in phenotypes){
  Min <- mean(df[[i]]) - (3*sd(df[[i]]))
  Max <- mean(df[[i]]) + (3*sd(df[[i]]))  
  df[[i]][df[[i]] < Min | df[[i]] > Max] <- NA}

Это принимает ваше определение выброса.

Answer 2

Это заменит значения более 3 SD из среднего значения на NA:

dd[,-1] <- lapply(dd[,-1],
      function(x) replace(x,abs(scale(x))>3,NA))

(функция scale() вычисляет (x-mean(x))/sd(x); abs(scale(x))>3 должна быть достаточно понятной; replace()заменяет указанный набор индексов указанным значением.)

Затем можно использовать na.omit(dd), если вы хотите удалить все строки, содержащие выбросы в любом столбце.

Пример данных, которые вы далиу нас, кажется, нет никаких выбросов (согласно вашему определению) - я добавил некоторые.

---

dd <- read.table(header=TRUE,
                 colClasses=c("character",rep("numeric",5)),
                 text="
SubjID M1 M2 M3 M4 M5 
1000496 14898.1 9172 4902 5921.9 1428.2 
1001121 5420.7 2855.5 4144 732.1 100000
1001468 7478.8 3401.4 5143.6 1106.5 4355.5 
1004960 11316.4 8460.1 3953.4 5682.2 1717 
1005040 15052.7 6362.8 3145.2 4593 1214.5  
1005677 17883.3 6705.1 100000 4993.1 1373.1 
1006128 6260.8 4274.6 5865 2002.3 4727.1 
1006694 9292.8 3389.9 5141.6 1246.6 4135.7 
1009080 10391.3 8372.1 2921.8 4008.6 860.4 
1010482 9381.5 2743.4 4526.5 1000000 3655.1 
1011508 15598.5 7365.7 4279.4 6274.1 1757.1
")