Заміна 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 Tb) невеликих розмірів data.frames (~ 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

... який, здається, працює. Але, чоловіче, це некрасиво! Будь-які пропозиції?

Можливо, ви хочете використовувати na.locf()функцію з пакету зоопарку, щоб перенести останнє спостереження вперед, щоб замінити ваші значення 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 

Вибачте за перекопання старого питання. Я не міг шукати функцію виконувати цю роботу в поїзді, тому написав її сам.

Я з гордістю дізнався, що це крихітний шматочок швидше.
Це менш гнучко, хоча.

Але це гарно грає 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   

Редагувати

Оскільки це стало моєю найбільш прихильною відповіддю, мені часто нагадували, що я не використовую власну функцію, бо мені часто потрібні 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).

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логіки.

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

Для вирішення більшого обсягу даних ми можемо використовувати пакет 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)
}

Вкинувши шапку:

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

Оновлення

Для числового вектора функція дещо інша:

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

Це спрацювало для мене:

  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 

Спробуйте цю функцію. Тут не потрібен пакет 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

Наявність ведучого 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)

Ви можете використовувати 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

Якщо у вас є NAкілька стовпців ...

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

... Ви можете заповнити їх за посиланням за один раз:

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

Зауважте, що:

Наразі підтримуються лише подвійні та цілі типи даних [ data.table 1.12.6].

Функціонал, швидше за все, незабаром буде розширений; див. відкритий випуск нафти, setnafill для символів, факторів та інших типів , де ви також знайдете тимчасове вирішення .

Пакет Tidyverse пропонує простий спосіб зробити це:

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

Є купа пакетів розміщення na.locf( NAостаннє спостереження вперед) функція:

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

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

Слідом за внесками Брендона Бертелсена в 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;
}')

Ось модифікація рішення @ AdamO. Цей працює швидше, тому що обходить na.omitфункцію. Це перезаписає NAзначення у вектор y(за винятком провідних 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)]

Я спробував нижче:

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

Це працювало для мене, хоча я не впевнений, чи ефективніший він, ніж інші пропозиції.

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 - це приємна концепція функціонального програмування, яка може бути корисною для подібних завдань. На жаль, у R це ~ 70 разів повільніше, ніж repeat.beforeу наведеній вище відповіді.

Я особисто використовую цю функцію. Я не знаю, наскільки це швидко чи повільно. Але вона робить свою роботу без необхідності використання бібліотек.

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

якщо ви хочете застосувати цю функцію у фреймі даних, якщо ваш кадр даних називається df, то просто

df[]<-lapply(df,replace_na_with_previous)