在data.frame(或data.table)中,我想用最近的非NA值“填充”NA。一个简单的例子,使用向量(而不是data.frame
)如下:
> y <- c(NA, 2, 2, NA, NA, 3, NA, 4, NA, NA)
我想要一个函数fill.NAs()
,它允许我构造yy
,使得:
> yy
[1] NA NA NA 2 2 2 2 3 3 3 4 4
我需要为许多(总计~1 Tb)小型data.frame
s(~30-50 Mb)重复此操作,其中一行是NA,其所有条目都是。解决问题的好方法是什么?
我做的丑陋的解决方案使用这个功能:
last <- function (x){
x[length(x)]
}
fill.NAs <- function(isNA){
if (isNA[1] == 1) {
isNA[1:max({which(isNA==0)[1]-1},1)] <- 0 # first is NAs
# can't be forward filled
}
isNA.neg <- isNA.pos <- isNA.diff <- diff(isNA)
isNA.pos[isNA.diff < 0] <- 0
isNA.neg[isNA.diff > 0] <- 0
which.isNA.neg <- which(as.logical(isNA.neg))
if (length(which.isNA.neg)==0) return(NULL) # generates warnings later, but works
which.isNA.pos <- which(as.logical(isNA.pos))
which.isNA <- which(as.logical(isNA))
if (length(which.isNA.neg)==length(which.isNA.pos)){
replacement <- rep(which.isNA.pos[2:length(which.isNA.neg)],
which.isNA.neg[2:max(length(which.isNA.neg)-1,2)] -
which.isNA.pos[1:max(length(which.isNA.neg)-1,1)])
replacement <- c(replacement, rep(last(which.isNA.pos), last(which.isNA) - last(which.isNA.pos)))
} else {
replacement <- rep(which.isNA.pos[1:length(which.isNA.neg)], which.isNA.neg - which.isNA.pos[1:length(which.isNA.neg)])
replacement <- c(replacement, rep(last(which.isNA.pos), last(which.isNA) - last(which.isNA.pos)))
}
replacement
}
函数fill.NAs
使用如下:
y <- c(NA, 2, 2, NA, NA, 3, NA, 4, NA, NA)
isNA <- as.numeric(is.na(y))
replacement <- fill.NAs(isNA)
if (length(replacement)){
which.isNA <- which(as.logical(isNA))
to.replace <- which.isNA[which(isNA==0)[1]:length(which.isNA)]
y[to.replace] <- y[replacement]
}
产量
> y
[1] NA 2 2 2 2 3 3 3 4 4 4
......似乎有效。但是,伙计,这太丑了!有什么建议?
您可能希望使用na.locf()
包中的zoo函数来进行最后一次观察以替换您的NA值。
以下是帮助页面中其使用示例的开头:
library(zoo)
az <- zoo(1:6)
bz <- zoo(c(2,NA,1,4,5,2))
na.locf(bz)
1 2 3 4 5 6
2 2 1 4 5 2
na.locf(bz, fromLast = TRUE)
1 2 3 4 5 6
2 1 1 4 5 2
cz <- zoo(c(NA,9,3,2,3,2))
na.locf(cz)
2 3 4 5 6
9 3 2 3 2
跟进Brandon Bertelsen的Rcpp贡献。对我来说,NumericVector版本不起作用:它只替换了第一个NA。这是因为ina
向量仅在函数开始时被评估一次。
相反,可以采用与IntegerVector函数完全相同的方法。以下对我有用:
library(Rcpp)
cppFunction('NumericVector na_locf_numeric(NumericVector x) {
R_xlen_t n = x.size();
for(R_xlen_t i = 0; i<n; i++) {
if(i > 0 && !R_finite(x[i]) && R_finite(x[i-1])) {
x[i] = x[i-1];
}
}
return x;
}')
如果您需要CharacterVector版本,相同的基本方法也适用:
cppFunction('CharacterVector na_locf_character(CharacterVector x) {
R_xlen_t n = x.size();
for(R_xlen_t i = 0; i<n; i++) {
if(i > 0 && x[i] == NA_STRING && x[i-1] != NA_STRING) {
x[i] = x[i-1];
}
}
return x;
}')
有一堆包提供na.locf
(NA
最后观察结转)功能:
xts
- xts::na.locf
zoo
- zoo::na.locf
imputeTS
- imputeTS::na.locf
spacetime
- spacetime::na.locf
以及其他以不同方式命名此功能的包。
我试过以下:
nullIdx <- as.array(which(is.na(masterData$RequiredColumn)))
masterData$RequiredColumn[nullIdx] = masterData$RequiredColumn[nullIdx-1]
nullIdx获取idData编号,其中masterData $ RequiredColumn具有Null / NA值。在下一行中,我们用相应的Idx-1值替换它,即每个NULL / NA之前的最后一个好的值
这对我有用,虽然我不确定它是否比其他建议更有效。
rollForward <- function(x){
curr <- 0
for (i in 1:length(x)){
if (is.na(x[i])){
x[i] <- curr
}
else{
curr <- x[i]
}
}
return(x)
}
这是对@ AdamO解决方案的修改。这个运行速度更快,因为它绕过了na.omit
函数。这将覆盖矢量NA
中的y
值(除了领先的NA
s)。
z <- !is.na(y) # indicates the positions of y whose values we do not want to overwrite
z <- z | !cumsum(z) # for leading NA's in y, z will be TRUE, otherwise it will be FALSE where y has a NA and TRUE where y does not have a NA
y <- y[z][cumsum(z)]
fill.NAs <- function(x) {is_na<-is.na(x); x[Reduce(function(i,j) if (is_na[j]) i else j, seq_len(length(x)), accumulate=T)]}
fill.NAs(c(NA, 2, 2, NA, NA, 3, NA, 4, NA, NA))
[1] NA 2 2 2 2 3 3 4 4 4
Reduce是一个很好的函数式编程概念,可能对类似的任务很有用。不幸的是,在上面的答案中,它比repeat.before
慢约70倍。
很抱歉找到一个老问题。我无法查找在火车上完成这项工作的功能,所以我自己写了一个。
我很自豪地发现它的速度要快一点。 但它不那么灵活。
但它与ave
很好,这是我需要的。
repeat.before = function(x) { # repeats the last non NA value. Keeps leading NA
ind = which(!is.na(x)) # get positions of nonmissing values
if(is.na(x[1])) # if it begins with a missing, add the
ind = c(1,ind) # first position to the indices
rep(x[ind], times = diff( # repeat the values at these indices
c(ind, length(x) + 1) )) # diffing the indices + length yields how often
} # they need to be repeated
x = c(NA,NA,'a',NA,NA,NA,NA,NA,NA,NA,NA,'b','c','d',NA,NA,NA,NA,NA,'e')
xx = rep(x, 1000000)
system.time({ yzoo = na.locf(xx,na.rm=F)})
## user system elapsed
## 2.754 0.667 3.406
system.time({ yrep = repeat.before(xx)})
## user system elapsed
## 0.597 0.199 0.793
由于这成为我最热烈的答案,我经常被提醒我不使用自己的功能,因为我经常需要动物园的maxgap
论点。因为当我使用无法调试的dplyr +日期时,动物园在边缘情况下有一些奇怪的问题,我今天回到这里来改善我的旧功能。
我对我的改进功能和所有其他条目进行了基准测试。对于基本功能集,tidyr::fill
是最快的,同时也不会使边缘情况失败。 @BrandonBertelsen的Rcpp条目更快,但它对于输入的类型是不灵活的(由于对all.equal
的误解,他错误地测试了边缘情况)。
如果你需要maxgap
,我的下面的函数比动物园快(并且没有日期的奇怪问题)。
repeat_last = function(x, forward = TRUE, maxgap = Inf, na.rm = FALSE) {
if (!forward) x = rev(x) # reverse x twice if carrying backward
ind = which(!is.na(x)) # get positions of nonmissing values
if (is.na(x[1]) && !na.rm) # if it begins with NA
ind = c(1,ind) # add first pos
rep_times = diff( # diffing the indices + length yields how often
c(ind, length(x) + 1) ) # they need to be repeated
if (maxgap < Inf) {
exceed = rep_times - 1 > maxgap # exceeding maxgap
if (any(exceed)) { # any exceed?
ind = sort(c(ind[exceed] + 1, ind)) # add NA in gaps
rep_times = diff(c(ind, length(x) + 1) ) # diff again
}
}
x = rep(x[ind], times = rep_times) # repeat the values at these indices
if (!forward) x = rev(x) # second reversion
x
}
我还把这个函数放在我的formr package(仅限Github)中。
处理大数据量,为了提高效率,我们可以使用data.table包。
require(data.table)
replaceNaWithLatest <- function(
dfIn,
nameColNa = names(dfIn)[1]
){
dtTest <- data.table(dfIn)
setnames(dtTest, nameColNa, "colNa")
dtTest[, segment := cumsum(!is.na(colNa))]
dtTest[, colNa := colNa[1], by = "segment"]
dtTest[, segment := NULL]
setnames(dtTest, "colNa", nameColNa)
return(dtTest)
}
扔我的帽子:
library(Rcpp)
cppFunction('IntegerVector na_locf(IntegerVector x) {
int n = x.size();
for(int i = 0; i<n; i++) {
if((i > 0) && (x[i] == NA_INTEGER) & (x[i-1] != NA_INTEGER)) {
x[i] = x[i-1];
}
}
return x;
}')
设置基本样本和基准:
x <- sample(c(1,2,3,4,NA))
bench_em <- function(x,count = 10) {
x <- sample(x,count,replace = TRUE)
print(microbenchmark(
na_locf(x),
replace_na_with_last(x),
na.lomf(x),
na.locf(x),
repeat.before(x)
), order = "mean", digits = 1)
}
并运行一些基准:
bench_em(x,1e6)
Unit: microseconds
expr min lq mean median uq max neval
na_locf(x) 697 798 821 814 821 1e+03 100
na.lomf(x) 3511 4137 5002 4214 4330 1e+04 100
replace_na_with_last(x) 4482 5224 6473 5342 5801 2e+04 100
repeat.before(x) 4793 5044 6622 5097 5520 1e+04 100
na.locf(x) 12017 12658 17076 13545 19193 2e+05 100
以防万一:
all.equal(
na_locf(x),
replace_na_with_last(x),
na.lomf(x),
na.locf(x),
repeat.before(x)
)
[1] TRUE
对于数字向量,函数有点不同:
NumericVector na_locf_numeric(NumericVector x) {
int n = x.size();
LogicalVector ina = is_na(x);
for(int i = 1; i<n; i++) {
if((ina[i] == TRUE) & (ina[i-1] != TRUE)) {
x[i] = x[i-1];
}
}
return x;
}
试试这个功能。它不需要ZOO包:
# last observation moved forward
# replaces all NA values with last non-NA values
na.lomf <- function(x) {
na.lomf.0 <- function(x) {
non.na.idx <- which(!is.na(x))
if (is.na(x[1L])) {
non.na.idx <- c(1L, non.na.idx)
}
rep.int(x[non.na.idx], diff(c(non.na.idx, length(x) + 1L)))
}
dim.len <- length(dim(x))
if (dim.len == 0L) {
na.lomf.0(x)
} else {
apply(x, dim.len, na.lomf.0)
}
}
例:
> # vector
> na.lomf(c(1, NA,2, NA, NA))
[1] 1 1 2 2 2
>
> # matrix
> na.lomf(matrix(c(1, NA, NA, 2, NA, NA), ncol = 2))
[,1] [,2]
[1,] 1 2
[2,] 1 2
[3,] 1 2
这对我有用:
replace_na_with_last<-function(x,a=!is.na(x)){
x[which(a)[c(1,1:sum(a))][cumsum(a)+1]]
}
> replace_na_with_last(c(1,NA,NA,NA,3,4,5,NA,5,5,5,NA,NA,NA))
[1] 1 1 1 1 3 4 5 5 5 5 5 5 5 5
> replace_na_with_last(c(NA,"aa",NA,"ccc",NA))
[1] "aa" "aa" "aa" "ccc" "ccc"
速度也合理:
> system.time(replace_na_with_last(sample(c(1,2,3,NA),1e6,replace=TRUE)))
user system elapsed
0.072 0.000 0.071
一个data.table
解决方案:
> dt <- data.table(y = c(NA, 2, 2, NA, NA, 3, NA, 4, NA, NA))
> dt[, y_forward_fill := y[1], .(cumsum(!is.na(y)))]
> dt
y y_forward_fill
1: NA NA
2: 2 2
3: 2 2
4: NA 2
5: NA 2
6: 3 3
7: NA 3
8: 4 4
9: NA 4
10: NA 4
这种方法也适用于前向填充零:
> dt <- data.table(y = c(0, 2, -2, 0, 0, 3, 0, -4, 0, 0))
> dt[, y_forward_fill := y[1], .(cumsum(y != 0))]
> dt
y y_forward_fill
1: 0 0
2: 2 2
3: -2 -2
4: 0 -2
5: 0 -2
6: 3 3
7: 0 3
8: -4 -4
9: 0 -4
10: 0 -4
这种方法对于大规模数据非常有用,并且您希望通过组执行前向填充,这对于data.table
来说是微不足道的。只需在by
逻辑之前将组添加到cumsum
子句中。
有一个领先的NA
有点皱纹,但我发现一个非常可读(和矢量化)的方式做LOCF时,主要术语不缺少是:
na.omit(y)[cumsum(!is.na(y))]
稍微不易读的修改通常起作用:
c(NA, na.omit(y))[cumsum(!is.na(y))+1]
给出所需的输出:
c(NA, 2, 2, 2, 2, 3, 3, 4, 4, 4)
您可以使用data.table
中提供的nafill
函数development version 1.12.3:
library(data.table)
nafill(y, type = "locf")
# [1] NA 2 2 2 2 3 3 4 4 4
如果你的矢量是data.table
中的一列,你也可以通过引用setnafill
更新它:
d <- data.table(x = 1:10, y)
setnafill(d, type = "locf", cols = "y")
d
# x y
# 1: 1 NA
# 2: 2 2
# 3: 3 2
# 4: 4 2
# 5: 5 2
# 6: 6 3
# 7: 7 3
# 8: 8 4
# 9: 9 4
# 10: 10 4