Remplacement des NA par la dernière valeur non NA
Dans un data.frame (ou data.table), je voudrais "compléter en avant" les NA avec la valeur non-NA précédente la plus proche. Voici un exemple simple d'utilisation de vecteurs (au lieu d'un data.frame):
> y <- c(NA, 2, 2, NA, NA, 3, NA, 4, NA, NA)
Je voudrais une fonction fill.NAs() qui me permette de construire yy telle que:
> yy
[1] NA NA NA 2 2 2 2 3 3 3 4 4
Je dois répéter cette opération pour de nombreux data.frames de petite taille (environ 1 To) (environ 30 à 50 Mo), où une ligne correspond à NA et toutes ses entrées. Quelle est une bonne façon d’aborder le problème?
La solution laide que j'ai concoctée utilise cette fonction:
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
}
La fonction fill.NAs s'utilise comme suit:
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]
}
Sortie
> y
[1] NA 2 2 2 2 3 3 3 4 4 4
... qui semble fonctionner. Mais, mec, c'est moche! Aucune suggestion?
Vous voudrez probablement utiliser la fonction na.locf() de Zoo package pour reporter la dernière observation en remplacement de vos valeurs NA.
Voici le début de son exemple d'utilisation à partir de la page d'aide:
> example(na.locf)
na.lcf> az <- Zoo(1:6)
na.lcf> bz <- Zoo(c(2,NA,1,4,5,2))
na.lcf> na.locf(bz)
1 2 3 4 5 6
2 2 1 4 5 2
na.lcf> na.locf(bz, fromLast = TRUE)
1 2 3 4 5 6
2 1 1 4 5 2
na.lcf> cz <- Zoo(c(NA,9,3,2,3,2))
na.lcf> na.locf(cz)
2 3 4 5 6
9 3 2 3 2
Désolé de creuser une vieille question. Je ne pouvais pas regarder la fonction pour faire ce travail dans le train, alors j'en ai écrit un moi-même.
J'étais fier de découvrir que c'était un peu plus rapide.
C'est moins flexible cependant.
Mais il joue bien avec ave, ce dont j'avais besoin.
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
Modifier
Comme cela est devenu ma réponse la plus votée, on m'a souvent rappelé que je n'utilisais pas ma propre fonction, car j'avais souvent besoin de l'argument maxgap de Zoo. Parce que Zoo rencontre des problèmes étranges dans les cas Edge lorsque j'utilise dplyr + des dates que je ne pouvais pas déboguer, je suis revenu à cela aujourd'hui pour améliorer mon ancienne fonction.
J'ai comparé ma fonction améliorée et toutes les autres entrées ici. tidyr::fill est le plus rapide sans pour autant nuire aux cas Edge. L'entrée Rcpp de @BrandonBertelsen est encore plus rapide, mais elle est inflexible quant au type de l'entrée (il a testé de manière incorrecte les cas Edge en raison d'un malentendu de all.equal).
Si vous avez besoin de maxgap, ma fonction ci-dessous est plus rapide que Zoo (et n'a pas les problèmes étranges avec les dates).
Je mets en place la documentation de mes tests .
nouvelle fonction
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
}
J'ai aussi mis la fonction dans mon paquet formr (Github uniquement).
Pour faire face à un gros volume de données, pour être plus efficace, nous pouvons utiliser le package 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)
}
Jeter mon chapeau dans:
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;
}')
Configurez un échantillon de base et un repère:
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)
}
Et lancez quelques repères:
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
Au cas où:
all.equal(
na_locf(x),
replace_na_with_last(x),
na.lomf(x),
na.locf(x),
repeat.before(x)
)
[1] TRUE
Mettre à jour
Pour un vecteur numérique, la fonction est un peu différente:
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;
}
Cela a fonctionné pour moi:
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"
la vitesse est raisonnable aussi:
> system.time(replace_na_with_last(sample(c(1,2,3,NA),1e6,replace=TRUE)))
user system elapsed
0.072 0.000 0.071
Essayez cette fonction. Il ne nécessite pas le paquet 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)
}
}
Exemple:
> # 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
une solution 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
cette approche pourrait également fonctionner avec des zéros de remplissage en aval:
> 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
cette méthode devient très utile pour les données à l'échelle et pour lesquelles vous souhaitez effectuer un remplissage avant par groupe (s), ce qui est trivial avec data.table. ajoutez simplement le ou les groupes à la clause by avant la logique cumsum.
Vous pouvez utiliser la fonction data.tablenafill, disponible dans la version de développement 1.12.3 :
library(data.table)
nafill(y, type = "locf")
# [1] NA 2 2 2 2 3 3 4 4 4
Si votre vecteur est une colonne dans un data.table, vous pouvez également le mettre à jour par référence avec 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
Suivi des contributions Rcpp de Brandon Bertelsen. Pour moi, la version NumericVector ne fonctionnait pas: elle remplaçait seulement le premier NA. En effet, le vecteur ina n’est évalué qu’une fois, au début de la fonction.
Au lieu de cela, on peut adopter exactement la même approche que pour la fonction IntegerVector. Ce qui suit a fonctionné pour moi:
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;
}')
Si vous avez besoin d'une version de CharacterVector, la même approche de base fonctionne également:
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;
}')
Il y a beaucoup de paquets offrant les fonctions na.locf (NA Dernière observation reportée):
xts-xts::na.locfZoo-Zoo::na.locfimputeTS-imputeTS::na.locfspacetime-spacetime::na.locf
Et aussi d'autres paquets où cette fonction est nommée différemment.
Voici une modification de la solution de @ AdamO. Celui-ci est plus rapide, car il contourne la fonction na.omit. Cela écrasera les valeurs NA dans le vecteur y (à l'exception de NAs en tête).
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)]
J'ai essayé le ci-dessous:
nullIdx <- as.array(which(is.na(masterData$RequiredColumn)))
masterData$RequiredColumn[nullIdx] = masterData$RequiredColumn[nullIdx-1]
nullIdx obtient le numéro idx si jamais masterData $ RequiredColumn a une valeur Null/NA . À la ligne suivante, nous la remplaçons par la valeur Idx-1 correspondante, c'est-à-dire la dernière valeur correcte avant chaque NULL/NA.
Cela a fonctionné pour moi, même si je ne suis pas sûr que ce soit plus efficace que d'autres suggestions.
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
Réduire est un concept de programmation fonctionnelle de Nice qui peut être utile pour des tâches similaires. Malheureusement, dans R, il est environ 70 fois plus lent que repeat.before dans la réponse ci-dessus.