Заполнение нескольких смещенных значений NA

Question

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

> dat
   id message index
1   1    <NA>     1
2   1     foo     2
3   1     foo     3
4   1    <NA>     4
5   1     foo     5
6   1    <NA>     6
7   2    <NA>     1
8   2     baz     2
9   2    <NA>     3
10  2     baz     4
11  2     baz     5
12  2     baz     6
13  3     bar     1
14  3    <NA>     2
15  3    <NA>     3
16  3     bar     4
17  3    <NA>     5
18  3     bar     6
19  3    <NA>     7
20  3     qux     8

Моя цель - заменить значения NA, которые заключены в одно и то же «сообщение», используя первое появление сообщения (наименьшее значение index) и последнее появление сообщения (используямаксимальное index значение) по id

Иногда последовательности NA имеют длину только 1, в других случаях они могут быть очень длинными.В любом случае, все NA, которые «зажаты» между сообщениями, должны быть заполнены.

Вывод для вышеприведенной неполной таблицы будет:

 > output
   id message index
1   1    <NA>     1
2   1     foo     2
3   1     foo     3
4   1     foo     4
5   1     foo     5
6   1    <NA>     6
7   2    <NA>     1
8   2     baz     2
9   2     baz     3
10  2     baz     4
11  2     baz     5
12  2     baz     6
13  3     bar     1
14  3     bar     2
15  3     bar     3
16  3     bar     4
17  3     bar     5
18  3     bar     6
19  3    <NA>     7
20  3     qux     8

Любое указание, использующее data.tableили dplyr здесь было бы полезно, так как я даже не уверен, с чего начать.

Насколько я мог понять, было подмножество уникальных сообщений, но этот метод не учитывает id:

#get distinct messages
messages = unique(dat$message)

#remove NA
messages = messages[!is.na(messages)]

#subset dat for each message
for (i in 1:length(messages)) {print(dat[dat$message == messages[i],]) }

данные:

 dput(dat)
structure(list(id = c(1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 3, 
3, 3, 3, 3, 3, 3, 3), message = c(NA, "foo", "foo", NA, "foo", 
NA, NA, "baz", NA, "baz", "baz", "baz", "bar", NA, NA, "bar", 
NA, "bar", NA, "qux"), index = c(1, 2, 3, 4, 5, 6, 1, 2, 3, 4, 
5, 6, 1, 2, 3, 4, 5, 6, 7, 8)), row.names = c(NA, -20L), class = "data.frame")

Answer 1

Выполните na.locf0 как вперед, так и назад, и если они одинаковы, то используйте общее значение;в противном случае используйте NA.Группировка выполняется с ave.

library(zoo)

filler <- function(x) {
  forward <- na.locf0(x)
  backward <- na.locf0(x, fromLast = TRUE)
  ifelse(forward == backward, forward, NA)
}
transform(dat, message = ave(message, id, FUN = filler))

, что дает:

   id message index
1   1    <NA>     1
2   1     foo     2
3   1     foo     3
4   1     foo     4
5   1     foo     5
6   1    <NA>     6
7   2    <NA>     1
8   2     baz     2
9   2     baz     3
10  2     baz     4
11  2     baz     5
12  2     baz     6
13  3     bar     1
14  3     bar     2
15  3     bar     3
16  3     bar     4
17  3     bar     5
18  3     bar     6
19  3    <NA>     7
20  3     qux     8

Answer 2

Опция, которая использует na.approx из zoo.

Сначала мы извлекаем уникальные элементы из столбца message, которые не являются NA, и находим там позиции в dat$message

x <- unique(na.omit(dat$message))
(y <- match(dat$message, x))
# [1] NA  1  1 NA  1 NA NA  2 NA  2  2  2  3 NA NA  3 NA  3 NA  4

library(zoo)
library(dplyr)
out <- do.call(coalesce, 
               lapply(seq_along(x), function(i) as.double(na.approx(match(y, i) * i, na.rm = FALSE))))
dat$new <- x[out]
dat
#    id message index  new
#1   1    <NA>     1 <NA>
#2   1     foo     2  foo
#3   1     foo     3  foo
#4   1    <NA>     4  foo
#5   1     foo     5  foo
#6   1    <NA>     6 <NA>
#7   2    <NA>     1 <NA>
#8   2     baz     2  baz
#9   2    <NA>     3  baz
#10  2     baz     4  baz
#11  2     baz     5  baz
#12  2     baz     6  baz
#13  3     bar     1  bar
#14  3    <NA>     2  bar
#15  3    <NA>     3  bar
#16  3     bar     4  bar
#17  3    <NA>     5  bar
#18  3     bar     6  bar
#19  3    <NA>     7 <NA>
#20  3     qux     8  qux

