Remplacement des NA par la dernière valeur non NA

Dans un data.frame (ou data.table), je voudrais "remplir" les NA avec la valeur non NA précédente la plus proche. Un exemple simple, utilisant des vecteurs (au lieu de a data.frame) est le suivant:

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

Je voudrais une fonction fill.NAs()qui me permette de construire yytelle que:

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

Je dois répéter cette opération pour de nombreux s (au total ~ 1 To) de petite taille data.frame(~ 30-50 Mb), où une ligne est NA est toutes ses entrées. Quelle est la bonne manière d'aborder le problème?

La solution laide que j'ai préparée utilise cette fonction:

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 fonction fill.NAsest utilisée comme suit:

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

Production

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

... qui semble fonctionner. Mais, mec, c'est moche! Aucune suggestion?

Vous voudrez probablement utiliser la na.locf()fonction du paquet zoo pour reporter la dernière observation pour remplacer vos valeurs NA.

Voici le début de son exemple d'utilisation à partir de la page d'aide:

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 

Désolé d'avoir déterré une vieille question. Je ne pouvais pas rechercher la fonction pour faire ce travail dans le train, alors j'en ai écrit une moi-même.

J'étais fier de découvrir que c'était un peu plus rapide.
C'est moins flexible cependant.

Mais ça joue bien avec ave, c'est ce dont j'avais besoin.

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   

Éditer

Comme cela est devenu ma réponse la plus positive, on m'a souvent rappelé que je n'utilise pas ma propre fonction, car j'ai souvent besoin de l' maxgapargument du zoo . Parce que zoo a des problèmes étranges dans les cas extrêmes lorsque j'utilise des dates dplyr + que je ne pouvais pas déboguer, j'y suis revenu aujourd'hui pour améliorer mon ancienne fonction.

J'ai comparé ma fonction améliorée et toutes les autres entrées ici. Pour l'ensemble de base des fonctionnalités, tidyr::fillest le plus rapide tout en ne manquant pas non plus les cas extrêmes. L'entrée Rcpp de @BrandonBertelsen est encore plus rapide, mais elle est inflexible en ce qui concerne le type d'entrée (il a mal testé les cas de bord en raison d'un malentendu de all.equal).

Si vous avez besoin maxgap, ma fonction ci-dessous est plus rapide que zoo (et n'a pas les problèmes étranges avec les dates).

J'ai mis en place la documentation de mes tests .

nouvelle fonction

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
}

J'ai également mis la fonction dans mon package formr (Github uniquement).

une data.tablesolution:

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

cette approche pourrait également fonctionner avec des zéros de remplissage avant:

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

cette méthode devient très utile sur les données à grande échelle et où vous voudriez effectuer un remplissage avant par groupe (s), ce qui est trivial avec data.table. ajoutez simplement le (s) groupe (s) à la byclause avant la cumsumlogique.

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

Pour faire face à un gros volume de données, pour être plus efficace, nous pouvons utiliser le package 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)
}

Jeter mon chapeau dans:

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

Configurer un échantillon de base et un benchmark:

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

Et exécutez quelques benchmarks:

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

Au cas où:

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

Mettre à jour

Pour un vecteur numérique, la fonction est un peu différente:

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

Cela a fonctionné pour moi:

  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 vitesse est également raisonnable:

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


 user  system elapsed 

 0.072   0.000   0.071 

Essayez cette fonction. Il ne nécessite pas le package 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)
    }
}

Exemple:

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

Avoir un début NAest un peu ridicule, mais je trouve une façon très lisible (et vectorisée) de faire LOCF lorsque le terme principal n'est pas manquant est:

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

Une modification légèrement moins lisible fonctionne en général:

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

donne la sortie souhaitée:

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

Vous pouvez utiliser la data.tablefonction nafill, disponible à partir de data.table >= 1.12.3.

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

Si votre vecteur est une colonne dans a data.table, vous pouvez également le mettre à jour par référence avec 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 vous avez NAdans plusieurs colonnes ...

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

... vous pouvez les remplir par référence en une seule fois:

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

Notez que:

Seuls les types de données double et entier sont actuellement [ data.table 1.12.6] pris en charge.

La fonctionnalité sera très probablement bientôt étendue; voir le problème ouvert nafill, setnafill pour les caractères, les facteurs et d'autres types , où vous trouverez également une solution de contournement temporaire .

Le package tidyverse propose un moyen simple de le faire:

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

Il existe de nombreux packages offrant des fonctions na.locf( NADernière observation reportée):

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

Et aussi d'autres packages où cette fonction est nommée différemment.

Suivi des contributions Rcpp de Brandon Bertelsen. Pour moi, la version NumericVector ne fonctionnait pas: elle ne remplaçait que le premier NA. En effet, le inavecteur n'est évalué qu'une seule fois, au début de la fonction.

Au lieu de cela, on peut adopter exactement la même approche que pour la fonction IntegerVector. Ce qui suit a fonctionné pour moi:

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

Si vous avez besoin d'une version CharacterVector, la même approche de base fonctionne également:

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

Voici une modification de la solution de @ AdamO. Celui-ci fonctionne plus rapidement, car il contourne la na.omitfonction. Cela écrasera les NAvaleurs du vecteur y(sauf pour les NAs en tête ).

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

J'ai essayé ci-dessous:

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

nullIdx obtient le numéro idx là où masterData $ RequiredColumn a une valeur Null / NA. Dans la ligne suivante, nous la remplaçons par la valeur Idx-1 correspondante, c'est-à-dire la dernière bonne valeur avant chaque NULL / NA

Cela a fonctionné pour moi, même si je ne suis pas sûr que ce soit plus efficace que d'autres suggestions.

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

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

Réduire est un joli concept de programmation fonctionnelle qui peut être utile pour des tâches similaires. Malheureusement, dans R, il est ~ 70 fois plus lent que repeat.beforedans la réponse ci-dessus.

J'utilise personnellement cette fonction. Je ne sais pas à quel point c'est rapide ou lent. Mais il fait son travail sans avoir à utiliser de bibliothèques.

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 vous souhaitez appliquer cette fonction dans un dataframe, si votre dataframe s'appelle df alors simplement

df[]<-lapply(df,replace_na_with_previous)