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




replace (4)

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

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 

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

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

기대되는 출력은,

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

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

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)

예를 들어, 값이 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

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

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