Замена NA с последним значением, отличным от NA

В data.frame(или data.table), я хотел бы "заполнить" NA с ближайшим предыдущим значением, отличным от NA. Простым примером использования векторов (вместо data.frame) является следующее:

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

Мне нужна функция fill.NAs(), которая позволяет мне построить yy такую, что:

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

Мне нужно повторить эту операцию для многих (всего ~ 1 Тб) малогабаритных data.frame (~ 30-50 Мб), где строка NA - это все ее записи. Каков хороший способ подойти к проблеме?

Уродливое решение, которое я приготовил, использует эту функцию:

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
}

Функция fill.NAs используется следующим образом:

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

Выход

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

... который, похоже, работает. Но, мужик, это уродливо! Любые предложения?

+126
источник поделиться
16 ответов

Возможно, вы захотите использовать функцию na.locf() из пакета zoo, чтобы перенести последнее наблюдение вперед для замены ваших значений NA.

Вот пример его использования на странице справки:

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 
+142
источник

Извините, что выкалываете старый вопрос. Я не мог найти функцию, чтобы выполнить эту работу в поезде, поэтому я написал ее сам.

Я с гордостью узнал, что это немного быстрее.
Он менее гибкий, хотя.

Но он отлично работает с ave, что мне и нужно.

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   

Изменить

Поскольку это стало моим самым лучшим ответом, мне часто напоминалось, что я не использую свою собственную функцию, потому что мне часто нужен аргумент zoo maxgap. Поскольку у зоопарка есть некоторые странные проблемы в крайних случаях, когда я использую dplyr + даты, которые я не мог отлаживать, я вернулся к этому сегодня, чтобы улучшить свою старую функцию.

Я сравнивал мою улучшенную функцию и все остальные записи здесь. Для базового набора функций tidyr::fill является самым быстрым, а также не прерывает случаи кросс. Запись Rcpp от @BrandonBertelsen еще быстрее, но она негибкая относительно типа ввода (он неправильно проверял случаи кросс-памяти из-за непонимания all.equal).

Если вам нужна maxgap, моя функция ниже, чем зоопарк (и не имеет странных проблем с датами).

Я разместил документацию моих тестов.

новая функция

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
}

Я также добавил функцию в свой пакет formr (только Github).

+57
источник
другие ответы

Связанные вопросы


Похожие вопросы

Для работы с большим объемом данных, чтобы быть более эффективным, мы можем использовать пакет 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)
}
+22
источник

Бросок моей шляпы в:

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

Настройте базовый образец и контрольный показатель:

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

И запустите несколько тестов:

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

На всякий случай:

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

Update

Для числового вектора функция немного отличается:

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;
}
+18
источник

Попробуйте эту функцию. Для него не требуется пакет 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)
    }
}

Пример:

> # 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
+14
источник

Это сработало для меня:

  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"

скорость тоже разумная:

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


 user  system elapsed 

 0.072   0.000   0.071 
+13
источник

a 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

этот подход мог бы работать и с первыми заполняющими нулями:

> 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

этот метод становится очень полезным для данных в масштабе и где вы хотите выполнить форвардную заливку по группам (-ам), что тривиально с data.table. просто добавьте группу в предложение by до логики cumsum.

+13
источник

Наличие начального NA немного морщится, но я нахожу очень удобочитаемый (и векторизованный) способ выполнения LOCF, когда основной термин не пропущен:

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

Немного менее читаемая модификация работает в общем:

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

дает желаемый результат:

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

+8
источник

Вы можете использовать функцию data.table nafill, доступную из data.table >= 1.12.3.

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

Если ваш вектор является столбцом в data.table, вы также можете обновить его по ссылке с помощью 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
+6
источник

Продолжение вкладов Брэндона Бертельсена Rcpp. Для меня версия NumericVector не работала: она заменила только первое NA. Это связано с тем, что вектор ina оценивается только один раз, в начале функции.

Вместо этого можно использовать тот же подход, что и для функции IntegerVector. Для меня работали следующие:

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

Если вам нужна версия CharacterVector, также работает тот же базовый подход:

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;
}')
+2
источник

Существует множество пакетов, предлагающих функции na.locf (NA Last Observation Carried Forward):

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

А также другие пакеты, где эта функция названа по-другому.

+1
источник

Я попробовал следующее:

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

nullIdx получает номер idx, где когда-либо masterData $RequiredColumn имеет значение Null/NA. В следующей строке мы заменим его соответствующим значением Idx-1, то есть последним хорошим значением перед каждым значением NULL/NA

0
источник

Это сработало для меня, хотя я не уверен, что он более эффективен, чем другие предложения.

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)
}
0
источник

Вот модификация решения @AdamO. Этот работает быстрее, потому что он обходит функцию na.omit. Это перезапишет значения NA в векторе y (за исключением ведущих NA).

   z  <- !is.na(y)                  # indicates the positions of y whose values we do not want to overwrite
   z  <- z | !cumsum(z)             # for leading NA 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)]
0
источник

Используя ave, можно разделить вектор на разные группы с помощью cumsum(!is.na(x)). Каждая группа будет состоять из предшествующих значений non- NA и последующих последовательных значений NA. Затем для каждой группы мы можем принять последнее значение non- NA.

Если есть ведущий NA, это может быть решено с pmax

fill = function(x){
    ave(x, cumsum(!is.na(x)), FUN = function(y) y[pmax(1, cumsum(!is.na(y)))])
}
fill(y)
# [1] NA  2  2  2  2  3  3  4  4  4
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 - это хорошая концепция функционального программирования, которая может быть полезна для подобных задач. К сожалению, в R это примерно в 70 раз медленнее, чем repeat.before в приведенном выше ответе.

0
источник

Посмотрите другие вопросы по меткам или Задайте вопрос