Sustitución de NA por el último valor no NA

141

En un data.frame (o data.table), me gustaría "completar" NA con el valor anterior que no sea NA más cercano. Un ejemplo simple, el uso de vectores (en lugar de a 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 de yymanera que:

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

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

La solución fea 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
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
}

La función fill.NAsse 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?

Ryogi
fuente
1
De otra pregunta ya que éste, creo que ahora ha encontrado roll=TRUEen data.table.
Matt Dowle
3
Se está introduciendo un nuevo método como fillenR
Saksham
14
Además, investigue tidyr::fill().
zx8754
Ver también: stackoverflow.com/questions/12607465/…
Michael Ohlrogge

Respuestas:

160

Probablemente quiera usar la na.locf()función del paquete del zoológico para llevar la última observación hacia adelante para reemplazar sus valores de NA.

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

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 
Dirk Eddelbuettel
fuente
2
También tenga na.locfen cuenta que en zoo funciona con vectores ordinarios, así como con objetos de zoo. Su na.rmargumento puede ser útil en algunas aplicaciones.
G. Grothendieck
55
Úselo na.locf(cz, na.rm=FALSE)para seguir liderando NA.
BallpointBen
El comentario de @BallpointBen es importante y debe incluirse en la respuesta. ¡Gracias!
Ben
62

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.

Me enorgulleció descubrir que es un poco más rápido.
Sin embargo, es menos flexible.

Pero juega bien 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 recordó que no uso mi propia función, porque a menudo necesito el uso de zoológicos. maxgap argumento . Debido a que el zoológico tiene algunos problemas extraños en casos extremos cuando uso dplyr + fechas que no pude depurar, volví a esto hoy para mejorar mi antigua función.

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

Si necesitas maxgap , mi función a continuación es más rápida que la del zoológico (y no tiene los problemas raros con las fechas).

Pongo 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).

Rubén
fuente
2
+1, pero supongo que esto debe colocarse en bucle por columna si desea aplicar esto a a dfcon varias columnas.
Zhubarb
3
@ Rubén Gracias de nuevo por tu informe. Por ahora, el error está solucionado en R-Forge. También modifiqué y exporté la función de caballo de batalla na.locf0que ahora es similar en alcance y rendimiento a su repeat_lastfunción. La clave era usar en difflugar de cumsumevitar ifelse. La principal na.locf.defaultfunción es todavía algo más lento, ya que hace algunos más controles y las manijas varias columnas, etc
Achim Zeileis
23

una data.tablesolucion:

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 relleno hacia adelante ceros:

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 desea realizar un relleno hacia adelante por grupo (s), lo cual es trivial data.table. simplemente agregue los grupos a la bycláusula antes de la cumsumlógica.

dt <- data.table(group = sample(c('a', 'b'), 20, replace = TRUE), y = sample(c(1:4, rep(NA, 4)), 20 , replace = TRUE))
dt <- dt[order(group)]
dt[, y_forward_fill := y[1], .(group, cumsum(!is.na(y)))]
dt
    group  y y_forward_fill
 1:     a NA             NA
 2:     a NA             NA
 3:     a NA             NA
 4:     a  2              2
 5:     a NA              2
 6:     a  1              1
 7:     a NA              1
 8:     a  3              3
 9:     a NA              3
10:     a NA              3
11:     a  4              4
12:     a NA              4
13:     a  1              1
14:     a  4              4
15:     a NA              4
16:     a  3              3
17:     b  4              4
18:     b NA              4
19:     b NA              4
20:     b  2              2
Tony DiFranco
fuente
1
¡La capacidad de hacer esto por grupos es increíble!
JCWong
22

Al tratar 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)
}
Michele Usuelli
fuente
2
Se puede agregar un lapply para que pueda aplicarlo directamente a múltiples columnas de NA:replaceNaWithLatest <- function( dfIn, nameColsNa = names(dfIn)[1] ){ dtTest <- data.table(dfIn) invisible(lapply(nameColsNa, function(nameColNa){ 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) }
xclotet
Al principio me entusiasmó esta solución, pero en realidad no está haciendo lo mismo en absoluto. La pregunta es sobre completar 1 conjunto de datos con otro. Esta respuesta es solo una imputación.
Hack-R
19

Tirando mi sombrero

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

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<n; i++) {
    if((ina[i] == TRUE) & (ina[i-1] != TRUE)) {
      x[i] = x[i-1];
    }
  }
  return x;
}
Brandon Bertelsen
fuente
15

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 también es razonable:

> system.time(replace_na_with_last(sample(c(1,2,3,NA),1e6,replace=TRUE)))


 user  system elapsed 

 0.072   0.000   0.071 
