Изменение формы фрейма данных на основе нескольких условий

Question

Я бы хотел идентифицировать действия, выполняемые в одном и том же месте и с одним и тем же человеком, для идентификатора в течение времени t. Переменная wher обозначает временные шаги и записи, где действия происходят в момент времени t. Параметр with записывает, с кем была выполнена операция в момент времени t. Я хотел бы знать общие действия, которые выполнялись в том же месте и с одним и тем же человеком в течение времени t в зависимости от пола. Необычные действия и действия, выполненные в другом месте с другим человеком, которого я заменил на 0.

Ввод

id     DMSex       t1  t2  t3  t4  wher1 wher2 wher3 wher4 wit1 wit2 wit3 wit4  
12       M         12  12  12  12  1        1   1     4     8     9    4    0  
12       F         10  13  12  12  3        1   1     5     6     5    4    1

Выход:

id  t1  t2  t3  t4  
12   0   0  12  0  

Пример данных для 18 time steps:

structure(list(serial = c(11011202, 11011202), DMSex = c(1, 2
), act1_1 = c(110, 110), act1_2 = c(110, 110), act1_3 = c(110, 
110), act1_4 = c(110, 110), act1_5 = c(110, 110), act1_6 = c(110, 
110), act1_7 = c(110, 110), act1_8 = c(110, 110), act1_9 = c(110, 
110), act1_10 = c(110, 110), act1_11 = c(110, 110), act1_12 = c(8219, 
110), act1_13 = c(310, 110), act1_14 = c(3210, 110), act1_15 = c(3110, 
110), act1_16 = c(7241, 110), act1_17 = c(210, 110), act1_18 = c(3819, 
110), wher_1 = c(11, 11), wher_2 = c(11, 11), wher_3 = c(11, 
11), wher_4 = c(11, 11), wher_5 = c(11, 11), wher_6 = c(11, 11
), wher_7 = c(11, 11), wher_8 = c(11, 11), wher_9 = c(11, 11), 
    wher_10 = c(11, 11), wher_11 = c(11, 11), wher_12 = c(11, 
    11), wher_13 = c(11, 11), wher_14 = c(11, 11), wher_15 = c(11, 
    11), wher_16 = c(11, 11), wher_17 = c(11, 11), wher_18 = c(11, 
    11), wit4_1 = c(0, 0), wit4_2 = c(0, 0), wit4_3 = c(0, 0), 
    wit4_4 = c(0, 0), wit4_5 = c(0, 0), wit4_6 = c(0, 0), wit4_7 = c(0, 
    0), wit4_8 = c(0, 0), wit4_9 = c(0, 0), wit4_10 = c(0, 0), 
    wit4_11 = c(0, 0), wit4_12 = c(0, 0), wit4_13 = c(0, 0), 
    wit4_14 = c(0, 0), wit4_15 = c(0, 0), wit4_16 = c(0, 0), 
    wit4_17 = c(0, 0), wit4_18 = c(0, 0)), row.names = 1:2, class = "data.frame")

, где act1_ равно t; wit4 равно wit и wher_ равно wher

Answer 1

Одно решение, объединяющее dplyr и purrr, может быть:

map(.x = as.character(1:4),
    ~ df %>%
     select(id, ends_with(.x)) %>%
     group_by(id) %>%
     mutate_at(vars(matches("^wher|^wit")), ~ all(. == first(.))) %>%
     ungroup() %>%
     mutate(cond = rowSums(select(.,  matches("^wher|^wit"))) == 2) %>%
     group_by(id) %>%
     mutate_at(vars(starts_with("t")), ~ all(. == first(.)) * cond * .) %>%
     ungroup() %>%
     select(starts_with("t"))) %>%
 bind_cols(df %>%
            select(id)) %>%
 group_by(id) %>%
 summarise_all(first)

     id    t1    t2    t3    t4
  <int> <int> <int> <int> <int>
1    12     0     0    12     0

Сначала создается символьный вектор от 1 до 4, поскольку существует четыре пары переменных (из t1, wher1, wit1 до t4, wher4, wit4). Функция отображения применяется к этим элементам. Во-вторых, из df он индивидуально выбирает пары переменных и проверяет, одинаковы ли wher и wit во всех строках для каждого идентификатора, создавая логическое условие. В-третьих, он проверяет, является ли переменная t одинаковой во всех строках для каждого идентификатора, и сравнивает ее с логическим условием из шага 2. Если TRUE, возвращается исходное значение, если нет, то 0. Наконец, он объединяет данные и сохраняет по одной строке на ID.

Решение для обновленного вопроса с добавлением stringr:

map(.x = str_extract(names(df)[grepl("^act", names(df))], "_.*+$"),
    ~ df %>%
     select(serial, ends_with(.x)) %>%
     group_by(serial) %>%
     mutate_at(vars(matches("^wher|^wit")), ~ all(. == first(.))) %>%
     ungroup() %>%
     mutate(cond = rowSums(select(.,  matches("^wher|^wit"))) == 2) %>%
     group_by(serial) %>%
     mutate_at(vars(starts_with("act")), ~ all(. == first(.)) * cond * .) %>%
     ungroup() %>%
     select(starts_with("act"))) %>%
 bind_cols(df %>%
            select(serial)) %>%
 group_by(serial) %>%
 summarise_all(first)

  serial act1_1 act1_2 act1_3 act1_4 act1_5 act1_6 act1_7 act1_8 act1_9 act1_10 act1_11 act1_12
   <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>   <dbl>   <dbl>   <dbl>
1 1.10e7    110    110    110    110    110    110    110    110    110     110     110       0
# … with 6 more variables: act1_13 <dbl>, act1_14 <dbl>, act1_15 <dbl>, act1_16 <dbl>,
#   act1_17 <dbl>, act1_18 <dbl>