Рекурсивная функция в R с конечной точкой, варьирующейся в зависимости от группы

Question

Я sh, чтобы использовать рекурсивную структуру в моем изменении dplyr, которая повторяет количество задержек, используемых для определенных операций. Дело в том, что я не уверен, как установить его конечную точку, поскольку она больше похожа на while, чем на for l oop, что делает меня немного небезопасным.

Вот некоторые образцы данных . Группы не обязательно имеют одинаковый размер и индексируются id

df <- data.frame(id = c(1, 1, 1, 1, 2, 
                        2, 3, 4, 5, 5, 5), 
                  p201 = c(NA, NA, "001", NA, NA, NA, "001", "001", "001", NA, NA), 
                 V2009 = c(25, 11, 63, 75, 49, 14, 32, 31, 3, 10, 3),
                 ager = c(2.3, 2, 8.1, 12.1, 5.1, 2, 2.9, 2.8, 2,
                          2, 2), 
                 V2007 = c(1, 1, 1, 1, 2, 2, 1, 2, 1, 1, 1)
)

I wi sh, чтобы обновить p201 в зависимости от того, насколько похожи на его задержки наблюдения в данной группе.

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

new <- df %>%
group_by(id) %>%
mutate(
    p201 = ifelse(!is.na(p201), p201,
                      ifelse(
                        V2007 == lag(V2007, 1) & 
                        abs(V2009 - lag(V2009, 1)) <= ager,
                        first(na.omit(p201)), p201)))

Мой вопрос в том, как я могу написать рекурсивную функцию, которая вписывается в цепочку dplyr, которая повторяется на i в lag(VAR, i) - Я хочу, чтобы i рос, пока не произойдет что-либо: в p201 больше нет NA s, и все возможные задержки проверяются в каждой группе. Что касается последнего, следует сказать, что количество строк в каждой группе различается.

Я подумал о двух возможностях: сделать максимальное значение i числом строк самой большой группы - 1 или это количество строк в каждой группе - 1. Я не уверен, какое решение является оптимальным, и я не знаю, как это реализовать.

Может ли кто-нибудь помочь?

Здесь желаемый результат:

# A tibble: 11 x 5
# Groups:   id [5]
      id p201  V2009  ager V2007
   <int> <chr> <dbl> <dbl> <dbl>
 1    1 NA       25  2.3      1
 2    1 NA       11  2        1
 3    1 001      63  8.1      1
 4    1 001      75 12.2      1
 5    2 NA       49  5.1      2
 6    2 NA       14  2        2
 7    3 001      32  2.9      1
 8    4 001      31  2.8      2
 9    5 001       3  2        1
10    5 NA       10  2        1
11    5 001       3  2        1

                 

Answer 1

Вы можете выполнить sh то, что хотите, с помощью 2 group_bys, сначала на (id, V2007), а затем после создания фиктивной переменной counter на (id, V2007, counter). Идея counter состоит в том, чтобы разделить записи в id, V2007, когда p201 == 001. См. Фиктивный пример ниже

id | p201 | V2007 | counter
 1 |   NA |     1 |       0
 1 |  001 |     1 |       1     <= (+1 to counter)
 1 |   NA |     1 |       1
 1 |  001 |     1 |       2     <= (+1 to counter)

После второго group_by он подразделяется на

id | p201 | V2007 | counter
 1 |   NA |     1 |       0   (group 1-A OR 1)
----------------------------
 1 |  001 |     1 |       1   (group 1-B OR 2)
 1 |   NA |     1 |       1
----------------------------
 1 |  001 |     1 |       2   (group 1-C OR 3)

После второго group_by, p201 будет «копировать» не- Значение NA, если строка соответствует 3 следующим условиям

• p201 IS NA
• НЕ ПЕРВАЯ СТРОКА ПОДГРУППЫ
  • cond1 = row_number() > 1
• ABS (V2009 - ПЕРВЫЙ (V2009)) <= <code>AGER
  • cond2 = abs(V2009 - first(V2009)) <= ager

