sintaxis - replace values in r
Rellene los NA en R con cero si el siguiente punto de datos válido está a más de 2 intervalos de distancia (6)
Aquí hay una opción data.table
library(data.table)
na0_dt <- function(x){
replace(x, rowid(r <- rleid(xna <- is.na(x))) > 1 & rev(rowid(rev(r))) > 1 & xna, 0)
}
Tengo varios vectores con NA y mi intención de rellenar NA, que son más de 2 intervalos desde un punto de datos válido con 0. por ejemplo:
x <- c(3, 4, NA, NA, NA, 3, 3)
La salida esperada es,
3, 4, NA, 0, NA, 3, 3
Aquí hay una solución "estúpidamente simple":
is_na <- is.na(x) # Vector telling you whether each position in x is NA
na_before <- c(F,is_na[1:(length(x)-1)]) # Whether each position has an NA before it
na_after <- c(is_na[2:length(x),F) # Whether each position has an NA after it
x[is_na & na_before & na_after] <- 0 # Set to 0 if all three are true
La creación de na_before y na_after se basa en desplazar uno a la derecha o uno a la izquierda. Para ilustrar cómo funciona esto, considere las letras a continuación (estoy escribiendo T y F como 1 y 0 para que sean más fáciles de distinguir):
A B C D E is_vowel 1 0 0 0 1 vowel_before 0 1 0 0 0 vowel_after 0 0 0 1 0
Cuando hagas vocal_ antes, tome la secuencia "10001" de is_vowel y gírela una a la derecha (porque cada letra ahora se refiere a la letra a su izquierda). Elimina el último 1 (no le importa que F tenga una vocal antes, porque F no está incluida) y agrega un 0 al principio (la primera letra no tiene ninguna letra antes y, por lo tanto, no puede tener una vocal delante de ella). vowel_after se crea con la misma lógica.
Editar. (Agregado por Rui Barradas)
Esta solución es, según mi punto de referencia, la más rápida.
Como una función:
TiredSquirrel <- function(x){
is_na <- is.na(x)
na_before <- c(FALSE, is_na[1:(length(x) - 1)])
na_after <- c(is_na[2:length(x)], FALSE)
x[is_na & na_before & na_after] <- 0
x
}
Y el punto de referencia.
x <- c(3, 4, NA, NA, NA, 3, 3)
r <- na2zero(x)
all.equal(r, TiredSquirrel(x))
#[1] TRUE
x <- sample(x, 1e3, TRUE)
r <- na2zero(x)
all.equal(r, TiredSquirrel(x))
#[1] TRUE
microbenchmark(
Rui = na2zero(x),
Uwe_Reduce = Uwe_Reduce(x),
TiredSquirrel = TiredSquirrel(x)
)
#Unit: microseconds
# expr min lq mean median uq max neval cld
# Rui 3134.293 3198.8180 3365.70736 3263.7980 3391.7900 5593.111 100 b
# Uwe_Reduce 99.895 104.3510 125.81417 113.9995 146.7335 244.280 100 a
# TiredSquirrel 65.205 67.4365 72.41129 70.6430 75.8315 122.061 100 a
Basado en el ejemplo, asumo que lo que quiere decir es que si el valor es NA y los valores adyacentes en ambas direcciones son NA (o en una dirección si el valor es el primero o el último), entonces reemplace el valor por 0. Usando una ventana de selección centrada de longitud 3, devuelva VERDADERO si es todo NA y luego reemplace las posiciones VERDADERAS con 0. Esto da lo siguiente de una sola línea
library(zoo)
replace(x, rollapply(c(TRUE, is.na(x), TRUE), 3, all), 0)
## [1] 3 4 NA 0 NA 3 3
En aras de la integridad, aquí hay otros tres enfoques de data.table:
x <- c(3, 4, NA, NA, NA, 3, 3, NA, NA, 1, NA, 0, 0, rep(NA, 4L))
library(data.table)
data.table(x)[, x := replace(x, which(is.na(x))[-c(1L, .N)], 0), by =.(rleid(is.na(x)))]$x
[1] 3 4 NA 0 NA 3 3 NA NA 1 NA 0 0 NA 0 0 NA
x[data.table(x)[, .I[is.na(x)][-c(1L, .N)], by =.(rleid(is.na(x)))]$V1] <- 0
x
[1] 3 4 NA 0 NA 3 3 NA NA 1 NA 0 0 NA 0 0 NA
shift()
y
Reduce()
Estaba tan concentrado en encontrar la manera correcta de crear grupos que comencé a pensar en el enfoque directo más bien tarde. La regla es bastante simple:
Reemplace todas las NA por cero, las cuales son precedidas y seguidas por otra NA.
Esto se puede lograr con
zoo::rollapply()
como en
la respuesta de G. Grothendieck
o usando
lag()
y
lead()
como en
la última edición de Shree
.
Sin embargo, mi propio punto de referencia (no publicado aquí para evitar la duplicación con
el punto de referencia de Shree
) muestra que
data.table::shift()
y
Reduce()
es el método más rápido hasta el momento.
isnax <- is.na(x)
x[Reduce(`&`, data.table::shift(isnax, -1:1))] <- 0
x
También es un poco más rápido que usar
lag()
y
lead()
(tenga en cuenta que esto difiere de
la versión
de
Shree,
ya que
is.na()
solo se llama una vez):
isnax <- is.na(x)
x[isnax & dplyr::lag(isnax) & dplyr::lead(isnax)] <- 0
x
Tal vez hay soluciones más simples pero esta funciona.
na2zero <- function(x){
ave(x, cumsum(abs(c(0, diff(is.na(x))))), FUN = function(y){
if(anyNA(y)){
if(length(y) > 2) y[-c(1, length(y))] <- 0
}
y
})
}
na2zero(x)
#[1] 3 4 NA 0 NA 3 3
X <- list(x, c(x, x), c(3, 4, NA, NA, NA, NA, 3, 3))
lapply(X, na2zero)
Actualización -
Aquí es probablemente una de las soluciones más simples y rápidas (gracias a la respuesta de G. Grothendieck).
El simple hecho de saber si el valor es
NA
en cualquier lado de cualquier
NA
es información suficiente.
Por lo tanto, usando
lead
y
lag
del paquete
dplyr
-
na2zero <- function(x) {
x[is.na(lag(x, 1, 0)) & is.na(lead(x, 1, 0)) & is.na(x)] <- 0
x
}
na2zero(x = c(3, 4, NA, NA, NA, 3, 3))
[1] 3 4 NA 0 NA 3 3
na2zero(x = c(3, 4, NA, NA, NA, NA, NA, 3, 3))
[1] 3 4 NA 0 0 0 NA 3 3
na2zero(x = c(3, 4, NA, NA, NA, 3, 3, NA, NA, 1, NA, 0, 0, rep(NA, 4L)))
[1] 3 4 NA 0 NA 3 3 NA NA 1 NA 0 0 NA 0 0 NA
Respuesta anterior (también rápida) -
Aquí hay una forma de usar
rle
y
replace
desde la base R. Este método convierte cada
NA
, que no es un punto final en la longitud de ejecución, en un
0
-
na2zero <- function(x) {
run_lengths <- rle(is.na(x))$lengths
replace(x,
sequence(run_lengths) != 1 &
sequence(run_lengths) != rep(run_lengths, run_lengths) &
is.na(x),
0)
}
na2zero(x = c(3, 4, NA, NA, NA, 3, 3))
[1] 3 4 NA 0 NA 3 3
na2zero(x = c(3, 4, NA, NA, NA, NA, NA, 3, 3))
[1] 3 4 NA 0 0 0 NA 3 3
Puntos de referencia actualizados -
set.seed(2)
x <- c(3, 4, NA, NA, NA, 3, 3)
x <- sample(x, 1e5, T)
microbenchmark(
Rui(x),
Shree_old(x), Shree_new(x),
markus(x),
IceCreamT(x),
Uwe1(x), Uwe2(x), Uwe_Reduce(x),
Grothendieck(x),
times = 50
)
all.equal(Shree_new(x), Rui(x)) # [1] TRUE
all.equal(Shree_new(x), Shree_old(x)) # [1] TRUE
all.equal(Shree_new(x), markus(x)) # [1] TRUE
all.equal(Shree_new(x), Uwe1(x)) # [1] TRUE
all.equal(Shree_new(x), Uwe2(x)) # [1] TRUE
all.equal(Shree_new(x), Uwe_Reduce(x)) # [1] TRUE
all.equal(Shree_new(x), Grothendieck(x)) # [1] TRUE
Unit: milliseconds
expr min lq mean median uq max neval
Rui(x) 286.026540 307.586604 342.620266 318.404731 363.844258 518.03330 50
Shree_old(x) 51.556489 62.038875 85.348031 65.012384 81.882141 327.57514 50
Shree_new(x) 3.996918 4.258248 17.210709 6.298946 10.335142 207.14732 50
markus(x) 853.513854 885.419719 1001.450726 919.930389 1018.353847 1642.25435 50
IceCreamT(x) 12.162079 13.773873 22.555446 15.021700 21.271498 199.08993 50
Uwe1(x) 162.536980 183.566490 225.801038 196.882049 269.020395 439.17737 50
Uwe2(x) 83.582360 93.136277 115.608342 99.165997 115.376903 309.67290 50
Uwe_Reduce(x) 1.732195 1.871940 4.215195 2.016815 4.842883 25.91542 50
Grothendieck(x) 620.814291 688.107779 767.749387 746.699435 850.442643 982.49094 50
PD: verifique la respuesta de TiredSquirell, que parece ser una versión base de la respuesta de Uwe, pero es algo más rápida (no comparada anteriormente).