Reemplazo de NA con el último valor no NA

En un data.frame (o data.table), me gustaría “completar” las NA con el valor previo no NA más cercano. Un ejemplo simple, usando vectores (en lugar de un data.frame ) es el siguiente:

 > y <- c(NA, 2, 2, NA, NA, 3, NA, 4, NA, NA) 

Me gustaría una función fill.NAs() que me permita construir yy tal que:

 > yy [1] NA NA NA 2 2 2 2 3 3 3 4 4 

Necesito repetir esta operación para muchos (totales ~ 1 Tb) data.frame tamaño pequeño (~ 30-50 Mb), donde una fila es NA son todas sus entradas. ¿Cuál es una buena manera de abordar el problema?

La fea solución que preparé usa esta función:

 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] <- 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 } 

La función fill.NAs se usa de la siguiente manera:

 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] } 

Salida

 > y [1] NA 2 2 2 2 3 3 3 4 4 4 

… que parece funcionar Pero, hombre, ¿es feo? ¿Alguna sugerencia?

Probablemente desee utilizar la función na.locf() del paquete del zoológico para llevar adelante la última observación y reemplazar sus valores NA.

Aquí está el comienzo de su ejemplo de uso de la página de ayuda:

 > 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 

Perdón por desenterrar una vieja pregunta. No pude buscar la función para hacer este trabajo en el tren, así que escribí uno yo mismo.

Estaba orgulloso de descubrir que es un poco más rápido.
Sin embargo, es menos flexible.

Pero juega bien con ave , que es lo que necesitaba.

 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 

Editar

Como esta se convirtió en mi respuesta más votada, a menudo me acordaban de que no uso mi propia función, porque a menudo necesito el argumento maxgap del zoo. Debido a que el zoológico tiene algunos problemas extraños en los casos extremos cuando uso dplyr + fechas que no pude depurar, volví a esto hoy para mejorar mi función anterior.

Analicé mi función mejorada y todas las demás entradas aquí. Para el conjunto básico de características, tidyr::fill es más rápido y no falla en los casos tidyr::fill . La entrada de Rcpp por @BrandonBertelsen es aún más rápida, pero es inflexible con respecto al tipo de entrada (que probó los casos de borde incorrectamente debido a un malentendido de all.equal ).

Si necesita maxgap , mi función a continuación es más rápida que zoo (y no tiene los problemas extraños con las fechas).

Puse la documentación de mis pruebas .

nueva función

 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 } 

También puse la función en mi paquete formr (solo Github).

Tratando con un gran volumen de datos, para ser más eficientes, podemos usar el paquete 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) } 

Arrojando mi sombrero en:

 library(Rcpp) cppFunction('IntegerVector na_locf(IntegerVector x) { int n = x.size(); for(int i = 0; i 0) && (x[i] == NA_INTEGER) & (x[i-1] != NA_INTEGER)) { x[i] = x[i-1]; } } return x; }') 

Configure una muestra básica y un punto de referencia:

 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) } 

Y ejecuta algunos puntos de referencia:

 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 

Por si acaso:

 all.equal( na_locf(x), replace_na_with_last(x), na.lomf(x), na.locf(x), repeat.before(x) ) [1] TRUE 

Actualizar

Para un vector numérico, la función es un poco diferente:

 NumericVector na_locf_numeric(NumericVector x) { int n = x.size(); LogicalVector ina = is_na(x); for(int i = 1; i 

Esto me ha funcionado:

  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" 

la velocidad es razonable también:

 > system.time(replace_na_with_last(sample(c(1,2,3,NA),1e6,replace=TRUE))) user system elapsed 0.072 0.000 0.071 

Prueba esta función. No requiere el paquete 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) } } 

Ejemplo:

 > # 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 

una solución 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 

este enfoque también podría funcionar con ceros de llenado hacia adelante:

 > 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 

este método se vuelve muy útil en los datos a escala y en los que le gustaría realizar un reenvío por grupo (s), lo cual es trivial con data.table . simplemente agregue el grupo (s) a la cláusula by antes de la lógica cumsum .

Tener una NA líder es un poco problemático, pero encuentro una manera muy legible (y vectorizada) de hacer LOCF cuando el término principal no falta es:

na.omit(y)[cumsum(!is.na(y))]

Una modificación ligeramente menos legible funciona en general:

c(NA, na.omit(y))[cumsum(!is.na(y))+1]

da el resultado deseado:

c(NA, 2, 2, 2, 2, 3, 3, 4, 4, 4)

Seguimiento de las contribuciones de Rcpp de Brandon Bertelsen. Para mí, la versión de NumericVector no funcionó: solo reemplazó la primera NA. Esto se debe a que el vector ina solo se evalúa una vez, al comienzo de la función.

En cambio, uno puede tomar el mismo enfoque que para la función IntegerVector. Lo siguiente funcionó para mí:

 library(Rcpp) cppFunction('NumericVector na_locf_numeric(NumericVector x) { R_xlen_t n = x.size(); for(R_xlen_t i = 0; i 0 && !R_finite(x[i]) && R_finite(x[i-1])) { x[i] = x[i-1]; } } return x; }') 

En caso de que necesite una versión de CharacterVector, el mismo enfoque básico también funciona:

 cppFunction('CharacterVector na_locf_character(CharacterVector x) { R_xlen_t n = x.size(); for(R_xlen_t i = 0; i 0 && x[i] == NA_STRING && x[i-1] != NA_STRING) { x[i] = x[i-1]; } } return x; }') 

Hay una gran cantidad de paquetes que ofrecen na.locf ( NA última observación llevada adelante):

  • xtsxts::na.locf
  • zoozoo::na.locf
  • imputeTSimputeTS::na.locf
  • spacetimespacetimespacetimespacetime::na.locf

Y también otros paquetes donde esta función recibe un nombre diferente.

Intenté lo siguiente:

 nullIdx <- as.array(which(is.na(masterData$RequiredColumn))) masterData$RequiredColumn[nullIdx] = masterData$RequiredColumn[nullIdx-1] 

nullIdx obtiene el número idx donde masterData $ RequiredColumn tiene un valor Null / NA. En la línea siguiente, lo reemplazamos con el correspondiente valor Idx-1, es decir, el último valor bueno antes de cada NULL / NA

Esto funcionó para mí, aunque no estoy seguro de si es más eficiente que otras sugerencias.

 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) } 

Aquí hay una modificación de la solución @ AdamO. Este corre más rápido, porque evita la función na.omit . Esto sobrescribirá los valores de NA en el vector y (a excepción de las NA principales).

  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)]