Mengganti NAS dengan nilai non-NA terbaru

141

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?

Ryogi
sumber
1
Dari pertanyaan lain sejak satu ini, saya pikir Anda sudah sekarang ditemukan roll=TRUEdi data.table.
Matt Dowle
3
Sebuah metode baru sedang diperkenalkan filldiR
Saksham
14
Juga, perhatikan tidyr::fill().
zx8754
Lihat juga: stackoverflow.com/questions/12607465/…
Michael Ohlrogge

Jawaban:

160

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 
Dirk Eddelbuettel
sumber
2
Perhatikan juga bahwa na.locfdi kebun binatang bekerja dengan vektor biasa serta objek kebun binatang. Its na.rmargumen dapat berguna dalam beberapa aplikasi.
G. Grothendieck
5
Gunakan na.locf(cz, na.rm=FALSE)untuk terus memimpin NA.
BallpointBen
Komentar @BallpointBen penting dan harus dimasukkan dalam jawaban. Terima kasih!
Ben
62

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

Ruben
sumber
2
+1, tapi saya kira ini perlu diulang per kolom jika Anda ingin menerapkan ini ke dfdengan beberapa kolom?
Zhubarb
3
@ Ruben Terima kasih lagi untuk laporan Anda. Sekarang bug diperbaiki pada R-Forge. Saya juga telah mengubah dan mengekspor fungsi pekerja keras na.locf0yang sekarang memiliki cakupan dan kinerja yang mirip dengan repeat_lastfungsi Anda . Petunjuknya adalah menggunakan diffdaripada cumsumdan menghindari ifelse. Fungsi utama na.locf.defaultmasih agak lambat karena melakukan pengecekan lagi dan menangani banyak kolom dll.
Achim Zeileis
23

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
Tony DiFranco
sumber
1
Kemampuan untuk melakukan ini secara berkelompok sungguh luar biasa!
JCWong
22

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)
}
Michele Usuelli
sumber
2
Sebuah lapply dapat ditambahkan sehingga dapat langsung menerapkannya ke beberapa kolom NA:replaceNaWithLatest <- function( dfIn, nameColsNa = names(dfIn)[1] ){ dtTest <- data.table(dfIn) invisible(lapply(nameColsNa, function(nameColNa){ 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) }
xclotet
Awalnya saya sangat senang dengan solusi ini, tetapi sebenarnya tidak melakukan hal yang sama sekali. Pertanyaannya adalah tentang mengisi 1 set data dengan yang lain. Jawaban ini hanya tuduhan.
Hack-R
19

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;
}
Brandon Bertelsen
sumber
15

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 
Nick Nassuphis
sumber
2
Fungsi ini tidak melakukan apa yang Anda harapkan ketika ada NAS terkemuka. replace_na_with_last(c(NA,1:4,NA))(Yaitu mereka diisi dengan nilai berikut). Ini juga merupakan perilaku default dari imputeTS::na.locf(x, na.remaining = "rev").
Ruben
lebih baik menambahkan default untuk kasus ini, pendekatan yang sedikit berbeda: replace_na_with_last<-function(x,p=is.na,d=0)c(d,x)[cummax(seq_along(x)*(!p(x)))+1]
Nick Nassuphis
@NickNassuphis jawaban ini pendek, manis, tidak tergantung paket, dan berfungsi baik dengan pipa dplyr!
Kim
14

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
Eldar Agalarov
sumber
Untuk memperbaikinya Anda dapat menambahkan ini: if (!anyNA(x)) return(x).
Artem Klevtsov
13

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)

AdamO
sumber
3
ini agak elegan. Tidak yakin apakah itu berfungsi dalam semua kasus tapi itu pasti berhasil untuk saya!
ABT
12

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 .

Henrik
sumber
5

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
Rtist
sumber
3

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.

stats0007
sumber
2

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;
}')
Evan Cortens
sumber
int n = x.size () dan untuk (int i = 0; i <n; i ++) harus diganti dengan dobel. Dalam R suatu vektor bisa lebih besar dari ukuran c ++ int.
stats0007
Sepertinya fungsi ini mengembalikan "R_xlen_t". Jika R dikompilasi dengan dukungan vektor yang panjang, ini didefinisikan sebagai ptrdiff_t; jika tidak, itu int. Terima kasih atas koreksinya!
Evan Cortens
1

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)]
Montgomery Clift
sumber
0

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

Abhishek Lahiri
sumber
Ini tidak berfungsi jika ada beberapa nilai yang hilang berurutan - 1 NA NAberubah menjadi 1 1 NA. Juga, saya pikir as.array()itu tidak perlu.
Gregor Thomas
0

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)
}
dmca
sumber
0
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.

Valentas
sumber
0

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)
Dimitrios Zacharatos
sumber