当最后一个和下一个非 NA 值相等时替换 NA答案

【问题标题】：Replace NA when last and next non-NA values are equal当最后一个和下一个非 NA 值相等时替换 NA
【发布时间】：2019-02-15 22:28:24
【问题描述】：

我有一个示例表，其中包含一些但不是所有需要替换的 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

我的目标是使用第一次出现的消息（最少的index 值）和最后一次出现的消息替换由相同“消息”包围的NA 值消息（使用最大 index 值）按 id

有时，NA 序列的长度仅为 1，有时它们可能很长。无论如何，应该填写所有“夹在”NA 前后相同“消息”值之间的 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")

【问题讨论】：

你能澄清一下你的意思吗？即，如果在此数据中，第 6 行有“foo”，第 8 行也有，那么第 7 行仍然不会被填充，而是会丢失？我认为您的数据示例中目前没有说明这一点
没错，因为第 6 行的 id 是 1 而第 8 行的 id 是 2，所以在这种情况下 7 会乱七八糟。如果第 7 行是“foo”，由于 id 不同，第 6 行仍将保持 NA

标签： r dplyr data.table

【解决方案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

【讨论】：

【解决方案2】：

使用来自zoo 的na.approx 的选项。

首先，我们从列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

我们只在y 中有1s 的地方得到元素。因此，当我们这样做时

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

2s 的结果相同。

将1 和2 视为

中的第一个和第二个元素

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

即"foo" 和"baz"。

现在对于每个match(y, i) * i，我们可以从zoo 调用na.approx 来填充介于两者之间的NA（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必须是双精度类型，而不是整数类型”）

我们快到了。接下来我们需要做的是在每个位置找到第一个非缺失值，这就是dplyr中的coalesce发挥作用的地方，结果是

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"

希望这会有所帮助。

【讨论】：

【解决方案3】：

这是一种无需分组来填充值的方法，如果填充不正确，则将其替换为 NA。

tidyr::fill 默认情况下会用前一个值填充缺失值，因此会溢出一些值。不幸的是，它不尊重分组，所以我们必须使用if_else 条件来修复它的错误。

首先，我们捕获原始缺失值位置并计算每个id 和message 的最大值和最小值index。填充后，我们加入这些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

^{由reprex package (v0.2.1) 于 2019 年 2 月 15 日创建}

【讨论】：

在什么输入上可以破解？
如果第 8 行缺少值，我认为我之前的方法会失败，它会替换第 8 行，但将第 7 行保留为foo

【解决方案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

数据表

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

【讨论】：

【解决方案5】：

另一个使用 case_when 的 tidyverse 解决方案。编辑以避免在系列结束后填充。

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

【讨论】：

是的，output$message[19] 应保持 NA，因为 bar 消息序列已在 output$message[18] 结束
可能为时已晚，但在编辑中提供了更新的解决方案。祝你好运！这里提供了许多其他不错的解决方案。