---

tl; dr

Когда мы вызываем

match(y, 1) * 1
# [1] NA  1  1 NA  1 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA

, мы получаем элементы только там, где 1 s в y.Соответственно, когда мы делаем

match(y, 2) * 2
# [1] NA NA NA NA NA NA NA  2 NA  2  2  2 NA NA NA NA NA NA NA NA

, результат одинаков для 2 s.

Думайте о 1 и 2 как о первом и втором элементах в

x
# [1] "foo" "baz" "bar" "qux"

, то есть "foo" и "baz".

Теперь для каждого match(y, i) * i мы можем вызвать na.approx из zoo, чтобы заполнить NA s, которые находятся вмежду (i станет seq_along(x) позже).

na.approx(match(y, 2) * 2, na.rm = FALSE)
# [1] NA NA NA NA NA NA NA  2  2  2  2  2 NA NA NA NA NA NA NA NA

Мы делаем то же самое для каждого элемента в seq_along(x), то есть 1:4, используя lapply.В результате получается список

lapply(seq_along(x), function(i) as.double(na.approx(match(y, i) * i, na.rm = FALSE)))
#[[1]]
# [1] NA  1  1  1  1 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
#
#[[2]]
# [1] NA NA NA NA NA NA NA  2  2  2  2  2 NA NA NA NA NA NA NA NA
#
#[[3]]
# [1] NA NA NA NA NA NA NA NA NA NA NA NA  3  3  3  3  3  3 NA NA
#
#[[4]]
# [1] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA  4

(as.double здесь необходим, потому что иначе coalesce будет жаловаться, что "Аргумент 4 должен иметь тип double, а не integer" )

Мы почти у цели.Далее нам нужно найти первое непропущенное значение в каждой позиции. Именно здесь в игру вступает coalesce из dplyr и получается

out <- do.call(coalesce, 
               lapply(seq_along(x), function(i) as.integer(na.approx(match(y, i) * i, na.rm = FALSE))))
out
# [1] NA  1  1  1  1 NA NA  2  2  2  2  2  3  3  3  3  3  3 NA  4

Мы можем использовать этот векторизвлечь нужные значения из x как

x[out]
# [1] NA    "foo" "foo" "foo" "foo" NA    NA    "baz" "baz" "baz" "baz" "baz" "bar" "bar" "bar" "bar" "bar" "bar" NA    "qux"

Надеюсь, это поможет.

Answer 3

Еще одно решение проблемы с использованием case_when.Отредактировано, чтобы избежать заполнения после окончания серии.

library(dplyr)

dfr <- data.frame(
  index =  c(1, 2, 3, 4, 5, 6, 1, 2, 3, 4, 5, 6, 1, 2, 3, 4, 5, 6, 7, 8),
  message = c(NA, "foo", "foo", NA, "foo", NA, NA, "baz", NA, "baz", "baz", "baz", "bar", NA, NA, "bar", NA, "bar", NA, "qux"),
  id =  c(1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3)
)

dfrFilled <- dfr %>% 
  group_by(id) %>% 
  mutate(
    endSeries = max( # identify end of series
      index[message == na.omit(message)[1]],
      na.rm = T
      ),
    filledValues = case_when(
      min(index) == index ~ message,
      max(index) == index ~ message,
      index < endSeries ~ na.omit(message)[1], # fill if index is before end of series.
      TRUE ~ message
    )
  )

Answer 4

Если вы заполняете оба пути и проверяете равенство, которое должно работать, при условии, что вы учитываете группировку и индекс:

tidyverse:

library(tidyverse)

dat %>%
  arrange(id, index) %>%
  mutate(msg_down = fill(group_by(., id), message, .direction = 'down')$message,
         msg_up   = fill(group_by(., id), message, .direction = 'up')$message,
         message = case_when(!is.na(message) ~ message,
                             msg_down == msg_up ~ msg_down,
                             TRUE ~ NA_character_)) %>%
  select(-msg_down, -msg_up)

   id message index
