分别从每列中删除异常值 (3*IQR)答案

【问题标题】：Remove outliers (3*IQR) from each column separately分别从每列中删除异常值 (3*IQR)
【发布时间】：2023-03-21 07:42:01
【问题描述】：

您好，我有一个包含许多列的大型数据框。我想根据数据集中所有列的每列+/- 3*IQR 的值将异常值替换为“NA”。我试过这样的事情，但一切都是假的。将不胜感激任何建议。我使用下面的代码收到以下错误消息。在 match.fun(FUN) 中：缺少参数“FUN”，没有默认值

IsOutlier <- apply(brain_measures, function(x) {
  lowerq = quantile(brain_measures, na.rm = TRUE)[2]
  upperq = quantile(brain_measures, na.rm = TRUE)[4]
  iqr = upperq - lowerq 
  lower_threshold = lowerq-(iqr*3) 
  upper_threshold=upperq+(iqr*3)
  brain_measures < lower_threshold | brain_measures>upper_threshold
}
)
The dataset called brain_measures is very fairly large (150 columns) and I need to perform some QC on each individual column to replace the outliers as missing so that in they will not be included in the regression models of my analysis. The below dataset has made up values but the structure is this with many more columns!

id        cuneus       hippocamp    icv         amygdala putamen
1          5.1         3.5          1.4         0.2        5
2          4.9         3.0          1.4         0.2        4
3          4.7         3.2          1.3         0.2       10
4          4.6         3.1          1.5         0.2        1
5          5.0         3.6          1.4         0.2        4
6          5.4         3.9          1.7         0.4        8

【问题讨论】：

lower_threshold 应该是 lowerq - iqr * 3 和 upper_threshold 应该是 upperq + iqr * 3。
建议：数据量越大，quantile 会变得更昂贵。捕获它的返回值并使用 that 值两次，如quant <- quantile(data, na.rm = TRUE); lowerq <- quant[2]; upperq <- quant[4];。（我同意 Darren 对 *_threshold 值的建议。）

标签： r function

【解决方案1】：

这是在每一列上使用 IQR 的一种方法。

我发现想出一个简单的“动词”函数通常非常有用，该函数可以轻松测试和演示，然后根据需要多次应用。

is_outlier <- function(x, iqrfac = 3) {
  quants <- quantile(x, na.rm = TRUE)
  iqr <- quants[4] - quants[2]
  !is.na(x) & (x < (quants[2] - iqrfac*iqr) | (quants[4] + iqrfac*iqr) < x)
}

查看您上面的示例数据，我更改了 $hippocamp 中的一个值，以获得更多异常值（除了 $amygdala 中的最后一个值）...