См. Решение

library(dplyr)
df %>%
    mutate(p201 = as.character(p201)) %>%
    group_by(id, V2007) %>% 
    mutate(counter = cumsum(ifelse(is.na(p201), 0, p201))) %>%
    group_by(id, V2007, counter) %>%
    mutate(cond1 = row_number() > 1) %>%
    mutate(cond2 = abs(V2009 - first(V2009)) <= ager) %>%
    mutate(p201 = ifelse(is.na(p201) & cond1 & cond2, first(p201), p201)) %>%
    ungroup() %>%
    select(-counter, -cond1, -cond2)

# A tibble: 11 x 5
      id p201  V2009  ager V2007
   <dbl> <chr> <dbl> <dbl> <dbl>
 1     1 NA       25   2.3     1
 2     1 NA       11   2       1
 3     1 001      63   8.1     1
 4     1 001      75  12.1     1
 5     2 NA       49   5.1     2
 6     2 NA       14   2       2
 7     3 001      32   2.9     1
 8     4 001      31   2.8     2
 9     5 001       3   2       1
10     5 NA       10   2       1
11     5 001       3   2       1

Более подробный взгляд на решение - если я исключу последние 2 строки, вы увидите новые столбцы, которые были созданы

# A tibble: 11 x 8
# Groups:   id, V2007, counter [6]
      id p201  V2009  ager V2007 counter cond1 cond2
   <dbl> <chr> <dbl> <dbl> <dbl>   <dbl> <lgl> <lgl>
 1     1 NA       25   2.3     1       0 FALSE TRUE
 2     1 NA       11   2       1       0 TRUE  FALSE
 3     1 001      63   8.1     1       1 FALSE TRUE
 4     1 001      75  12.1     1       1 TRUE  TRUE
 5     2 NA       49   5.1     2       0 FALSE TRUE
 6     2 NA       14   2       2       0 TRUE  FALSE
 7     3 001      32   2.9     1       1 FALSE TRUE
 8     4 001      31   2.8     2       1 FALSE TRUE
 9     5 001       3   2       1       1 FALSE TRUE
10     5 NA       10   2       1       1 TRUE  FALSE
11     5 001       3   2       1       1 TRUE  TRUE

Давайте сначала посмотрим at counter - создан после первой группировки на id, V2007

# A tibble: 11 x 8
# Groups:   id, V2007, counter [6]
      id p201  V2009  ager V2007 counter 
   <dbl> <chr> <dbl> <dbl> <dbl>   <dbl> 
 ------------- GROUP 1 -----------------
 1     1 NA       25   2.3     1       0 
 2     1 NA       11   2       1       0 
 3     1 001      63   8.1     1       1   <= (+1 when p201 == '001')
 4     1 NA       75  12.1     1       1  
 ------------- GROUP 2 -----------------
 5     2 NA       49   5.1     2       0  
 6     2 NA       14   2       2       0 
 ------------- GROUP 3 -----------------
 7     3 001      32   2.9     1       1   <= (+1 when p201 == '001')
 -------------- GROUP 4 ----------------
 8     4 001      31   2.8     2       1   <= (+1 when p201 == '001')
 etc 

Теперь давайте посмотрим на cond1, созданный после 2-го группирования на id, V2007, counter

# A tibble: 11 x 8
# Groups:   id, V2007, counter [6]
      id p201  V2009  ager V2007 counter cond1 
   <dbl> <chr> <dbl> <dbl> <dbl>   <dbl> <lgl> 
 ---------------- GROUP 1 -------------------- 
 1     1 NA       25   2.3     1       0 FALSE   <= ROW_NUMBER == 1 => FALSE
 2     1 NA       11   2       1       0 TRUE    <= ROW_NUMBER > 1 => TRUE
 ---------------- GROUP 2 --------------------
 3     1 001      63   8.1     1       1 FALSE   <= ROW_NUMBER == 1 => FALSE
 4     1 NA      75  12.1     1        1 TRUE    <= ROW_NUMBER > 1 => TRUE
 ---------------- GROUP 3 -------------------- 
 5     2 NA       49   5.1     2       0 FALSE   <= ROW_NUMBER == 1 => FALSE
 6     2 NA       14   2       2       0 TRUE    <= ROW_NUMBER > 1 => TRUE
 <skip>
 ---------------- GROUP N --------------------
 9     5 001       3   2       1       1 FALSE   <= ROW_NUMBER == 1 => FALSE
