Как мне применить сложное условное изменение к нескольким столбцам?

#r #dplyr

#r #dplyr

Вопрос:

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

DF1

 dgCondition a_1000  a_1001  a_1010  a_1011
1   0   0   0   0
2   0   1   1   1
3   1   0   1   0
4   0   0   0   0
5   1   0   0   1
6   0   0   1   0
7   0   0   0   1
8   1   0   1   0
9   0   0   0   0
 

DF2

 dgCondition a_1000  a_1001  a_1010  a_1011
1   1   1   0   0
2   0   1   1   1
1   0   0   1   1
5   1   1   1   0
7   1   1   0   0
7   1   0   0   0
7   0   0   0   0
1   0   0   0   0
7   0   1   0   1
4   0   1   0   1
4   0   1   0   1
4   0   0   1   0
4   0   0   1   0
4   1   1   0   1
6   1   1   0   1
6   1   1   0   0
6   0   0   1   0
6   0   0   1   0
 

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

 testVect <- DF1 %>% filter(a_1000 == 1)
testVect <- testVect %>% select(-contains("a_"))

DF2 <- DF2 %>% mutate(aDG_1000 = (a_1000 == 1 amp; dgCondition %in% testVect$dgCondition)*1)
 

Строки выше фильтруются DF1$dgCondition так, чтобы оставались только строки, где a_1000 == 1 , так что в этом случае 3,5, 8. Затем я устанавливаю a_1000 значение 0 везде, кроме тех случаев, когда оно уже было установлено в 1, и одно из условий соответствует одному testVect . Таким образом, результатом для a_1000 in DF2 является новый столбец с:

 dgCondition aDG_1000
1   0
2   0
1   0
5   1
7   0
7   0
7   0
1   0
7   0
4   0
4   0
4   0
4   0
4   0
6   0
6   0
6   0
6   0
 

Я пытался создать цикл for для перебора каждого столбца, но безуспешно. Я также изучал возможность do.call с помощью lapply. Но мне пока тоже не повезло с этим. Я чувствую, что мне не хватает чего-то, что заставило бы это работать, поэтому я подумал спросить экспертов.

Спасибо за помощь.

Комментарии:

1. Я думаю, что в примере есть ошибка: вы, вероятно, имеете в виду dgCondition %in% testVect$dgCondition , а не %in% DF1$dgCondition

2. ах, вы правы

Ответ №1:

Базовый подход R :

 result <- cbind(df2[1], mapply(function(x, y) {
              as.integer(df2$dgCondition %in% x amp; y == 1)
          }, lapply(df1[-1], function(x) df1$dgCondition[x == 1]), df2[-1]))
result
#   dgCondition a_1000 a_1001 a_1010 a_1011
#1            1      0      0      0      0
#2            2      0      1      1      1
#3            1      0      0      0      0
#4            5      1      0      0      0
#5            7      0      0      0      0
#6            7      0      0      0      0
#7            7      0      0      0      0
#8            1      0      0      0      0
#9            7      0      0      0      1
#10           4      0      0      0      0
#11           4      0      0      0      0
#12           4      0      0      0      0
#13           4      0      0      0      0
#14           4      0      0      0      0
#15           6      0      0      0      0
#16           6      0      0      0      0
#17           6      0      0      1      0
#18           6      0      0      1      0
 

lapply(df1[-1], function(x) df1$dgCondition[x == 1]) возвращает dgCondition значения в каждом столбце, где значение равно 1. Эти значения вместе с df2 мы передаем mapply и присваиваем 1, если dgCondition of df1 присутствует в df2 , а также его y значение равно 1.

Комментарии:

1. потрясающе. Отлично работает. Я еще не использовал lapply и mapply , и, похоже, мне придется их прочитать. Одна вещь, которую я не понимаю, — зачем использовать -1 в [ ] ?

2. Это означает игнорировать первый столбец в обоих фреймах данных, который есть dgCondition .

Ответ №2:

