NAs durch den neuesten Nicht-NA-Wert ersetzen

Entschuldigung, dass Sie eine alte Frage gefunden haben. Ich konnte die Funktion nicht nachschlagen, um diese Arbeit im Zug zu erledigen, also habe ich selbst eine geschrieben.

Ich war stolz darauf, dass es ein bisschen schneller ist.
Es ist jedoch weniger flexibel.

Aber es spielt Nizza mit ave, was ich brauchte.

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   

Bearbeiten

Da dies zu meiner am meisten bewerteten Antwort wurde, wurde ich oft daran erinnert, dass ich meine eigene Funktion nicht benutze, da ich oft das maxgap-Argument von Zoo brauche. Da Zoo in Edge-Fällen einige merkwürdige Probleme hat, wenn ich Dplyr + -Daten verwende, die ich nicht debuggen konnte, kam ich heute darauf zurück, um meine alte Funktion zu verbessern.

Ich habe meine verbesserte Funktion und alle anderen Einträge hier getestet. Bei den grundlegenden Funktionen ist tidyr::fill am schnellsten, während die Edge-Fälle auch nicht ausfallen. Der Rcpp-Eintrag von @BrandonBertelsen ist zwar noch schneller, aber hinsichtlich des Eingabetyps ist er unflexibel (er hat Edge-Fälle aufgrund eines Missverständnisses von all.equal falsch getestet).

Wenn Sie maxgap benötigen, ist meine Funktion schneller als Zoo (und hat nicht die seltsamen Probleme mit Datumsangaben). 

Ich habe die Dokumentation meiner Tests aufgelegt .

neue Funktion

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
}

Ich habe die Funktion auch in mein formr package (nur Github) eingefügt.

Bei einem großen Datenvolumen können Sie das Paket data.table verwenden, um effizienter zu sein.

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

Werfen meinen Hut in: 

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

Richten Sie ein Basisbeispiel und einen Benchmark ein:

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

Und führe ein paar Benchmarks aus: 

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

Nur für den Fall: 

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

Aktualisieren

Bei einem numerischen Vektor ist die Funktion etwas anders:

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

Das hat für mich funktioniert:

  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"

geschwindigkeit ist auch vernünftig:

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


 user  system elapsed 

 0.072   0.000   0.071 

Versuchen Sie diese Funktion. Es ist kein Zoo-Paket erforderlich:

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

Beispiel:

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

Ein führendes NA zu haben ist ein bisschen faltig, aber ich finde eine sehr lesbare (und vektorisierte) Methode, um LOCF zu machen, wenn der führende Ausdruck nicht fehlt:

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

Eine etwas weniger lesbare Änderung funktioniert im Allgemeinen:

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

ergibt die gewünschte Ausgabe:

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

eine data.table-Lösung:

> 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

dieser Ansatz könnte auch mit vorwärts füllenden Nullen funktionieren:

> 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

diese Methode ist sehr nützlich für Daten mit Skalierung und wo Sie eine Vorwärtsfüllung nach Gruppe (n) durchführen möchten, was mit data.table trivial ist. Fügen Sie einfach die Gruppe (n) der by-Klausel vor der cumsum-Logik hinzu.

Sie können die data.table Funktion nafill verwenden, die in der Entwicklungsversion 1.12.3 verfügbar ist:

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

Wenn Ihr Vektor eine Spalte in einem data.table ist, können Sie ihn auch mit setnafill aktualisieren:

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

Folgemaßnahmen zu Brandon Bertelsens Rcpp-Beiträgen. Für mich funktionierte die NumericVector-Version nicht: Sie ersetzte nur die erste NA. Dies liegt daran, dass der ina-Vektor nur einmal am Anfang der Funktion ausgewertet wird.

Stattdessen kann genau dieselbe Vorgehensweise wie für die IntegerVector-Funktion verwendet werden. Folgendes hat für mich gearbeitet:

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

Falls Sie eine CharacterVector-Version benötigen, funktioniert der gleiche grundlegende Ansatz ebenfalls:

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

Es gibt eine Reihe von Paketen mit na.locf (NA Last Observation Carried Forward) Funktionen:

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

Und auch andere Pakete, bei denen diese Funktion anders benannt ist.

Hier ist eine Modifikation der @ AdamO-Lösung. Dieser läuft schneller, weil er die na.omit-Funktion umgeht. Dadurch werden die NA-Werte im Vektor y überschrieben (außer für führende NAs).

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

Ich habe das folgende probiert:

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

nullIdx erhält die IDx-Nummer, bei der masterData $ RequiredColumn einen Null-/NA-Wert hat ..__ In der nächsten Zeile ersetzen wir sie durch den entsprechenden Idx-1-Wert, d

Das hat für mich funktioniert, obwohl ich nicht sicher bin, ob es effizienter ist als andere Vorschläge.

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

Reduce ist ein schönes funktionales Programmierkonzept, das für ähnliche Aufgaben nützlich sein kann. Leider ist es in R in der obigen Antwort ~ 70-mal langsamer als repeat.before.