Заменить значения NA в зависимости от конкретных правил

Question

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

В некоторых случаях я могу заменить значение NA предыдущим значением.Ограничения для этого подхода:

Если оценка равна NA, проверьте, являются ли предыдущие и следующие значения NA.Если предыдущее и следующее значения не являются NA, введите среднее значение этих оценок.

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

Если в последовательности два или более значений NA, только замените первое значение NA, оставьте другие как NA.

Я попробовал функцию zoo :: na.locf (), но это без разбора либозаменит все NA или ограничит замену Gaps greated, чем количество NA.

Я посмотрел на аккуратную заливку, но в документации не было ничего об установке пределов для заполнения.

Для следующегоdata:

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

* с, чтобы было понятно, куда копируются значения.

Answer 1

Если я правильно понимаю, есть только два правила для замены NA значений в столбце score для каждого ID:

1. Если есть единственное значение NA, замените его средним значением предшествующего и последующего (не NA) значений.
2. Если имеется последовательность из двух или более значений NA, замените только первое значение NA на предыдущее (не NA) значение и оставьте остальные значения NA такими, как они есть.

Реализация этих двух правил сводится к двум простым mutate() утверждениям: Во-первых, все отдельные значения NA заменяются в соответствии с правилом 1 путем вызова zoo::na.approx() с maxgap = 1L. Таким образом, остаются только последовательности с более чем двумя значениями NA (если есть). Наконец, каждое значение NA заменяется предыдущим значением, используя if_else() и lag() в oder для выполнения правила 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 2

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

Замените каждое NA средним значением его соседей, если is.na(score[i]) && !is.na(score[i - 1]), то есть элемент равен 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 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