with - Rellene los NA en R con cero si el siguiente punto de datos válido está a más de 2 intervalos de distancia
tidyr replace na (4)
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 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)
}
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
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)