Вот подход, позволяющий преобразовать все в длинный формат.

 
library(tidyverse)
DF1 <- read.table(text="dgCondition a_1000  a_1001  a_1010  a_1011
1   0   0   0   0
2   0   1   1   1
3   1   0   1   0
4   0   0   0   0
5   1   0   0   1
6   0   0   1   0
7   0   0   0   1
8   1   0   1   0
9   0   0   0   0", header=TRUE)


DF2 <- read.table(text="dgCondition a_1000  a_1001  a_1010  a_1011
1   1   1   0   0
2   0   1   1   1
1   0   0   1   1
5   1   1   1   0
7   1   1   0   0
7   1   0   0   0
7   0   0   0   0
1   0   0   0   0
7   0   1   0   1
4   0   1   0   1
4   0   1   0   1
4   0   0   1   0
4   0   0   1   0
4   1   1   0   1
6   1   1   0   1
6   1   1   0   0
6   0   0   1   0
6   0   0   1   0", header=TRUE)


testVect <- DF1 %>% filter(a_1000 == 1)
testVect <- testVect %>% select(-contains("a_"))

DF2bis <- DF2 %>% mutate(aDG_1000 = (a_1000 == 1 amp; (dgCondition %in% testVect$dgCondition))*1)
 

Сначала давайте переформулируем DF1 более практичным способом:

 conds_for_DF1 <- pivot_longer(DF1,
                            starts_with("a_"),
                            names_to = "a_xxx") %>%
  filter(value == 1) %>%
  group_by(a_xxx) %>%
  summarize(dgConds_DF1 = list(dgCondition),
            dgConds_readable = paste(dgCondition, collapse=", "))
#> `summarise()` ungrouping output (override with `.groups` argument)

conds_for_DF1
#> # A tibble: 4 x 3
#>   a_xxx  dgConds_DF1 dgConds_readable
#>   <chr>  <list>      <chr>           
#> 1 a_1000 <int [3]>   3, 5, 8         
#> 2 a_1001 <int [1]>   2               
#> 3 a_1010 <int [4]>   2, 3, 6, 8      
#> 4 a_1011 <int [3]>   2, 5, 7
 

Обратите внимание, что я буду использовать столбец dgConds_DF1 , я просто добавил символьную версию dgConds_readable , чтобы визуализировать, что происходит.

Затем мы можем преобразовать DF2 в более длинный формат и просто join использовать наш преобразованный DF1. Таким образом, каждая строка имеет одно условие dgCondition и a_xxx, после чего мы можем просто проверять условия по отдельности.

 pivot_longer(DF2,
             starts_with("a_"),
             names_to = "a_xxx") %>%
  left_join(conds_for_DF1, by= "a_xxx") %>%
  mutate(dgCond_in_DF1 = map2_lgl(dgCondition, dgConds_DF1, ~ .x %in% .y),
         aDG_xxx = value * dgCond_in_DF1)
#> # A tibble: 72 x 7
#>    dgCondition a_xxx  value dgConds_DF1 dgConds_readable dgCond_in_DF1 aDG_xxx
#>          <int> <chr>  <int> <list>      <chr>            <lgl>           <int>
#>  1           1 a_1000     1 <int [3]>   3, 5, 8          FALSE               0
#>  2           1 a_1001     1 <int [1]>   2                FALSE               0
#>  3           1 a_1010     0 <int [4]>   2, 3, 6, 8       FALSE               0
#>  4           1 a_1011     0 <int [3]>   2, 5, 7          FALSE               0
#>  5           2 a_1000     0 <int [3]>   3, 5, 8          FALSE               0
#>  6           2 a_1001     1 <int [1]>   2                TRUE                1
#>  7           2 a_1010     1 <int [4]>   2, 3, 6, 8       TRUE                1
#>  8           2 a_1011     1 <int [3]>   2, 5, 7          TRUE                1
#>  9           1 a_1000     0 <int [3]>   3, 5, 8          FALSE               0
#> 10           1 a_1001     0 <int [1]>   2                FALSE               0
#> # ... with 62 more rows
 

Наконец, если вы хотите восстановить исходный формат с помощью a_xxx в виде отдельных столбцов, вам просто нужно pivot_wider . Однако есть один нюанс: поскольку несколько строк DF2 имеют одинаковое условие dgCondition, нам нужен отдельный идентификатор строки для их восстановления:

 DF2 %>%
  mutate(row_id = row_number()) %>%
  pivot_longer(starts_with("a_"),
               names_to = "a_xxx") %>%
  left_join(conds_for_DF1, by= "a_xxx") %>%
  mutate(dgCond_in_DF1 = map2_lgl(dgCondition, dgConds_DF1, ~ .x %in% .y),
         aDG_xxx = value * dgCond_in_DF1) %>%
  select(row_id, dgCondition, a_xxx, aDG_xxx) %>%
  pivot_wider(names_from = "a_xxx",
              values_from = "aDG_xxx") %>%
  select(-row_id)
#> # A tibble: 18 x 5
#>    dgCondition a_1000 a_1001 a_1010 a_1011
#>          <int>  <int>  <int>  <int>  <int>
#>  1           1      0      0      0      0
#>  2           2      0      1      1      1
#>  3           1      0      0      0      0
#>  4           5      1      0      0      0
#>  5           7      0      0      0      0
#>  6           7      0      0      0      0
#>  7           7      0      0      0      0
#>  8           1      0      0      0      0
#>  9           7      0      0      0      1
#> 10           4      0      0      0      0
#> 11           4      0      0      0      0
#> 12           4      0      0      0      0
#> 13           4      0      0      0      0
#> 14           4      0      0      0      0
#> 15           6      0      0      0      0
#> 16           6      0      0      0      0
#> 17           6      0      0      1      0
#> 18           6      0      0      1      0