Mengganti NAS dengan nilai non-NA terbaru

Dalam data.frame (atau data.table), saya ingin "mengisi maju" NAS dengan nilai non-NA terdekat sebelumnya. Contoh sederhana, menggunakan vektor (bukan a data.frame) adalah sebagai berikut:

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

Saya ingin fungsi fill.NAs()yang memungkinkan saya membangun yysedemikian rupa sehingga:

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

Saya perlu mengulangi operasi ini untuk banyak (total ~ 1 Tb) data.frames kecil (~ 30-50 Mb), di mana baris adalah NA adalah semua entri. Apa cara yang baik untuk mendekati masalah?

Solusi jelek yang saya buat menggunakan fungsi ini:

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
}

Fungsi fill.NAsini digunakan sebagai berikut:

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

Keluaran

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

... yang sepertinya berhasil. Tapi, kawan, apakah itu jelek! Ada saran?

Anda mungkin ingin menggunakan na.locf()fungsi dari paket kebun binatang untuk melakukan pengamatan terakhir ke depan untuk mengganti nilai NA Anda.

Ini adalah awal dari contoh penggunaannya dari halaman bantuan:

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 

Maaf karena menggali pertanyaan lama. Saya tidak bisa mencari fungsi untuk melakukan pekerjaan ini di kereta, jadi saya menulis sendiri.

Saya bangga mengetahui bahwa ini sedikit lebih cepat.
Ini kurang fleksibel.

Tapi bermain bagus ave, itulah yang saya butuhkan.

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   

Edit

Karena ini menjadi jawaban saya yang paling banyak dipilih, saya sering diingatkan bahwa saya tidak menggunakan fungsi saya sendiri, karena saya sering membutuhkan kebun binatang maxgap argumen . Karena kebun binatang memiliki beberapa masalah aneh dalam kasus tepi ketika saya menggunakan tanggal dplyr + yang tidak dapat saya debug, saya kembali ke sini hari ini untuk meningkatkan fungsi lama saya.

Saya membuat tolok ukur fungsi saya yang ditingkatkan dan semua entri lainnya di sini. Untuk serangkaian fitur dasar, tidyr::filltercepat dan juga tidak menghilangkan kasus tepi. Entri Rcpp oleh @BrandonBertelsen masih lebih cepat, tetapi tidak fleksibel mengenai tipe input (ia menguji case edge secara tidak benar karena kesalahpahaman all.equal).

Jika Anda perlu maxgap , fungsi saya di bawah ini lebih cepat daripada kebun binatang (dan tidak memiliki masalah aneh dengan tanggal).

Saya memasang dokumentasi tes saya .

fungsi baru

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
}

Saya juga memasukkan fungsi ke dalam paket formr saya (hanya Github).

a data.tablesolusi:

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

pendekatan ini dapat bekerja dengan mengisi nol di depan juga:

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

metode ini menjadi sangat berguna pada data pada skala dan di mana Anda ingin melakukan pengisian maju dengan kelompok, yang sepele dengan data.table. cukup tambahkan grup ke byklausa sebelum cumsumlogika.

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

Berurusan dengan volume data besar, agar lebih efisien, kita bisa menggunakan paket 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)
}

Melemparkan topiku:

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

Menyiapkan sampel dasar dan tolok ukur:

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

Dan jalankan beberapa tolok ukur:

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

Untuk berjaga-jaga:

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

Memperbarui

Untuk vektor numerik, fungsinya sedikit berbeda:

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

Ini berhasil bagi saya:

  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"

kecepatan juga masuk akal:

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


 user  system elapsed 

 0.072   0.000   0.071 

Coba fungsi ini. Tidak memerlukan paket 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)
    }
}

Contoh:

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

Memiliki pemimpin NAadalah sedikit kerutan, tetapi saya menemukan cara yang sangat mudah dibaca (dan vektor) untuk melakukan LOCF ketika istilah terkemuka tidak hilang adalah:

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

Modifikasi yang sedikit kurang mudah dibaca secara umum:

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

memberikan hasil yang diinginkan:

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

Anda dapat menggunakan data.tablefungsi ini nafill, tersedia dari data.table >= 1.12.3.

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

Jika vektor Anda adalah kolom dalam data.table, Anda juga dapat memperbaruinya dengan referensi dengan 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

Jika ada NAdi beberapa kolom ...

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

... Anda dapat mengisinya dengan referensi dalam sekali jalan:

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

Perhatikan bahwa:

Hanya tipe data ganda dan bilangan bulat yang saat ini [ data.table 1.12.6] didukung.

Fungsionalitas kemungkinan besar akan segera diperpanjang; lihat isu terbuka nafill, setnafill untuk karakter, faktor dan tipe lainnya , di mana Anda juga menemukan solusi sementara .

Paket rapi mengusulkan cara sederhana untuk melakukan itu:

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

Ada banyak paket yang menawarkan fungsi na.locf( NAPengamatan Terakhir Dilakukan Maju):

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

Dan juga paket lain di mana fungsi ini dinamai berbeda.

Menindaklanjuti kontribusi Brandon Bertelsen Rcpp. Bagi saya, versi NumericVector tidak berfungsi: itu hanya menggantikan NA pertama. Ini karenaina vektor hanya dievaluasi sekali, di awal fungsi.

Sebagai gantinya, seseorang dapat mengambil pendekatan yang sama persis seperti untuk fungsi IntegerVector. Berikut ini bekerja untuk saya:

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

Jika Anda membutuhkan versi CharacterVector, pendekatan dasar yang sama juga berfungsi:

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

Berikut ini adalah modifikasi dari solusi @ AdamO. Yang ini berjalan lebih cepat, karena melewati na.omitfungsi. Ini akan menimpa NAnilai - nilai dalam vektor y(kecuali untuk NAs terkemuka ).

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

Saya mencoba di bawah ini:

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

nullIdx mendapatkan nomor idx di mana pernah masterData $ RequiredColumn memiliki nilai Null / NA. Pada baris berikutnya kita menggantinya dengan nilai Idx-1 yang sesuai, yaitu nilai bagus terakhir sebelum setiap NULL / NA

Ini bekerja untuk saya, walaupun saya tidak yakin apakah ini lebih efisien daripada saran lainnya.

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 adalah konsep pemrograman fungsional yang bagus yang mungkin berguna untuk tugas serupa. Sayangnya di R ~ 70 kali lebih lambat dari repeat.beforepada jawaban di atas.

Saya pribadi menggunakan fungsi ini. Saya tidak tahu seberapa cepat atau lambatnya itu. Tetapi ia melakukan tugasnya tanpa harus menggunakan perpustakaan.

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

jika Anda ingin menerapkan fungsi ini dalam kerangka data, jika kerangka data Anda disebut df maka cukup

df[]<-lapply(df,replace_na_with_previous)