В data.frame (или data.table) я хотел бы «заполнить вперед» NA ближайшим предыдущим значением, отличным от NA. Вот простой пример использования векторов (вместо a 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
... что, кажется, работает. Но, чувак, это некрасиво! Какие-либо предложения?
r
data.table
zoo
r-faq
Ryogi
источник
источник
roll=TRUE
вdata.table
.fill
вR
tidyr::fill()
.Ответы:
Вероятно, вы захотите использовать
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
источник
na.locf
в зоопарке работает как с обычными векторами, так и с объектами зоопарка. Егоna.rm
аргумент может быть полезен в некоторых приложениях.na.locf(cz, na.rm=FALSE)
чтобы продолжать вестиNA
.Извините, что раскопал старый вопрос. Я не мог найти функцию для выполнения этой работы в поезде, поэтому написал ее сам.
Я был горд узнать, что это немного быстрее.
Хотя это менее гибко.
Но он отлично сочетается с тем
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
аргумент зоопарка . Поскольку у zoo есть некоторые странные проблемы в крайних случаях, когда я использую даты 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).
источник
df
с несколькими столбцами?na.locf0
которая теперь аналогична по объему и производительности вашейrepeat_last
функции. Подсказка заключалась в том, чтобы использовать,diff
а неcumsum
избегатьifelse
. Основнаяna.locf.default
функция по-прежнему работает несколько медленнее, потому что она выполняет еще несколько проверок и обрабатывает несколько столбцов и т. Д.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) }
источник
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) }
Забрасываю шляпу:
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
источник
replace_na_with_last(c(NA,1:4,NA))
(т.е. они заполнены следующим значением). Это также поведение по умолчаниюimputeTS::na.locf(x, na.remaining = "rev")
.replace_na_with_last<-function(x,p=is.na,d=0)c(d,x)[cummax(seq_along(x)*(!p(x)))+1]
Попробуйте эту функцию. Не требует пакета 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
источник
if (!anyNA(x)) return(x)
.Вы можете использовать
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
Обратите внимание, что:
Скорее всего, скоро функциональность будет расширена; см. открытую проблему nafill, setnafill для символов, факторов и других типов , где вы также найдете временное решение .
источник
Наличие интерлиньяжа
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)
источник
Пакет 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
Last Observation Carried Forward):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; }')
источник
Я хочу добавить следующее решение, использующее
runner
пакет r Cran.library(runner) y <- c(NA, 2, 2, NA, NA, 3, NA, 4, NA, NA) fill_run(y, FALSE) [1] NA 2 2 2 2 3 3 4 4 4
Весь пакет оптимизирован и большая часть написана на cpp. Таким образом предлагают большую эффективность.
источник
Вот модификация решения @ AdamO. Этот работает быстрее, потому что он обходит
na.omit
функцию. Это перезапишетNA
значения в вектореy
(кроме ведущихNA
s).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)]
источник
Я лично использую эту функцию. Я не знаю, насколько это быстро или медленно. Но он выполняет свою работу без использования библиотек.
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, просто
источник
Я пробовал следующее:
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.
источник
1 NA NA
превращается в1 1 NA
. Кроме того, я думаю, что вas.array()
этом нет необходимости.Это сработало для меня, хотя я не уверен, что это более эффективно, чем другие предложения.
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
в приведенном выше ответе.источник