10     5 NA       10   2       1       1 TRUE    <= ROW_NUMBER > 1 => TRUE
11     5 NA        3   2       1       1 TRUE    <= ROW_NUMBER > 1 => TRUE

Наконец, посмотрим на cond2 - abs(V2009 - first(V2009)) <= ager

# A tibble: 11 x 8
# Groups:   id, V2007, counter [6]
      id p201  V2009  ager V2007 counter cond1 cond2
   <dbl> <chr> <dbl> <dbl> <dbl>   <dbl> <lgl> <lgl>
 ---------------- GROUP 1 ------------------------      first(V2009) in this group is 25
 1     1 NA       25   2.3     1       0 FALSE TRUE     <= abs(25 - 25) <= 2.3 => TRUE
 2     1 NA       11   2       1       0 TRUE  FALSE    <= abs(11 - 25) <= 2 => FALSE

 ---------------- GROUP 2 ------------------------      first(V2009) in this group is 63
 3     1 001      63   8.1     1       1 FALSE TRUE     <= abs(63 - 63) <= 8.1 => TRUE
 4     1 NA       75  12.1     1       1 TRUE  TRUE     <= abs(75 - 63) <= 12.1 => TRUE

 ---------------- GROUP 3 ------------------------      <= first(V2009) in this group is 49
 5     2 NA       49   5.1     2       0 FALSE TRUE     <= abs(49 - 49) <= 5.1 => TRUE
 6     2 NA       14   2       2       0 TRUE  FALSE    <= abs(14 - 49) <= 2 => FALSE
 <skip>

 ---------------- GROUP N ------------------------      <= first(V2009) in this group is 3
 9     5 001       3   2       1       1 FALSE TRUE     <= abs(3 - 3) <= 2 => TRUE
10     5 NA       10   2       1       1 TRUE  FALSE    <= abs(10 - 3) <= 2 => FALSE
11     5 NA        3   2       1       1 TRUE  TRUE     <= abs(3 - 3) <= 2 => TRUE

Наконец, ifelse(is.na(p201) & cond1 & cond2, first(p201), p201). Этот оператор переводится как «ЕСЛИ p201 IS NA AND COND1 == TRUE AND COND2 == TRUE, THEN ASSIGN P201 = FIRST (P201), ELSE P201 НЕ МЕНЯЕТСЯ»

# A tibble: 11 x 8
# Groups:   id, V2007, counter [6]
      id p201  V2009  ager V2007 counter cond1 cond2
   <dbl> <chr> <dbl> <dbl> <dbl>   <dbl> <lgl> <lgl>
---------------- GROUP 1 ------------------------
 1     1 NA       25   2.3     1       0 FALSE TRUE     <= P201 DOES NOT CHANGE BECAUSE COND1 IS FALSE
 2     1 NA       11   2       1       0 TRUE  FALSE    <= P201 DOES NOT CHANGE BECAUSE COND2 IS FALSE

---------------- GROUP 2 ------------------------       <= FIRST(P201) == '001' FOR THIS GROUP
 3     1 001      63   8.1     1       1 FALSE TRUE     <= P201 DOES NOT CHANGE BECAUSE P201 == '001' AND COND1 IS FALSE
 4     1 001      75  12.1     1       1 TRUE  TRUE     <= P201 = FIRST(P201) BECAUSE ALL 3 CONDITIONS ARE TRUE (P201 WAS ORIGINALLY NA HERE)

