Выполнить функцию по группам

Question

В настоящее время я работаю над удалением выбросов и использую функцию Клодиана Дханы на тему выбросов ( https://datascienceplus.com/identify-describe-plot-and-removing-the-outliers-from-the-dataset/).

Мой набор данных состоит из 95000 наблюдений, разделенных на 1050 групп, и мне интересно, есть ли способ проверить выбросы по группе, а не перейти к формуле 1050 раз.

Data(DF)

Group   Height 
 Gr1    2
 Gr1    5
 Gr1    5
 Gr2    75
 Gr2    72
 Gr2    44
 Gr3    4
 Gr3    25
 Gr3    42
 …      …
 Gr1050 43

Поэтому я хотел бы проверить формулу выбросов по группе, но иметь ее в одном DF.

Я не очень эксперт, поэтому я сделал свое исследование и обнаружил, что by(), ddply(), а также tapply() функции могут быть использованы в этом случае. Я думаю также, что петли могут быть полезны.

Answer 1

Посмотрите на следующий пример. Я генерирую некоторые выборочные данные путем выборки из распределения Коши, чтобы получить достаточно широкий хвост, который дает нам выбросы согласно критерию выбросов IQR Тьюки.

# Sample data
set.seed(2017);
df <- cbind.data.frame(
    Group = rep(c("Gr1", "Gr2", "Gr3"), each = 20),
    Height = unlist(lapply(c(10, 20, 30), function(x) rcauchy(20, x))));
head(df);
#  Group    Height
#1   Gr1  9.757403
#2   Gr1  1.476820
#3   Gr1 20.300998
#4   Gr1 11.277766
#5   Gr1  9.118874
#6   Gr1  9.133723

# Split based on Group
ll <- split(df, df$Group);

# Flag entries based on 1.5 IQR
ll <- lapply(ll, function(x) {
    x$outlier <- ifelse(
        x$Height < quantile(x$Height, 0.25) - 1.5 * IQR(x$Height) |
        x$Height > quantile(x$Height, 0.75) + 1.5 * IQR(x$Height),
        TRUE,
        FALSE);
    return(x);
})

# Optionally replace outiers with NA
ll <- lapply(ll, function(x) {
    x$Height[x$outlier] <- NA;
    return(x);
});

# Optionally combine into single dataframe
df.filtered <- do.call(rbind.data.frame, ll);
head(df.filtered);
#      Group    Height outlier
#Gr1.1   Gr1  9.757403   FALSE
#Gr1.2   Gr1        NA    TRUE
#Gr1.3   Gr1        NA    TRUE
#Gr1.4   Gr1 11.277766   FALSE
#Gr1.5   Gr1  9.118874   FALSE
#Gr1.6   Gr1  9.133723   FALSE

Визуализируйте распределения до и после анализа обнаружения выбросов.

# Show a comparative plot
library(ggplot2);
df.all <- rbind.data.frame(
    cbind.data.frame(df, src = "pre-outlier analysis"),
    cbind.data.frame(df.filtered[, -3], src = "post-outlier analysis"));
gg <- ggplot(df.all, aes(x = Group, y = Height));
gg <- gg + geom_boxplot() + facet_wrap(~ src, scale = "free_y");

Answer 2

Вот мой подход, который использует пакет tidyverse dplyr:

        #--create dataframe

    Group = c("Gr1", "Gr1", "Gr1","Gr1",
              "Gr1", "Gr1", "Gr1","Gr1", 
              "Gr2", "Gr2", "Gr2","Gr2",
              "Gr2", "Gr2", "Gr2","Gr2",
              "Gr3", "Gr3", "Gr3","Gr3",
              "Gr3", "Gr3", "Gr3","Gr3")

    Height = c(1,21,22,23,
              241,24,29,30,
               2,50,49,50,
               51,50,4900,50,
               10,10,3000,10,
               10,10,2,10) 

    grp_df = data.frame(Group, Height)

    library(dplyr) #--for group_by and summarise functions

    library(outliers) #--for outlier function

    new_df <- grp_df %>%
      group_by(Group) %>%
      summarise(lower_outlier = outlier(Height, opposite=TRUE),
                higher_outlier = outlier(Height, opposite=FALSE))