用最新的非NA值replaceNA
在data.frame（或data.table）中，我想“填充”具有最近的非NA值的NA。 一个简单的例子，使用vector（而不是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
我需要对许多（总计data.frame ）小型数据data.frame （ data.frame ）重复这个操作，其中一行是NA，它的所有条目都是。 什么是解决问题的好方法？
我制作的丑陋解决scheme使用这个function：
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
…似乎工作。 但是，男人，这是丑陋的！ 有什么build议么？
您可能想要使用zoo包中的na.locf()函数来进行最后的观察以replace您的NA值。
以下是帮助页面中的使用示例的开头部分：
> example(na.locf) na.lcf> az <- zoo(1:6) na.lcf> bz <- zoo(c(2,NA,1,4,5,2)) na.lcf> na.locf(bz) 1 2 3 4 5 6 2 2 1 4 5 2 na.lcf> na.locf(bz, fromLast = TRUE) 1 2 3 4 5 6 2 1 1 4 5 2 na.lcf> cz <- zoo(c(NA,9,3,2,3,2)) na.lcf> na.locf(cz) 2 3 4 5 6 9 3 2 3 2
对不起，挖一个老问题。 我不能在火车上查找这个工作，所以我自己写了一个。
我很自豪地发现它速度要快一点。
虽然不太灵活。
但是，它与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
编辑
由于这成了我最有争议的答案，经常提醒我不要用我自己的function，因为我经常需要动物园的maxgap理由。 因为当我使用dplyr +date，我无法debugging时，动物园在边缘情况下有一些奇怪的问题，我今天回到这个来改善我的旧function。
我在这里testing了我的改进function和所有其他条目。 对于基本的特征， tidyr::fill是最快的，而且不会使边缘情况失败。 @BrandonBertelsen的Rcpp条目还是比较快，但是对于input的types却不灵活（由于对all.equal的误解，他错误地testing了边缘案例）。
如果你需要maxgap ，我下面的函数比动物园更快（并且没有date奇怪的问题）。
我把我的testing文件 。
新function
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包里 （只有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
更新
对于数字vector，函数有点不同：
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; }
试试这个function。 它不需要动物园包：
# 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
跟随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; }')
一个data.table解决scheme：
> 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是微不足道的。 只需在cumsum逻辑之前将组添加到by子句即可。
有一堆提供na.locf（NA Last Observation Carried）function的软件包：
- xts – xts :: na.locf
- 动物园 – 动物园:: na.locf
- imputeTS – imputeTS :: na.locf
- 时空 – 时空:: na.locf
还有其他的软件包，这个function的命名是不同的。
这对我有效，虽然我不确定是否更有效的其他build议。
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) }
我试了下面：
nullIdx <- as.array(which(is.na(masterData$RequiredColumn))) masterData$RequiredColumn[nullIdx] = masterData$RequiredColumn[nullIdx-1]
masterIdx获取idx数字，其中masterData $ RequiredColumn具有Null / NA值。 在下一行中，我们将其replace为相应的Idx-1值，即每个NULL / NA之前的最后一个好值
