Sostituzione di NA con l’ultimo valore non NA

In un data.frame (o data.table), vorrei “riempire” NA con il valore non NA precedente più vicino. Un semplice esempio, usando i vettori (invece di un data.frame ) è il seguente:

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

Vorrei una funzione fill.NAs() che mi permetta di build yy tale 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) di piccola dimensione data.frame s (~ 30-50 Mb), dove una riga è NA sono 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] <- 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 viene 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 vorrai utilizzare la funzione na.locf() del pacchetto zoo per trasportare l’ultima osservazione in avanti per sostituire i tuoi valori NA.

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

     > 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 

    Mi dispiace per aver scavato una vecchia domanda. Non ho potuto cercare la funzione per svolgere questo lavoro sul treno, quindi ne ho scritto uno io stesso.

    Sono stato orgoglioso di scoprire che è un po ‘più veloce.
    È meno flessibile però.

    Ma suona 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 uso la mia funzione, perché spesso ho bisogno dell’argomento maxgap di zoo. Perché lo zoo ha alcuni strani problemi nei casi limite quando uso dplyr + date che non ho potuto eseguire il debug, sono tornato a questo oggi per migliorare la mia vecchia funzione.

    Ho messo a confronto la mia funzione migliorata e tutte le altre voci qui. Per il set di funzioni di base, tidyr::fill è il più veloce e non fallisce i casi limite. La voce Rcpp di @BrandonBertelsen è ancora più veloce, ma non è flessibile per quanto riguarda il tipo di input (ha verificato i casi limite in modo errato a causa di un fraintendimento di all.equal ).

    Se hai bisogno di maxgap , la mia funzione qui sotto è più veloce dello zoo (e non ha i problemi strani 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).

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

    Lancio del mio cappello in:

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

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

    E gestisci alcuni punti di riferimento:

     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 

    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 

    una soluzione 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 

    questo approccio potrebbe funzionare anche con gli 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 in scala e in cui si desidera eseguire un riempimento in avanti per gruppo (s), che è banale con data.table . basta aggiungere il gruppo (i) alla clausola by prima della logica cumsum .

    Avere una NA leader è 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)

    Seguito sui contributi Rcpp di Brandon Bertelsen. Per me, la versione di NumericVector non ha funzionato: ha sostituito solo la prima NA. Questo perché il vettore ina viene valutato solo una volta, all’inizio della funzione.

    Invece, si può prendere lo stesso approccio come per la funzione IntegerVector. Quanto segue ha funzionato per me:

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

    Se hai bisogno di 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 0 && x[i] == NA_STRING && x[i-1] != NA_STRING) { x[i] = x[i-1]; } } return x; }') 

    Ci sono un sacco di pacchetti che offrono le na.locf ( NA Last Observation na.locf Forward):

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

    E anche altri pacchetti in cui questa funzione ha un nome diverso.

    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 buono prima di ogni NULL / NA

    Questo ha funzionato per me, anche se non sono sicuro se 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) } 

    Ecco una modifica della soluzione di @ AdamO. Questo viene eseguito più velocemente, perché ignora la funzione na.omit . Questo sovrascriverà i valori di NA nel vettore y (eccetto che per i NA principali).

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