如何让这个 R 代码更优雅？

Question

我正在解决 R 练习，但我认为我可以更优雅或更简单地编写此代码。我正在使用来自 ggplot2 的钻石数据集。我必须从数值变量中删除异常值，对我来说，异常值是任何数值变量高于或低于中位数 +/- 3 倍 MAD（中位数绝对偏差）的行。我的实际代码非常手动：

library(dplyr)

filter(numeric.vars, 
    carat > median(carat) - 3 * mad(carat),
    carat < median(carat) + 3 * mad(carat),
    depth > median(depth) - 3 * mad(depth),
    depth < median(depth) + 3 * mad(depth),
    table > median(table) - 3 * mad(table),
    table < median(table) + 3 * mad(table),
    price > median(price) -3 * mad(price),
    price < median(price) +3 * mad(price),
    x > median(x) - 3 * mad(x),
    x < median(x) + 3 * mad(x),
    y > median(y) - 3 * mad(y),
    y < median(y) + 3 * mad(y),
    z > median(z) - 3 * mad(z),
    z < median(z) + 3 * mad(z)) -> clean

我应该像apply(numeric.vars,1, myCustomFunction) 这样对每一行应用条件吗？虽然按行，但我不知道数据属于哪一列。

Answer 1

我们创建numeric列的逻辑索引（'numeric.vars'），循环遍历数据集的这些列，应用median和mad的条件，并检查所有变量是否符合每行的条件（使用Reduce 和&）创建一个逻辑vector（'i1'），我们用它来子集'diamonds'数据集的行。

numeric.vars <- sapply(diamonds, is.numeric)
i1 <-  Reduce(`&`, lapply(diamonds[numeric.vars], function(v) 
        (v > median(v) - 3* mad(v)) & (v < median(v) + 3 * mad(v))) )
SubDiam <- diamonds[i1,]
nrow(SubDiam)
#[1] 44736

基于 OP 的代码

nrow(clean)
#[1] 44736

Answer 2

assertr 包包含一个 within_n_mads 函数，这很有帮助。但是，要在其通常的框架之外使用它，需要做一些工作。 within_n_mads(3) 返回一个函数，该函数将在传递向量时创建一个新函数。 那个函数测试单个值。

因此，加上一点 purrr（如果你愿意，可以与 dplyr 混合），

library(purrr)
library(assertr)

diamonds %>% keep(is.numeric) %>%    # Subset to numeric columns
    # Change all values to logical of whether it is within 3 mads
    dmap(~within_n_mads(3)(.x)(.x)) %>% 
    # Filter diamonds to rows where all columns of . are TRUE
    reduce(`&`) %>% diamonds[., ]

## # A tibble: 44,736 × 10
##    carat       cut color clarity depth table price     x     y     z
##    <dbl>     <ord> <ord>   <ord> <dbl> <dbl> <int> <dbl> <dbl> <dbl>
## 1   0.23     Ideal     E     SI2  61.5    55   326  3.95  3.98  2.43
## 2   0.21   Premium     E     SI1  59.8    61   326  3.89  3.84  2.31
## 3   0.29   Premium     I     VS2  62.4    58   334  4.20  4.23  2.63
## 4   0.31      Good     J     SI2  63.3    58   335  4.34  4.35  2.75
## 5   0.24 Very Good     J    VVS2  62.8    57   336  3.94  3.96  2.48
## 6   0.24 Very Good     I    VVS1  62.3    57   336  3.95  3.98  2.47
## 7   0.26 Very Good     H     SI1  61.9    55   337  4.07  4.11  2.53
## 8   0.23 Very Good     H     VS1  59.4    61   338  4.00  4.05  2.39
## 9   0.30      Good     J     SI1  64.0    55   339  4.25  4.28  2.73
## 10  0.23     Ideal     J     VS1  62.8    56   340  3.93  3.90  2.46
## # ... with 44,726 more rows

Answer 3

使用data.table 包，第一个函数将返回一个表格，显示每个值的结果。第二个函数将检查所有值是否通过过滤器。

dt <- as.data.table(diamonds)
dt[, lapply(.SD, function(x) abs((x-median(x))/mad(x))<3), .SDcols=sapply(dt, is.numeric)]
index <- dt[, Reduce("+", lapply(.SD, function(x) abs((x-median(x))/mad(x))<3))==length(.SD), .SDcols=sapply(dt, is.numeric)]
dt[index, .N]

显示所有符合过滤条件的钻石

dt[index]

简化的逻辑检查

对于小数据集，时间差可能无关紧要，但我想强调的是，使用以下函数几乎是其他两个答案的两倍

function(x) abs((x - median(x)) / mad(x)) < 3

Answer 4

使用dplyr 包，我们应用下面的in_range 函数，如果您的条件单独应用于每一列，则返回True，然后rowwise() 和Reduce('&') 将其应用于整个行. 并且为了简单起见，numeric.vars 被重命名为 df。

in_range <- function(x) {
  (x > median(x) - (3*mad(x))) & (x < median(x) + (3*mad(x)))
}

df <- diamonds[sapply(diamonds, is.numeric)]

clean <- df[df %>% mutate_each(funs=funs(in_range)) %>% rowwise() %>% Reduce('&',.),]

nrow(clean)  # 44736

或@alistaire 建议的单线

diamonds %>% select_if(is.numeric) %>% mutate_all(funs((. > (median(.) - 3 * mad(.))) & (. < (median(.) + 3 * mad(.))))) %>% { filter(diamonds, Reduce(`&`, .)) }