根据特定规则替换 NA 值

Question

我正在研究一个数据集，其中根据从临床记录中收集的数据计算得分。在某些情况下，此数据已被省略，因此无法计算分数并记录为 NA。

在某些情况下，我可以用以前的值替换 NA 值。这种方法的局限性在于：

如果 score 为 NA，则检查上一个值和下一个值是否为 NA。如果前一个值和下一个值都不是 NA，则插入这些分数的平均值。

如果 score 为 NA，则检查上一个值和下一个值是否为 NA。如果只有前一个值不是 NA，则用前一个值替换第一个 NA 值。

如果顺序有两个或多个NA值，只替换第一个NA值，其余的为NA。

我已经尝试过函数 zoo::na.locf() 但这会不加选择地替换所有 NA 或限制替换大于多个 NA 的间隙。

我查看了 tidy fill，但文档没有包含任何关于设置填充限制的内容。

对于以下数据：

ID,episode,score
1,1,1
1,2,1
1,3,1
1,4,NA
1,5,NA
1,6,NA
1,7,2
1,8,NA
1,9,4
1,10,NA
2,1,NA
2,2,2
2,3,3
2,4,4
2,5,NA
2,6,NA
2,7,3
2,8,NA
2,9,NA
2,10,NA

所以我认为我在下面嵌套的 ifelse mutate 上走在了正确的轨道上，但我缺少有关可用于将替换限制为特定数量的 NA 值的函数的知识

data <- data %>%
group_by(ID) %>%
arrange(episode) %>%
mutate(score = ifelse(is.na(score) & lag(!is.na(score)) & lead(!is.na(score)), average(sum(lag(score),lead(score))),
    ifelse(is.na(score) & lag(!is.na(score)) & lead(is.na(score)), lag(score), ...) #And this is where I get stuck as I am unsure how to code for NA runs greater than 1

我的预期输出是：

ID,episode,score
1,1,1
1,2,1
1,3,1
1,4,*1
1,5,NA
1,6,NA
1,7,2
1,8,*3
1,9,4
1,10,*4
2,1,NA
2,2,2
2,3,3
2,4,4
2,5,*4
2,6,NA
2,7,3
2,8,*3
2,9,NA
2,10,NA

*s 添加以明确复制值的位置。

Answer 1

从计算上讲，您可以将三个规则简化为一个复合条件：

如果is.na(score[i]) && !is.na(score[i - 1])，则将每个NA替换为其邻居的平均值，即元素是NA，而前一个元素不是NA。

为此，您只需将na.rm = T 传递给mean()，即mean(x[(i-1):(i+1)], na.rm = T)，您可以在*apply 函数或map 中使用它，如下所示。请注意，我还选择通过索引位置引用和分配值，而不是使用生成额外向量的lead 和lag。它可能不那么令人兴奋，但也更有效率：

library(dplyr)
library(purrr)

mutate(df, score = map(seq_along(score),
                       ~ ifelse(
                           is.na(score[.]) && !is.na(score[. - 1]),
                           mean(score[(. - 1):(. + 1)], na.rm = T),
                           score[.]
                       )))

#### OUTPUT ####

   ID episode score
1   1       1     1
2   1       2     1
3   1       3     1
4   1       4     1
5   1       5    NA
6   1       6    NA
7   1       7     2
8   1       8     3
9   1       9     4
10  1      10     4
11  2       1    NA
12  2       2     2
13  2       3     3
14  2       4     4
15  2       5     4
16  2       6    NA
17  2       7     3
18  2       8     3
19  2       9    NA
20  2      10    NA

Answer 2

如果我理解正确，对于每个 ID，在 score 列中替换 NA 值的规则只有两条：

1. 如果只有一个 NA 值，则将其替换为前面和后面（非 NA）值的平均值。
2. 如果有两个或多个 NA 值的序列，则仅将第一个 NA 值替换为前面的（非 NA）值，并保留其他 NA 值不变。

这两条规则的实现归结为两个简单的mutate() 语句： 首先，通过将zoo::na.approx() 调用为maxgap = 1L，根据规则1 替换所有单个NA 值。因此，仅保留具有两个以上 NA 值的序列（如果有）。最后，每个 NA 值都使用 if_else() 和 lag() 替换为前面的值，以实现规则 2。

library(dplyr)
data %>% 
  group_by(ID) %>% 
  mutate(new_score = zoo::na.approx(score, x = row_number(), maxgap = 1, na.rm = FALSE)) %>% 
  mutate(new_score = if_else(is.na(new_score), lag(new_score), new_score))

# A tibble: 20 x 4
# Groups:   ID [2]
      ID episode score new_score
   <dbl>   <dbl> <dbl>     <dbl>
 1     1       1     1         1
 2     1       2     1         1
 3     1       3     1         1
 4     1       4    NA         1
 5     1       5    NA        NA
 6     1       6    NA        NA
 7     1       7     2         2
 8     1       8    NA         3
 9     1       9     4         4
10     1      10    NA         4
11     2       1    NA        NA
12     2       2     2         2
13     2       3     3         3
14     2       4     4         4
15     2       5    NA         4
16     2       6    NA        NA
17     2       7     3         3
18     2       8    NA         3
19     2       9    NA        NA
20     2      10    NA        NA

请注意，这里会创建一个新列 new_score 以进行比较。

用于替换 score 使用

data %>% 
  group_by(ID) %>% 
  mutate(score = zoo::na.approx(score, x = row_number(), maxgap = 1, na.rm = FALSE)) %>% 
  mutate(score = if_else(is.na(score), lag(score), score))

数据

data <- readr::read_csv("ID,episode,score
1,1,1
1,2,1
1,3,1
1,4,NA
1,5,NA
1,6,NA
1,7,2
1,8,NA
1,9,4
1,10,NA
2,1,NA
2,2,2
2,3,3
2,4,4
2,5,NA
2,6,NA
2,7,3
2,8,NA
2,9,NA
2,10,NA")

Answer 3

一个选项是

library(dplyr)
data %>%
   group_by(ID) %>% 
  group_by(grp = cumsum(lead(is.na(score) & !is.na(lead(score) & 
      !is.na(lag(score)) ))), add = TRUE) %>% 
  mutate(score1 = if(n() == 3 & is.na(score[2]) & sum(is.na(score))== 1) 
    replace(score, is.na(score), mean(score, na.rm = TRUE)) else score) %>% 
  ungroup %>% 
  select(-grp) %>%
  mutate(score1 = coalesce(score1, lag(score1)))
# A tibble: 20 x 4
#      ID episode score score1
#   <int>   <int> <int>  <dbl>
# 1     1       1     1      1
# 2     1       2     1      1
# 3     1       3     1      1
# 4     1       4    NA      1
# 5     1       5    NA     NA
# 6     1       6    NA     NA
# 7     1       7     2      2
# 8     1       8    NA      3
# 9     1       9     4      4
#10     1      10    NA      4
#11     2       1    NA     NA
#12     2       2     2      2
#13     2       3     3      3
#14     2       4     4      4
#15     2       5    NA      4
#16     2       6    NA     NA
#17     2       7     3      3
#18     2       8    NA      3
#19     2       9    NA     NA
#20     2      10    NA     NA