Заполните NA в R нулем, если следующая действительная точка данных находится на расстоянии более 2 интервалов - PullRequest
Новая
       18

Заполните NA в R нулем, если следующая действительная точка данных находится на расстоянии более 2 интервалов

13 голосов
/ 20 июня 2019

У меня есть несколько векторов с NA, и я намерен заполнить NA, которые находятся более чем в 2 интервалах от действительной точки данных, например, 0. 

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

Ожидаемый результат: 

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

Ответы [ 6 ]

13 голосов
/ 20 июня 2019

Обновление -

Вот, пожалуй, одно из самых простых и быстрых решений (благодаря ответу Г. Гротендика). Достаточно просто знать, является ли значение NA с любой стороны от любого NA. Поэтому, используя lead и lag из пакета 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

Предыдущий ответ (также быстрый) -

Вот один из способов использования rle и replace от базы R. Этот метод превращает каждый 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_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: Ознакомьтесь с ответом TiredSquirell, который выглядит как базовая версия ответа Уэва с опозданием, но несколько быстрее (не тестировался выше).

8 голосов
/ 20 июня 2019

Для полноты картины можно привести три других подхода к данным: 

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.

Это может быть достигнуто с помощью zoo::rollapply(), как в G.Ответ Гротендика или с использованием lag() & lead(), как в Последнее редактирование Шри .

Однако, мой собственный тест (здесь не публикуется, чтобы избежать дублирования с Шри'benchmark ) показывает, что data.table::shift() и Reduce() является самым быстрым на сегодняшний день методом. 

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

Это также немного быстрее, чем использование lag() & lead() (пожалуйста, обратите внимание, чтоэто отличается от версии Шри , так как is.na() вызывается только один раз): 

  isnax <- is.na(x) 
  x[isnax & dplyr::lag(isnax) & dplyr::lead(isnax)] <- 0
  x
8 голосов
/ 20 июня 2019

Вот опция 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)
}
8 голосов
/ 20 июня 2019

Возможно, есть более простые решения, но это работает. 

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)
6 голосов
/ 20 июня 2019

Исходя из примера, я предполагаю, что вы имеете в виду, что если значение равно NA, а смежные значения в обоих направлениях равны NA (или в одном направлении, если значение является первым или последним), то замените значение на 0. ИспользуяСкользящее окно по центру длины 3 возвращает TRUE, если все это NA, и затем заменяет TRUE на 0. Это дает следующий однострочный 

library(zoo)

replace(x, rollapply(c(TRUE, is.na(x), TRUE), 3, all), 0)
## [1]  3  4 NA  0 NA  3  3
5 голосов
/ 21 июня 2019

Вот «тупо простое» решение: 

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, вы берете «10001»последовательность is_vowel и сдвиньте ее вправо (потому что каждая буква теперь ссылается на букву слева).Вы отбрасываете последнюю 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
...