Nick Nassuphis
fuente
2
Esta función no hace lo que espera cuando hay NA principales. replace_na_with_last(c(NA,1:4,NA))(es decir, se rellenan con el siguiente valor). Este es también el comportamiento predeterminado de imputeTS::na.locf(x, na.remaining = "rev").
Ruben
mejor agregar un valor predeterminado para este caso, un enfoque ligeramente diferente: replace_na_with_last<-function(x,p=is.na,d=0)c(d,x)[cummax(seq_along(x)*(!p(x)))+1]
Nick Nassuphis
¡La respuesta de @NickNassuphis es corta, dulce, no depende del paquete y funciona bien con tuberías dplyr!
Kim
14

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
Eldar Agalarov
fuente
Para mejorarla se puede añadir lo siguiente: if (!anyNA(x)) return(x).
Artem Klevtsov
13

Tener un inicio NAes un poco arrugado, pero encuentro una forma muy legible (y vectorizada) de hacer LOCF cuando no falta el término principal :

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 la salida deseada:

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

AdamO
fuente
3
Esto es bastante elegante. ¡No estoy seguro de si funciona en todos los casos, pero seguro que funcionó para mí!
ABT
12

Puede usar la data.tablefunción nafill, disponible en data.table >= 1.12.3.

library(data.table)
nafill(y, type = "locf")
# [1] NA  2  2  2  2  3  3  4  4  4

Si su vector es una columna en a data.table, también puede actualizarlo por referencia con 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

Si tienes NAen varias columnas ...

d <- data.table(x = c(1, NA, 2), y = c(2, 3, NA), z = c(4, NA, 5))
#     x  y  z
# 1:  1  2  4
# 2: NA  3 NA
# 3:  2 NA  5

... puedes llenarlos por referencia de una vez:

setnafill(d, type = "locf")
d
#    x y z
# 1: 1 2 4
# 2: 1 3 4
# 3: 2 3 5

Tenga en cuenta que:

Sólo dobles y enteros tipos de datos están actualmente [ data.table 1.12.6] compatibles.

Lo más probable es que la funcionalidad se extienda pronto; vea el tema abierto nafill, setnafill para caracteres, factores y otros tipos , donde también encontrará una solución temporal .

Henrik
fuente
5

El paquete tidyverse propone una forma simple de hacer eso:

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

# first, transform it into a data.frame

y = as.data.frame(y)
   y
1  NA
2   2
3   2
4  NA
5  NA
6   3
7  NA
8   4
9  NA
10 NA

fill(y, y, .direction = 'down')
    y
1  NA
2   2
3   2
4   2
5   2
6   3
7   3
8   4
9   4
10  4
Rist
fuente
3

Hay un montón de paquetes que ofrecen funciones na.locf( NAúltima observación realizada):

  • xts - xts::na.locf
  • zoo - zoo::na.locf
  • imputeTS - imputeTS::na.locf
  • spacetime - spacetime::na.locf

Y también otros paquetes donde esta función se nombra de manera diferente.

stats0007
fuente
2

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

En cambio, uno puede adoptar el mismo enfoque exacto 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<n; i++) {
    if(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<n; i++) {
    if(i > 0 && x[i] == NA_STRING && x[i-1] != NA_STRING) {
      x[i] = x[i-1];
    }
  }
  return x;
}')
Evan Cortens
fuente
int n = x.size () y for (int i = 0; i <n; i ++) deben reemplazarse por double. En R, un vector puede ser mayor que el tamaño c ++ int.
stats0007
Parece que esta función devuelve "R_xlen_t". Si R se compila con soporte de vector largo, esto se define como ptrdiff_t; si no lo es, es un int. ¡Gracias por la corrección!
Evan Cortens
1

Aquí hay una modificación de la solución de @ AdamO. Este se ejecuta más rápido, ya que omite la na.omitfunción. Esto sobrescribirá los NAvalores en el vector y(excepto los NAs iniciales ).

   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)]
Montgomery Clift
fuente
0

Intenté lo siguiente:

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

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

Abhishek Lahiri
fuente
Esto no funciona si hay varios valores perdidos consecutivos, se 1 NA NAconvierte en 1 1 NA. Además, creo que as.array()es innecesario.
Gregor Thomas
0

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)
}
dmca
fuente
0
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

Reducir es un buen concepto de programación funcional que puede ser útil para tareas similares. Desafortunadamente en R es ~ 70 veces más lento que repeat.beforeen la respuesta anterior.

Valentas
fuente
0

Yo personalmente uso esta función. No sé qué tan rápido o lento es. Pero hace su trabajo sin tener que usar bibliotecas.

replace_na_with_previous<-function (vector) {
        if (is.na(vector[1])) 
            vector[1] <- na.omit(vector)[1]
        for (i in 1:length(vector)) {
            if ((i - 1) > 0) {
                if (is.na(vector[i])) 
                    vector[i] <- vector[i - 1]
            }
        }
        return(vector)
    }

si desea aplicar esta función en un marco de datos, si su marco de datos se llama df, simplemente

df[]<-lapply(df,replace_na_with_previous)
Dimitrios Zacharatos
fuente