Ersetzen von NAs durch den neuesten Nicht-NA-Wert

In einem data.frame (oder einer data.table) möchte ich NAs mit dem nächsten vorherigen Nicht-NA-Wert "vorwärts füllen". Ein einfaches Beispiel für die Verwendung von Vektoren (anstelle von a data.frame) ist das folgende:

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

Ich möchte eine Funktion fill.NAs(), mit der ich Folgendes konstruieren kann yy:

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

Ich muss diesen Vorgang für viele (insgesamt ~ 1 TB) kleine data.frames (~ 30-50 Mb) wiederholen , bei denen eine Zeile NA ist und alle ihre Einträge sind. Was ist ein guter Weg, um das Problem anzugehen?

Die hässliche Lösung, die ich mir ausgedacht habe, verwendet diese Funktion:

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
}

Die Funktion fill.NAswird wie folgt verwendet:

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

Ausgabe

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

... was zu funktionieren scheint. Aber Mann, ist es hässlich? Irgendwelche Vorschläge?

Sie möchten wahrscheinlich die na.locf()Funktion aus dem Zoo- Paket verwenden, um die letzte Beobachtung fortzusetzen und Ihre NA-Werte zu ersetzen.

Hier ist der Beginn des Verwendungsbeispiels auf der Hilfeseite:

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 

Entschuldigen Sie, dass Sie eine alte Frage ausgegraben haben. Ich konnte die Funktion für diesen Job im Zug nicht nachschlagen, also habe ich selbst eine geschrieben.

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

Aber es spielt gut damit 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 meine am meisten befürwortete Antwort wurde, wurde ich oft daran erinnert, dass ich meine eigene Funktion nicht benutze, weil ich oft das maxgapArgument des Zoos brauche . Da der Zoo in Randfällen einige seltsame Probleme hat, wenn ich dplyr + -Daten verwende, die ich nicht debuggen konnte, bin ich heute darauf zurückgekommen, um meine alte Funktion zu verbessern.

Ich habe meine verbesserte Funktion und alle anderen Einträge hier verglichen. Für die Grundfunktionen tidyr::fillist am schnellsten, ohne auch die Randfälle zu verfehlen. Der Rcpp-Eintrag von @BrandonBertelsen ist noch schneller, aber hinsichtlich des Eingabetyps unflexibel (er hat Kantenfälle aufgrund eines Missverständnisses von falsch getestet all.equal).

Wenn Sie brauchen maxgap, ist meine Funktion unten schneller als der Zoo (und hat nicht die seltsamen Probleme mit Daten).

Ich habe die Dokumentation meiner Tests erstellt .

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-Paket aufgenommen (nur Github).

Um effizienter zu arbeiten, können wir 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)
}

eine data.tableLö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 in großem Maßstab und dort, wo Sie eine Vorwärtsfüllung nach Gruppe (n) durchführen möchten, was bei trivial ist data.table. Fügen Sie einfach die Gruppe (n) byvor der cumsumLogik zur Klausel hinzu .

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

Ich werfe meinen Hut hinein:

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ühren Sie einige Benchmarks durch:

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

Für einen 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 bei mir 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 

Probieren Sie diese Funktion aus. Das ZOO-Paket ist nicht 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

Eine Führung zu haben NAist ein bisschen faltig, aber ich finde eine sehr lesbare (und vektorisierte) Möglichkeit, LOCF zu machen, wenn der führende Begriff nicht fehlt:

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

Eine etwas weniger lesbare Modifikation funktioniert im Allgemeinen:

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

gibt die gewünschte Ausgabe:

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

Sie können die data.tableFunktion verwenden nafill, die unter verfügbar ist data.table >= 1.12.3.

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

Wenn Ihr Vektor eine Spalte in a ist data.table, können Sie ihn auch mit folgendem Verweis aktualisieren 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

Wenn Sie NAin mehreren Spalten haben ...

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

... Sie können sie auf einmal durch Referenz füllen:

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

Beachten Sie, dass:

Derzeit werden nur doppelte und ganzzahlige Datentypen [ data.table 1.12.6] unterstützt.

Die Funktionalität wird höchstwahrscheinlich bald erweitert; Weitere Informationen finden Sie in der offenen Ausgabe nafill, setnafill für Charakter, Faktor und andere Typen . Dort finden Sie auch eine vorübergehende Problemumgehung .

Das Tidyverse-Paket schlägt einen einfachen Weg vor, dies zu tun:

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

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

• 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.

Weiterverfolgung der Rcpp-Beiträge von Brandon Bertelsen. Für mich hat die NumericVector-Version nicht funktioniert: Sie hat nur die erste NA ersetzt. Das liegt daran, dass dieina Vektor zu Beginn der Funktion nur einmal ausgewertet wird.

Stattdessen kann man genau den gleichen Ansatz wie für die IntegerVector-Funktion wählen. Folgendes hat bei mir funktioniert:

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

Wenn Sie eine CharacterVector-Version benötigen, funktioniert der gleiche grundlegende Ansatz auch:

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

Hier ist eine Modifikation der @ AdamO-Lösung. Dieser läuft schneller, weil er die na.omitFunktion umgeht . Dadurch werden die NAWerte im Vektor überschrieben y(mit Ausnahme der führenden 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 Folgendes versucht:

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

nullIdx erhält die IDX-Nummer, wenn masterData $ RequiredColumn einen Null / NA-Wert hat. In der nächsten Zeile ersetzen wir ihn durch den entsprechenden Idx-1-Wert, dh den letzten guten Wert vor jedem NULL / NA

Dies hat bei mir 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

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

Ich persönlich benutze diese Funktion. Ich weiß nicht, wie schnell oder langsam es ist. Aber es macht seinen Job, ohne Bibliotheken benutzen zu müssen.

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

Wenn Sie diese Funktion in einem Datenrahmen anwenden möchten, wenn Ihr Datenrahmen df heißt, dann einfach

df[]<-lapply(df,replace_na_with_previous)