下面的函数计算向量的平均值。然而,它首先检查向量中存在的NA的比例,如果超过给定的阈值,则返回NA而不是平均值。
我的问题是,当前的实现相当低效。它比简单运行`mean(vec, na.rm=TRUE)`慢7倍以上。
我尝试了使用`na.omit`的替代方法,但那甚至更慢。
鉴于我的数据规模,执行单个`lapply`需要超过40分钟。
有什么建议可以更快地完成同样的任务吗?
更新 - 关于@thelatemail的解决方案和@Arun的评论:
我正在对数百个组执行此函数,每个组的大小都不同。这个问题最初提供的示例数据只是为了方便创建人工数据而提供的整洁数据框。
替代样本数据以避免混淆。
我的问题是,当前的实现相当低效。它比简单运行`mean(vec, na.rm=TRUE)`慢7倍以上。
我尝试了使用`na.omit`的替代方法,但那甚至更慢。
鉴于我的数据规模,执行单个`lapply`需要超过40分钟。
有什么建议可以更快地完成同样的任务吗?
更新 - 关于@thelatemail的解决方案和@Arun的评论:
我正在对数百个组执行此函数,每个组的大小都不同。这个问题最初提供的示例数据只是为了方便创建人工数据而提供的整洁数据框。
替代样本数据以避免混淆。
# Sample Data
# ------------
set.seed(1)
# slightly different sizes for each group
N1 <- 5e3
N2 <- N1 + as.integer(rnorm(1, 0, 100))
# One group has only a moderate amount of NA's
SAMP1 <- rnorm(N1)
SAMP1[sample(N1, .25 * N1, FALSE)] <- NA # add in NA's
# Another group has many NA's
SAMP2 <- rnorm(N2)
SAMP2[sample(N2, .95 * N2, FALSE)] <- NA # add in large number of NA's
# put them all in a list
SAMP.NEW <- list(SAMP1, SAMP2)
# keep it clean
rm(SAMP1, SAMP2)
# Execute
# -------
lapply(SAMP.NEW, meanIfThresh)
原始样本数据、函数等
# Sample Data
# ------------
set.seed(1)
rows <- 20000 # actual data has more than 7M rows
cols <- 1000
SAMP <- replicate(cols, rnorm(rows))
SAMP[sample(length(SAMP), .25 * length(SAMP), FALSE)] <- NA # add in NA's
# Select 5 random rows, and have them be 90% NA
tooSparse <- sample(rows, 5)
for (r in tooSparse)
SAMP[r, sample(cols, cols * .9, FALSE)] <- NA
# Function
# ------------
meanIfThresh <- function(vec, thresh=12/15) {
# Calculates the mean of vec, however,
# if the number of non-NA values of vec is less than thresh, returns NA
# thresh : represents how much data must be PRSENT.
# ie, if thresh is 80%, then there must be at least
len <- length(vec)
if( (sum(is.na(vec)) / len) > thresh)
return(NA_real_)
# if the proportion of NA's is greater than the threshold, return NA
# example: if I'm looking at 14 days, and I have 12 NA's,
# my proportion is 85.7 % = (12 / 14)
# default thesh is 80.0 % = (12 / 15)
# Thus, 12 NAs in a group of 14 would be rejected
# else, calculate the mean, removing NA's
return(mean(vec, na.rm=TRUE))
}
# Execute
# -----------------
apply(SAMP, 1, meanIfThresh)
# Compare with `mean`
#----------------
plain <- apply(SAMP, 1, mean, na.rm=TRUE)
modified <- apply(SAMP, 1, meanIfThresh)
# obviously different
identical(plain, modified)
plain[tooSparse]
modified[tooSparse]
microbenchmark( "meanIfThresh" = apply(SAMP, 1, meanIfThresh)
, "mean (regular)" = apply(SAMP, 1, mean, na.rm=TRUE)
, times = 15L)
# With the actual data, the penalty is sevenfold
# Unit: seconds
# expr min lq median uq max neval
# meanIfThresh 1.658600 1.677472 1.690460 1.751913 2.110871 15
# mean (regular) 1.422478 1.485320 1.503468 1.532175 1.547450 15
SAMP[sample(SAMP, .25 * length(SAMP), FALSE)] <- NA
在 R3.0.1 中对我来说会抛出一个错误,提示only 0's may be mixed with negative subscripts
。 - thelatemailSAMP[sample(seq_along(SAMP), .25 * length(SAMP))] <- NA
? - thelatemailSAMP[sample(length(SAMP), .25 * length(SAMP), FALSE)] <- NA
(已在编辑中更正) - Ricardo Saporta