Remplir les NA dans R avec zéro si le prochain point de données valide est éloigné de plus de 2 intervalles.

Question

J'ai plusieurs vecteurs avec des NA et mon intention est de remplir les NA qui sont à plus de 2 intervalles d'un point de données valide avec 0. par exemple :

x <- c(3, 4, NA, NA, NA, 3, 3)

La sortie attendue est,

3, 4, NA, 0, NA, 3, 3

Answer 1

Mise à jour -

Voici probablement l'une des solutions les plus simples et les plus rapides (Merci à la réponse de G. Grothendieck). Il suffit de savoir si la valeur est NA de part et d'autre de tout NA est une information suffisante. Par conséquent, en utilisant lead y lag de dplyr paquet -

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

---

Réponse précédente (également rapide) -

Voici une façon d'utiliser rle y replace de la base R. Cette méthode transforme chaque NA qui n'est pas un point d'arrivée dans la longueur courante, en un fichier 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

---

Benchmarks mis à jour -

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_dplyr(x), Rui(x)) # [1] TRUE
all.equal(Shree_dplyr(x), Shree_rle(x)) # [1] TRUE
all.equal(Shree_dplyr(x), markus(x)) # [1] TRUE
all.equal(Shree_dplyr(x), Uwe1(x)) # [1] TRUE
all.equal(Shree_dplyr(x), Uwe2(x)) # [1] TRUE
all.equal(Shree_dplyr(x), Uwe_Reduce(x)) # [1] TRUE
all.equal(Shree_dplyr(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_rle(x)  51.556489  62.038875   85.348031  65.012384   81.882141  327.57514    50
 Shree_dplyr(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

PS : Jetez un coup d'œil à la réponse de TiredSquirell qui semble être une version de base de la réponse plomb-lag d'Uwe, mais qui est un peu plus rapide (non évaluée ci-dessus).

Answer 2

Il existe peut-être des solutions plus simples, mais celle-ci fonctionne.

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)

Answer 3

Voici une option de 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)
}

Answer 4

Par souci d'exhaustivité, voici trois autres approches 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() & Reduce()

J'étais tellement concentré sur la recherche de la bonne façon de créer des groupes que j'ai commencé à réfléchir à l'approche directe assez tard. La règle est assez simple :

Remplacer par zéro tous les NA qui sont précédés et suivis par un autre NA.

Cela peut être accompli en zoo::rollapply() dans le cas de La réponse de G. Grothendieck ou en utilisant lag() & lead() comme dans Le dernier montage de Shree .

Cependant, mon propre benchmark (qui n'est pas affiché ici pour éviter les doublons avec les Référence "Shree ) montre que data.table::shift() y Reduce() est la méthode la plus rapide jusqu'à présent.

  isnax <- is.na(x) 
  x[Reduce(`&`, data.table::shift(isnax, -1:1))] <- 0
  x

Il est également légèrement plus rapide que l'utilisation de lag() & lead() (veuillez noter que cela diffère de La version de Shree como is.na() n'est appelé qu'une seule fois) :

  isnax <- is.na(x) 
  x[isnax & dplyr::lag(isnax) & dplyr::lead(isnax)] <- 0
  x

Answer 5

Sur la base de l'exemple, je suppose que vous voulez dire que si la valeur est NA et que les valeurs adjacentes dans les deux directions sont NA (ou dans une direction si la valeur est la première ou la dernière), il faut remplacer la valeur par 0. En utilisant une fenêtre roulante centrée de longueur 3, il faut retourner VRAI si tout est NA et remplacer les positions VRAIES par 0.

library(zoo)

replace(x, rollapply(c(TRUE, is.na(x), TRUE), 3, all), 0)
## [1]  3  4 NA  0 NA  3  3