1   1    <NA>     1
2   1     foo     2
3   1     foo     3
4   1     foo     4
5   1     foo     5
6   1    <NA>     6
7   2    <NA>     1
8   2     baz     2
9   2     baz     3
10  2     baz     4
11  2     baz     5
12  2     baz     6
13  3     bar     1
14  3     bar     2
15  3     bar     3
16  3     bar     4
17  3     bar     5
18  3     bar     6
19  3    <NA>     7
20  3     qux     8

data.table

library(data.table)
library(zoo)

setDT(dat)[order(index),
           message := ifelse(na.locf(message, na.rm = FALSE) == na.locf(message, na.rm = FALSE, fromLast = TRUE),
                             na.locf(message, na.rm = FALSE),
                             NA),
           by = "id"][]

    id message index
 1:  1    <NA>     1
 2:  1     foo     2
 3:  1     foo     3
 4:  1     foo     4
 5:  1     foo     5
 6:  1    <NA>     6
 7:  2    <NA>     1
 8:  2     baz     2
 9:  2     baz     3
10:  2     baz     4
11:  2     baz     5
12:  2     baz     6
13:  3     bar     1
14:  3     bar     2
15:  3     bar     3
16:  3     bar     4
17:  3     bar     5
18:  3     bar     6
19:  3    <NA>     7
20:  3     qux     8

Answer 5

Вот подход без группировки, чтобы заполнить значения и затем заменить обратно на NA, если они были заполнены неправильно.

tidyr::fill по умолчанию заполняет пропущенные значения предыдущим значением, поэтому оно переполняет некоторыеценности.К сожалению, это не относится к группировке, поэтому мы должны использовать условие if_else для исправления ошибок.

Сначала мы фиксируем исходные местоположения пропущенных значений и вычисляем максимальное и минимальное значения index для каждого * 1009.* и message.После заполнения мы присоединяемся к этим index границам.Если совпадений нет, то id изменилось;если есть совпадение, либо это была правильная замена, либо index выходит за границы.Поэтому мы проверяем местоположения с исходными пропущенными значениями для этих условий и заменяем их на NA, если они выполняются.

РЕДАКТИРОВАТЬ: это может быть повреждено на другом входе, пытаясь исправить

library(tidyverse)
dat <- structure(list(id = c(1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3), message = c(NA, "foo", "foo", NA, "foo", NA, NA, "baz", NA, "baz", "baz", "baz", "bar", NA, NA, "bar", NA, "bar", NA, "qux"), index = c(1, 2, 3, 4, 5, 6, 1, 2, 3, 4, 5, 6, 1, 2, 3, 4, 5, 6, 7, 8)), row.names = c(NA, -20L), class = "data.frame")

indices <- dat %>%
  group_by(id, message) %>%
  summarise(min = min(index), max = max(index)) %>%
  drop_na

dat %>%
  mutate(orig_na = is.na(message)) %>%
  fill(message) %>%
  left_join(indices, by = c("id", "message")) %>% 
  mutate(
    message = if_else(
      condition = orig_na &
        (index < min | index > max | is.na(min)),
      true = NA_character_,
      false = message
    )
  )
#>    id message index orig_na min max
#> 1   1    <NA>     1    TRUE  NA  NA
#> 2   1     foo     2   FALSE   2   5
#> 3   1     foo     3   FALSE   2   5
#> 4   1     foo     4    TRUE   2   5
#> 5   1     foo     5   FALSE   2   5
#> 6   1    <NA>     6    TRUE   2   5
#> 7   2    <NA>     1    TRUE  NA  NA
#> 8   2     baz     2   FALSE   2   6
#> 9   2     baz     3    TRUE   2   6
#> 10  2     baz     4   FALSE   2   6
#> 11  2     baz     5   FALSE   2   6
#> 12  2     baz     6   FALSE   2   6
#> 13  3     bar     1   FALSE   1   6
#> 14  3     bar     2    TRUE   1   6
#> 15  3     bar     3    TRUE   1   6
#> 16  3     bar     4   FALSE   1   6
#> 17  3     bar     5    TRUE   1   6
#> 18  3     bar     6   FALSE   1   6
#> 19  3    <NA>     7    TRUE   1   6
#> 20  3     qux     8   FALSE   8   8

^{Создан в 2019-02-15 пакетом Представить (v0.2.1)}