Sostituzione di NA con l'ultimo valore non NA

In un data.frame (o data.table), vorrei "riempire" le NA con il valore precedente non NA più vicino. Un semplice esempio, utilizzando i vettori (anziché a data.frame) è il seguente:

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

Vorrei una funzione fill.NAs()che mi permettesse di costruire in modo yytale che:

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

Ho bisogno di ripetere questa operazione per molti (totale ~ 1 Tb) data.frames di piccole dimensioni (~ 30-50 Mb), dove una riga è NA è tutte le sue voci. Qual è un buon modo per affrontare il problema?

La brutta soluzione che ho preparato usa questa funzione:

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 funzione fill.NAsè utilizzata come segue:

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

Produzione

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

... che sembra funzionare. Ma, amico, è brutto! Eventuali suggerimenti?

Probabilmente vuoi usare la na.locf()funzione dal pacchetto zoo per portare avanti l'ultima osservazione per sostituire i tuoi valori NA.

Ecco l'inizio del suo esempio di utilizzo dalla pagina di aiuto:

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 

Ci scusiamo per aver scavato una vecchia domanda. Non ho potuto cercare la funzione per fare questo lavoro sul treno, quindi ne ho scritto uno da solo.

Sono stato orgoglioso di scoprire che è un po 'più veloce.
Tuttavia è meno flessibile.

Ma gioca bene con ave, che è quello di cui avevo bisogno.

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   

modificare

Poiché questa è diventata la mia risposta più votata, mi è stato spesso ricordato che non utilizzo la mia funzione, perché spesso ho bisogno maxgapdell'argomento dello zoo . Poiché lo zoo ha alcuni strani problemi nei casi limite quando uso le date dplyr + che non sono riuscito a eseguire il debug, sono tornato a questo oggi per migliorare la mia vecchia funzione.

Ho confrontato la mia funzione migliorata e tutte le altre voci qui. Per il set di funzionalità di base, tidyr::fillè più veloce pur non fallendo i casi limite. La voce Rcpp di @BrandonBertelsen è ancora più veloce, ma non è flessibile per quanto riguarda il tipo di input (ha verificato erroneamente i casi limite a causa di un malinteso di all.equal).

Se necessario maxgap, la mia funzione di seguito è più veloce di zoo (e non ha gli strani problemi con le date).

Ho messo la documentazione dei miei test .

nuova funzione

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
}

Ho anche inserito la funzione nel mio pacchetto formr (solo Github).

una data.tablesoluzione:

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

questo approccio potrebbe funzionare anche con zeri di riempimento in avanti:

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

questo metodo diventa molto utile su dati su larga scala e dove si desidera eseguire un riempimento in avanti per gruppo (i), il che è banale data.table. basta aggiungere i gruppi alla byclausola prima della cumsumlogica.

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

Affrontare un grande volume di dati, per essere più efficienti, possiamo usare il pacchetto 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)
}

Lanciando il mio cappello dentro:

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

Imposta un campione di base e 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)
}

Ed esegui alcuni benchmark:

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

Nel caso in cui:

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

Aggiornare

Per un vettore numerico, la funzione è leggermente diversa:

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

Questo ha funzionato per me:

  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"

anche la velocità è ragionevole:

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


 user  system elapsed 

 0.072   0.000   0.071 

Prova questa funzione. Non richiede il pacchetto 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)
    }
}

Esempio:

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

Avere un vantaggio NAè un po 'una ruga, ma trovo un modo molto leggibile (e vettorializzato) di fare LOCF quando il termine principale non manca:

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

Una modifica leggermente meno leggibile funziona in generale:

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

dà l'output desiderato:

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

È possibile utilizzare la data.tablefunzione nafill, disponibile da data.table >= 1.12.3.

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

Se il tuo vettore è una colonna in a data.table, puoi anche aggiornarlo facendo riferimento a 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

Se hai NAin più colonne ...

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

... puoi riempirli per riferimento in una sola volta:

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

Nota che:

Attualmente sono supportati solo i tipi di dati doppio e intero [ data.table 1.12.6].

Molto probabilmente la funzionalità sarà presto estesa; vedere il problema aperto nafill, setnafill per carattere, fattore e altri tipi , dove trovi anche una soluzione temporanea .

Il pacchetto tidyverse propone un modo semplice per farlo:

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

Ci sono un sacco di pacchetti che offrono funzioni na.locf( NAUltima osservazione portata avanti):

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

E anche altri pacchetti in cui questa funzione è denominata diversamente.

In seguito ai contributi Rcpp di Brandon Bertelsen. Per me, la versione di NumericVector non funzionava: sostituiva solo la prima NA. Questo perché il inavettore viene valutato una sola volta, all'inizio della funzione.

Invece, si può seguire lo stesso approccio della funzione IntegerVector. Per me ha funzionato:

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

Nel caso in cui sia necessaria una versione di CharacterVector, lo stesso approccio di base funziona anche:

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

Ecco una modifica della soluzione di @ AdamO. Questo funziona più velocemente, perché ignora la na.omitfunzione. Questo sovrascriverà i NAvalori nel vettore y(eccetto per le NAs iniziali ).

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

Ho provato il seguito:

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

nullIdx ottiene il numero idx dove mai masterData $ RequiredColumn ha un valore Null / NA. Nella riga successiva lo sostituiamo con il corrispondente valore Idx-1, ovvero l'ultimo valore valido prima di ogni NULL / NA

Questo ha funzionato per me, anche se non sono sicuro che sia più efficiente di altri suggerimenti.

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

Ridurre è un bel concetto di programmazione funzionale che può essere utile per compiti simili. Sfortunatamente in R è ~ 70 volte più lento rispetto repeat.beforealla risposta sopra.

Personalmente uso questa funzione. Non so quanto sia veloce o lento. Ma fa il suo lavoro senza dover usare le librerie.

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

se vuoi applicare questa funzione in un dataframe, se il tuo dataframe è chiamato df, allora semplicemente

df[]<-lapply(df,replace_na_with_previous)