다음 유효 데이터 포인트가 2 개 이상의 간격으로 떨어져 있으면 0으로 R을 NAs로 채 웁니다.




replace (5)

업데이트 -

다음은 아마도 가장 간단하고 빠른 솔루션 중 하나 일 것입니다 (G. Grothendieck의 답변에 감사드립니다). NA 양면에 값이 NA 인지 단순히 알면 충분한 정보가됩니다. 따라서 dplyr 패키지의 leadlag 사용 -

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

이전 답변 (또한 빠름) -

다음은 rle 사용하고 base R에서 replace 하는 한 가지 방법입니다.이 방법은 실행중인 길이의 끝점이 아닌 모든 NA 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

업데이트 된 벤치 마크 -

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

추신 : Uwe의 리드 - 지연 (lead-lag) 답변의 기본 버전처럼 보이는 TiredSquirell의 답변을 확인해보십시오. 그러나 다소 빠릅니다 (위의 벤치 마크는 아닙니다).

NA와 함께 여러 벡터를 가지고 NA를 채우려는 의도는 유효한 데이터 포인트에서 2를 초과하는 간격을 0으로합니다. 예를 들면 다음과 같습니다.

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

기대되는 출력은,

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

다음은 "어리석은 단순한"해결책입니다.

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

na_before 및 na_after의 작성은 하나를 오른쪽으로 또는 하나를 왼쪽으로 시프트하는 것을 기반으로합니다. 이것이 어떻게 작동 하는지를 설명하기 위해, 아래의 문자들을 고려하십시오. (저는 T와 F를 구별하기 쉽도록 1과 0으로 쓰고 있습니다) :

              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

vowel_before를 만들 때 is_vowel의 "10001"시퀀스를 취하여 오른쪽으로 이동합니다 (각 문자는 이제 왼쪽에있는 문자를 나타 내기 때문입니다). 마지막 1 글자를 버리면 (F는 포함되어 있지 않기 때문에 F 앞에 모음이 있다는 것은 상관이 없습니다.) 처음에 0을 붙이십시오 (첫 글자는 앞에 글자가 없으므로, 그 앞에 모음). 동일한 논리로 vowel_after가 생성됩니다.

편집하다. (Rui Barradas에 의해 추가됨)

이 솔루션은 내 벤치 마크에 따르면 가장 빠릅니다.
함수로서 :

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
}

그리고 벤치 마크.

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 

어쩌면 간단한 솔루션이 있지만이 방법이 효과가있을 수 있습니다.

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)

완전을 기하기 위해 여기에 세 가지 다른 데이터 테이블 접근법이 있습니다.

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()

나는 그룹을 만들 수있는 올바른 방법을 찾는데 너무 집중하여 다소 늦은 직접적인 접근 방식에 대해 생각하기 시작했습니다. 규칙은 매우 간단합니다.

다른 NA에 의해 선행되고 성공한 모든 NA를 0으로 대체하십시오.

이것은 G. Grothendieck의 답변 에서처럼 zoo::rollapply() 또는 Shree의 최신 편집 에서처럼 lag()lead() 를 사용하여 수행 할 수 있습니다.

그러나, 내 자신의 벤치 마크 (여기에 게시되지 않습니다 슈리 '벤치 마크 와 중복을 피하기 위해) 보여줍니다 data.table::shift()Reduce() 지금까지 가장 빠른 방법입니다.

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

또한 lag()lead() 사용하는 것보다 약간 빠릅니다 ( is.na() 가 한 번만 호출되므로 Shree의 버전 과 다릅니다).

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

예를 들어, 값이 NA이고 양방향의 인접 값이 NA (또는 값이 첫 번째 또는 마지막 인 경우 한 방향으로) 인 경우이 값을 0으로 대체한다는 것을 의미한다고 가정합니다. 중심 회전 윈도우 길이가 3 인 경우 TR이 모두 NA이면 TRUE를 반환하고 TRUE 위치를 0으로 바꿉니다. 다음과 같은 한 줄짜리 줄을 제공합니다

library(zoo)

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




na