dat <- read.table(header = TRUE, stringsAsFactors = FALSE, text = "
id        cuneus       hippocamp    icv         amygdala putamen
1          5.1         3.5          1.4         0.2        5
2          4.9         3.0          1.4         0.2        4
3          4.7        13.2          1.3         0.2       10
4          4.6         3.1          1.5         0.2        1
5          5.0         3.6          1.4         0.2        4
6          5.4         3.9          1.7         0.4        8")

lapply(dat, is_outlier)
# $id
# [1] FALSE FALSE FALSE FALSE FALSE FALSE
# $cuneus
# [1] FALSE FALSE FALSE FALSE FALSE FALSE
# $hippocamp
# [1] FALSE FALSE  TRUE FALSE FALSE FALSE
# $icv
# [1] FALSE FALSE FALSE FALSE FALSE FALSE
# $amygdala
# [1] FALSE FALSE FALSE FALSE FALSE  TRUE
# $putamen
# [1] FALSE FALSE FALSE FALSE FALSE FALSE

从那里，我们可以使用lapply 的组合来返回逻辑向量列表（其中TRUE 表示该向量中的值需要替换）、replace（进行替换）和Map（将replace 函数映射到每一列和每个逻辑向量）。这可能看起来很复杂，但是...

dat[] <- Map(replace, dat, lapply(dat, is_outlier), NA)
dat
#   id cuneus hippocamp icv amygdala putamen
# 1  1    5.1       3.5 1.4      0.2       5
# 2  2    4.9       3.0 1.4      0.2       4
# 3  3    4.7        NA 1.3      0.2      10
# 4  4    4.6       3.1 1.5      0.2       1
# 5  5    5.0       3.6 1.4      0.2       4
# 6  6    5.4       3.9 1.7       NA       8

Map 实际上类似于lapply。

lapply(mydat, myfunc)
# "unrolls" to
list(
  myfunc(mydat[[1]]),
  myfunc(mydat[[2]]),
  myfunc(mydat[[3]]),
  ...,
  myfunc(mydat[[n]])
)

# equivalently
Map(myfunc, mydat) # reversed arguments
# "unrolls" to
list(
  myfunc(mydat[[1]]),
  myfunc(mydat[[2]]),
  myfunc(mydat[[3]]),
  ...,
  myfunc(mydat[[n]])
)

# extended
Map(otherfunc, datA, datB, datC)
# "unrolls" to
list(
  otherfunc(datA[[1]], datB[[1]], datC[[1]]),
  otherfunc(datA[[2]], datB[[2]], datC[[2]]),
  otherfunc(datA[[3]], datB[[3]], datC[[3]]),
  ...,
  otherfunc(datA[[n]], datB[[n]], datC[[n]])
)
# assuming that datA, datB, and datC are all the same length

Darren 使用 lowerq 和 upperq 代替 data 的评论是正确的。请允许我向您展示为什么会出现这种情况。

set.seed(42)
data <- rnorm(20)
data
#  [1]  1.37095845 -0.56469817  0.36312841  0.63286260  0.40426832 -0.10612452  1.51152200
#  [8] -0.09465904  2.01842371 -0.06271410  1.30486965  2.28664539 -1.38886070 -0.27878877
# [15] -0.13332134  0.63595040 -0.28425292 -2.65645542 -2.44046693  1.32011335

quant <- quantile(data, na.rm = TRUE)
lowerq <- quant[2]
upperq <- quant[4]
iqr <- upperq - lowerq

cbind(data, lower=data-(iqr * 3), upper=data+(iqr * 3))
#              data     lower    upper
#  [1,]  1.37095845 -3.395548 6.137465
#  [2,] -0.56469817 -5.331204 4.201808
#  [3,]  0.36312841 -4.403378 5.129635
#  [4,]  0.63286260 -4.133644 5.399369
#  [5,]  0.40426832 -4.362238 5.170774
#  [6,] -0.10612452 -4.872631 4.660382
#  [7,]  1.51152200 -3.254984 6.278028
#  [8,] -0.09465904 -4.861165 4.671847
#  [9,]  2.01842371 -2.748082 6.784930
# [10,] -0.06271410 -4.829220 4.703792
# [11,]  1.30486965 -3.461636 6.071376
# [12,]  2.28664539 -2.479861 7.053152
# [13,] -1.38886070 -6.155367 3.377645
# [14,] -0.27878877 -5.045295 4.487717
# [15,] -0.13332134 -4.899827 4.633185
# [16,]  0.63595040 -4.130556 5.402457
# [17,] -0.28425292 -5.050759 4.482253
# [18,] -2.65645542 -7.422962 2.110051
# [19,] -2.44046693 -7.206973 2.326039
# [20,]  1.32011335 -3.446393 6.086619

从data 中减去iqr*3 就是从data 中的每个值中减去它。这意味着所有_threshold 值将始终位于iqr*3 下方和iqr*3 上方每个data。这相当于说：

data > (data - (iqr*3)) | data < (data - (iqr*3))

这是总是正确的。

相反，

cbind(data, lower = lowerq-(iqr * 3), upper = upperq+(iqr * 3))
#              data     lower    upper
#  [1,]  1.37095845 -5.046661 6.075187
#  [2,] -0.56469817 -5.046661 6.075187
#  [3,]  0.36312841 -5.046661 6.075187
#  [4,]  0.63286260 -5.046661 6.075187
#  [5,]  0.40426832 -5.046661 6.075187
#  [6,] -0.10612452 -5.046661 6.075187
#  [7,]  1.51152200 -5.046661 6.075187
#  [8,] -0.09465904 -5.046661 6.075187
#  [9,]  2.01842371 -5.046661 6.075187
# [10,] -0.06271410 -5.046661 6.075187
# [11,]  1.30486965 -5.046661 6.075187
# [12,]  2.28664539 -5.046661 6.075187
# [13,] -1.38886070 -5.046661 6.075187
# [14,] -0.27878877 -5.046661 6.075187
# [15,] -0.13332134 -5.046661 6.075187
# [16,]  0.63595040 -5.046661 6.075187
# [17,] -0.28425292 -5.046661 6.075187
# [18,] -2.65645542 -5.046661 6.075187
# [19,] -2.44046693 -5.046661 6.075187
# [20,]  1.32011335 -5.046661 6.075187

（在此示例中始终如此，但至少您可以看到比较是针对每个较低/较高的单个值进行的。）

【讨论】：

感谢您指出这一点！我的代码实际上不起作用，我找不到太多关于如何分别在每一列上执行此功能的信息！
我或许可以提供帮助，但 "doesn't work" 信息不足，而且您的问题无法完全重现。你是说这段代码对你根本不起作用？
不，我试图找到其他类似的帖子，但看起来他们是逐列进行的。我在 R 中使用的函数不多……我现在用数据格式和我得到的错误来编辑我的问题！非常感谢您的帮助！
非常感谢您提供详细的解决方案和解释。出于好奇，与 lapply 相比，在这种情况下使用 map 是否有任何优势 dat[]
Map 在那里是“需要的”，因为它需要在 dat 的第一个“元素”（列）和第一个元素（列表的向量）上应用 replace 函数lapply() 返回；重复第二个和第二个；等等因为它是两个列表（一个是框架，一种特殊的列表），它需要可以处理两个或多个数据参数的东西。尔格Map。有解决方法。一种是存储outs <- lapply(dat, is_outlier)，然后存储lapply(seq_along(dat), function(i) replace(dat[[i]], outs[[i]], NA))。