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'），我们用它来对“钻石”数据集的行进行子集化。

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和{{1}，则使用in_range包，我们会应用下面的True函数返回rowwise()将它作为一个整体应用于整个行。为简单起见，Reduce('&')已重命名为numeric.vars。

df

@alistaire建议的单线程

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

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

4 个答案: