Как сократить этот длинный синтаксис dplyr?

#r #dplyr #purrr

Вопрос:

В некотором роде я хотел бы иметь возможность корректировать определенные значения, принимаемые переменными nbeta_dep01 , nbeta_dep02

Ниже приведен воспроизводимый пример того, что я делаю.

Я хотел бы знать, есть ли способ сократить синтаксис (потому что в моем примере я копирую и вставляю столько раз инструкцию по исправлению, сколько у меня есть переменной nbeta_depXX)

 suppressMessages(library(dplyr))  test lt;- tribble(  ~ent, ~dep_impl, ~nbeta_dep01, ~nbeta_dep02, ~nbeta_dep03, ~nbeta_dep04, ~nbeta_dep05,  "a", "01", 0, 0, 0, 0, 0,   "b", "03", 2, 0, 3, 0, 1,  "c", "05", 0, 0, 0, 1, 0,  "d", "02", 0, 0, 0, 0, 0 )  test %gt;%   rowwise() %gt;%   mutate(  nbeta_dep01 = ifelse(  nbeta_dep01==0 amp; nbeta_dep02==0 amp; nbeta_dep03==0 amp; nbeta_dep04==0 amp; nbeta_dep05==0 amp; dep_impl=="01",  1,  nbeta_dep01),  nbeta_dep02 = ifelse(  nbeta_dep01==0 amp; nbeta_dep02==0 amp; nbeta_dep03==0 amp; nbeta_dep04==0 amp; nbeta_dep05==0 amp; dep_impl=="02",  1,  nbeta_dep02),  nbeta_dep03 = ifelse(  nbeta_dep01==0 amp; nbeta_dep02==0 amp; nbeta_dep03==0 amp; nbeta_dep04==0 amp; nbeta_dep05==0 amp; dep_impl=="03",  1,  nbeta_dep03),  nbeta_dep04 = ifelse(  nbeta_dep04==0 amp; nbeta_dep02==0 amp; nbeta_dep03==0 amp; nbeta_dep04==0 amp; nbeta_dep05==0 amp; dep_impl=="04",  1,  nbeta_dep04),  ) #gt; # A tibble: 4 x 7 #gt; # Rowwise:  #gt; ent dep_impl nbeta_dep01 nbeta_dep02 nbeta_dep03 nbeta_dep04 nbeta_dep05 #gt; lt;chrgt; lt;chrgt; lt;dblgt; lt;dblgt; lt;dblgt; lt;dblgt; lt;dblgt; #gt; 1 a 01 1 0 0 0 0 #gt; 2 b 03 2 0 3 0 1 #gt; 3 c 05 0 0 0 1 0 #gt; 4 d 02 0 1 0 0 0 Created on 2021-10-25 by the reprex package (v2.0.1)  

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

1. Я не проверял, можно ли вообще упростить логику, но вместо нескольких команд ifelse вы, возможно, захотите проверить case_when .

Ответ №1:

Вы могли бы использовать

 library(dplyr) library(stringr)  test %gt;%   mutate(across(matches("dep\d $"),   ~ifelse(rowSums(across(nbeta_dep01:nbeta_dep05)) == 0 amp; dep_impl == str_extract(cur_column(), "\d $"),  1,  .x)))  

Это возвращает

 # A tibble: 4 x 7  ent dep_impl nbeta_dep01 nbeta_dep02 nbeta_dep03 nbeta_dep04 nbeta_dep05  lt;chrgt; lt;chrgt; lt;dblgt; lt;dblgt; lt;dblgt; lt;dblgt; lt;dblgt; 1 a 01 1 0 0 0 0 2 b 03 2 0 3 0 1 3 c 05 0 0 0 1 0 4 d 02 0 1 0 0 0  
  • Мы определяем столбцы, подлежащие изменениям, с помощью регулярного выражения: "dep\d $" соответствует всем столбцам, которые заканчиваются «dep», за которыми следуют две цифры. Эти столбцы используются в across() функции.
  • if Утверждение упрощено: поскольку все nbeta_dep столбцы должны быть 0 , мы берем сумму этих столбцов с помощью rowSum функции в сочетании с across() функцией выбора. Кроме того, мы проверяем, совпадают ли цифры в имени текущего столбца с цифрами в столбце dep_impl .
  • Если эти условия выполнены, мы возвращаем, 1 иначе возвращается значение, уже содержащееся в текущем столбце/строке .x .

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

1. Потрясающе, я не владею регулярными выражениями !

Ответ №2:

Вы можете ссылаться на столбцы, все имена которых начинаются одинаково, используя функцию starts_with :

 test %gt;%   mutate(across(starts_with("nbeta"),  ~ifelse(  nbeta_dep01==0 amp; nbeta_dep02==0 amp; nbeta_dep03==0 amp; nbeta_dep04==0 amp; nbeta_dep05==0 amp; dep_impl=="01",  1,  nbeta_dep01)))  

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

1. спасибо, но последнее условие «dep_impl == XX» отсутствует

Ответ №3:

Это rowwise тоже работает и без matches() и rowSums() :

 test %gt;%  rowwise %gt;%  mutate(across(3:7, ~ifelse(grepl(dep_impl, cur_column()) amp;amp; sum(across(3:7)) == 0, 1, .))) # A tibble: 4 x 7 # Rowwise:   ent dep_impl nbeta_dep01 nbeta_dep02 nbeta_dep03 nbeta_dep04 nbeta_dep05  lt;chrgt; lt;chrgt; lt;dblgt; lt;dblgt; lt;dblgt; lt;dblgt; lt;dblgt; 1 a 01 1 0 0 0 0 2 b 03 2 0 3 0 1 3 c 05 0 0 0 1 0 4 d 02 0 1 0 0 0  

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

1. Хорошо, большое спасибо !