---------------- GROUP 3 ------------------------
 5     2 NA       49   5.1     2       0 FALSE TRUE    <= P201 DOES NOT CHANGE BECAUSE COND1 IS FALSE
 6     2 NA       14   2       2       0 TRUE  FALSE   <= P201 DOES NOT CHANGE BECAUSE COND2 IS FALSE
 <skip>

---------------- GROUP N ------------------------
 9     5 001       3   2       1       1 FALSE TRUE    <= P201 DOES NOT CHANGE BECAUSE COND1 IS FALSE
10     5 NA       10   2       1       1 TRUE  FALSE   <= P201 DOES NOT CHANGE BECAUSE COND2 IS FALSE
11     5 001       3   2       1       1 TRUE  TRUE    <= P201 = FIRST(P201) BECAUSE ALL 3 CONDITIONS ARE TRUE (P201 WAS ORIGINALLY NA HERE)

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

Я добавил

mutate(p201 = as.character(p201))

, потому что в противном случае p201 преобразуется в целое число.

Answer 2

Я не думаю, что то, что вы описываете, действительно рекурсивно, поскольку вычисления не зависят от результатов предыдущих итераций. Однако это довольно сложно, и, возможно, лучший способ вписать его в конвейер dplyr - объявить функцию, которая принимает необходимые переменные и возвращает ваш ответ.

Вот функция, которая выполняет уловка. Он использует парадигму разделения-слияния-слияния, чтобы заставить вычисления работать правильно по строкам. Затем он использует sapply, чтобы проверить, выполнены ли для каждой строки логические условия в любой предыдущей строке в группе. Если это так, он заменяет NA в этих строках p201 значение значением, отличным от NA:

multi_condition <- function(id, v1, v2, v3, v4)
{
  unlist(lapply(split(data.frame(v1, v2, v3, v4), id), function(x) 
  {
    if(all(is.na(x$v1))) return(x$v1)
    
    ss <- unlist(c(FALSE, sapply(seq_along(x$v2)[-1], function(i) 
    {
      x$v2[i] %in% x$v2[1:(i - 1)] & any(abs(x$v3[i] - x$v3[1:(i - 1)]) <= x$v4[i])
    })))   
    replace(x$v1, ss, x$v1[!is.na(x$v1)][1])    
  }))
}

Таким образом, сама функция сложна, но ее использовать просто:

library(dplyr)

df %>%
  group_by(id) %>%
  mutate(p201 = multi_condition(id, p201, V2007, V2009, ager))
#> # A tibble: 11 x 5
#> # Groups:   id [5]
#>       id p201  V2009  ager V2007
#>    <dbl> <chr> <dbl> <dbl> <dbl>
#>  1     1 <NA>     25   2.3     1
#>  2     1 <NA>     11   2       1
#>  3     1 001      63   8.1     1
#>  4     1 001      75  12.1     1
#>  5     2 <NA>     49   5.1     2
#>  6     2 <NA>     14   2       2
#>  7     3 001      32   2.9     1
#>  8     4 001      31   2.8     2
#>  9     5 001       3   2       1
#> 10     5 <NA>     10   2       1
#> 11     5 001       3   2       1

Если вы предпочитаете решение типа dplyr с использованием group_map, с logi c, возможно, немного понятнее, вы можете попробовать:

multi_select <- function(df, ...) 
{
  rowwise_logic <- function(i) 
  {
    if(i == 1) return(FALSE)
    j <- 1:(i - 1)
    df$V2007[i] %in% df$V2007[j] & 
    any(abs(df$V2009[i] - df$V2009[j]) <= df$ager[i])
  }
  
  matching_rows <- sapply(seq(nrow(df)), rowwise_logic)  
  df$p201[matching_rows] <- first(na.exclude(df$p201))

  return(df)
}

Что будет работать следующим образом:

df %>% 
  group_by(id) %>%
  group_map(multi_select, .keep = TRUE) %>%
  bind_rows()

^{Создано 15.07.2020 с помощью пакета . (v0.3.0)}