superponer - Reemplazo de NA con el último valor no NA
superponer graficas en r (13)
Aquí hay una modificación de la solución @ AdamO. Este corre más rápido, porque evita la función na.omit . Esto sobrescribirá los valores de NA en el vector y (a excepción de las NA principales).
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)]
En un data.frame (o data.table), me gustaría "completar" las NA con el valor previo no NA más cercano. Un ejemplo simple, usando vectores (en lugar de un data.frame ) es el siguiente:
> y <- c(NA, 2, 2, NA, NA, 3, NA, 4, NA, NA)
Me gustaría una función fill.NAs() que me permita construir yy tal que:
> yy
[1] NA NA NA 2 2 2 2 3 3 3 4 4
Necesito repetir esta operación para muchos (totales ~ 1 Tb) data.frame tamaño pequeño (~ 30-50 Mb), donde una fila es NA son todas sus entradas. ¿Cuál es una buena manera de abordar el problema?
La fea solución que preparé usa esta función:
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 función fill.NAs se usa de la siguiente manera:
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]
}
Salida
> y
[1] NA 2 2 2 2 3 3 3 4 4 4
... que parece funcionar Pero, hombre, ¿es feo? ¿Alguna sugerencia?
Arrojando mi sombrero en:
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;
}'')
Configure una muestra básica y un punto de referencia:
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)
}
Y ejecuta algunos puntos de referencia:
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
Por si acaso:
all.equal(
na_locf(x),
replace_na_with_last(x),
na.lomf(x),
na.locf(x),
repeat.before(x)
)
[1] TRUE
Actualizar
Para un vector numérico, la función es un poco diferente:
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;
}
Esto funcionó para mí, aunque no estoy seguro de si es más eficiente que otras sugerencias.
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)
}
Esto me ha funcionado:
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 velocidad es razonable también:
> system.time(replace_na_with_last(sample(c(1,2,3,NA),1e6,replace=TRUE)))
user system elapsed
0.072 0.000 0.071
Hay una gran cantidad de paquetes que ofrecen funciones na.locf (NA última observación llevada adelante):
- xts - xts :: na.locf
- zoo - zoo :: na.locf
- imputeTS - imputeTS :: na.locf
- espacio-tiempo - espacio-tiempo :: na.locf
Y también otros paquetes donde esta función recibe un nombre diferente.
Intenté lo siguiente:
nullIdx <- as.array(which(is.na(masterData$RequiredColumn)))
masterData$RequiredColumn[nullIdx] = masterData$RequiredColumn[nullIdx-1]
nullIdx obtiene el número idx donde masterData $ RequiredColumn tiene un valor Null / NA. En la línea siguiente, lo reemplazamos con el correspondiente valor Idx-1, es decir, el último valor bueno antes de cada NULL / NA
Perdón por desenterrar una vieja pregunta. No pude buscar la función para hacer este trabajo en el tren, así que escribí uno yo mismo.
Estaba orgulloso de descubrir que es un poco más rápido.
Sin embargo, es menos flexible.
Pero juega bien con ave , que es lo que necesitaba.
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
Editar
Como esta se convirtió en mi respuesta más votada, a menudo me acordaban de que no uso mi propia función, porque a menudo necesito el argumento maxgap del zoo. Debido a que el zoológico tiene algunos problemas extraños en los casos extremos cuando uso dplyr + fechas que no pude depurar, volví a esto hoy para mejorar mi función anterior.
Analicé mi función mejorada y todas las demás entradas aquí. Para el conjunto básico de características, tidyr::fill es más rápido y no falla en los casos tidyr::fill . La entrada de Rcpp por @BrandonBertelsen es aún más rápida, pero es inflexible con respecto al tipo de entrada (que probó los casos de borde incorrectamente debido a un malentendido de all.equal ).
Si necesita maxgap , mi función a continuación es más rápida que zoo (y no tiene los problemas extraños con las fechas).
Puse la documentación de mis pruebas .
nueva función
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
}
También puse la función en mi paquete formr (solo Github).
Probablemente desee utilizar la función na.locf() del paquete del zoo para llevar adelante la última observación y reemplazar sus valores NA.
Aquí está el comienzo de su ejemplo de uso de la página de ayuda:
> 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
Prueba esta función. No requiere el paquete 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)
}
}
Ejemplo:
> # 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
Seguimiento de las contribuciones de Rcpp de Brandon Bertelsen. Para mí, la versión de NumericVector no funcionó: solo reemplazó la primera NA. Esto se debe a que el vector ina solo se evalúa una vez, al comienzo de la función.
En cambio, uno puede tomar el mismo enfoque que para la función IntegerVector. Lo siguiente funcionó para mí:
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;
}'')
En caso de que necesite una versión de CharacterVector, el mismo enfoque básico también funciona:
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;
}'')
Tener una NA líder es un poco problemático, pero encuentro una manera muy legible (y vectorizada) de hacer LOCF cuando el término principal no falta es:
na.omit(y)[cumsum(!is.na(y))]
Una modificación ligeramente menos legible funciona en general:
c(NA, na.omit(y))[cumsum(!is.na(y))+1]
da el resultado deseado:
c(NA, 2, 2, 2, 2, 3, 3, 4, 4, 4)
Tratando con un gran volumen de datos, para ser más eficientes, podemos usar el paquete 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)
}
una solución 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
este enfoque también podría funcionar con ceros de llenado hacia adelante:
> 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
este método se vuelve muy útil en los datos a escala y en los que le gustaría realizar un reenvío por grupo (s), lo cual es trivial con data.table . simplemente agregue el grupo (s) a la cláusula by antes de la lógica cumsum .