Слияние значений двух строк на основе условий с использованием data.table в R

Question

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

library(data.table)
DT <- data.table(person=c(1,1,1,1,2,2,2,2,2,3,3,3,3),
             activity=c("grab", "walk", "remove", "delete", "run", "talk", "walk", "remove",
                        "grab", "walk", "delete", "talk", "remove"),
             start_time=c(0,1,3,6,0,2,2,3,3,3,6,6,7), stop_time=c(1,3,5,7,1,4,4,8,4,5,7,7,8))
 DT

Я хочу обновить время начала и окончания и объединить столбец «активность» для каждого человека, если:

• действия выполняются параллельно. В частности, если start_time следующего действия предшествует stop_time предыдущего действия действия для этого человека. Или:
• Если время начала или окончания действий одного человека идентично.

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

DT.goal <- data.table(person=c(1,1,2,2,3,3),
                  activity=c("grab + walk + remove", "delete", "run", "talk + walk + grab + remove",
                             "walk", "delete + talk + remove"),
                  start_time=c(0,6,0,2,3,6), stop_time=c(5,7,1,8,5,8))
DT.goal

До сих пор я придумал следующую незавершенную попытку:

DT.test <- DT[start_time <= shift(stop_time, 1L, type="lag"), 
          cond := T, by=person]
DT.test <- DT.test[cond==T, 
          new_activity := paste(activity, shift(activity, 1L, type="lag")), by=person]
DT.test <- DT.test[, new_start := start_time, by=person][cond==T, new_start := min(start_time), by=person]
DT.test <- DT.test[, new_stop := stop_time, by=person][cond==T, new_stop := max(stop_time), by=person]

Однако, используяshift(, type="lag) не очень полезен для первого ряда для каждого человека, так как теперь у него есть предыдущий ряд для просмотра. Кроме того, paste() вставляет NA, если условие не оценивается как TRUE.

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

Answer 1

Пожалуйста, проверьте следующее:

library(data.table)
DT <- data.table(person=c(1,1,1,1,2,2,2,2,2,3,3,3,3),
                 activity=c("grab", "walk", "remove", "delete", "run", "talk", "walk", "remove",
                            "grab", "walk", "delete", "talk", "remove"),
                 start_time=c(0,1,3,6,0,2,2,3,3,3,6,6,7), stop_time=c(1,3,5,7,1,4,4,8,4,5,7,7,8))

setorder(DT, person, start_time)
DT[, concatenate := start_time %in% stop_time | stop_time %in% start_time | duplicated(start_time) | duplicated(start_time, fromLast=TRUE), by = "person"]
DT[, concatenate_grp := rleid(concatenate), by = "person"]
DT[, paste(activity, collapse = " + "), by = c("person", "concatenate_grp")]
DT.goal <- DT[, .(activity = paste(activity, collapse = " + "), start_time = min(start_time), stop_time = max(stop_time)), by = c("person", "concatenate_grp")][, concatenate_grp := NULL]

Что приводит к:

   person                    activity start_time stop_time
1:      1        grab + walk + remove          0         5
2:      1                      delete          6         7
3:      2                         run          0         1
4:      2 talk + walk + remove + grab          2         8
5:      3                        walk          3         5
6:      3      delete + talk + remove          6         8

Answer 2

Другой вариант, заимствуя идею из решения Дэвида Ауренбурга из здесь

setorder(DT, person, start_time, stop_time)
DT[, g := c(0L, cumsum(shift(start_time, -1L) > cummax(stop_time))[-.N]), person]
DT[, .(activity=paste(activity, collapse=" + "), 
        start_time=min(start_time), stop_time=max(stop_time)), 
    .(person, g)]

output:

   person g                    activity start_time stop_time
1:      1 0        grab + walk + remove          0         5
2:      1 1                      delete          6         7
3:      2 0                         run          0         1
4:      2 1 talk + walk + grab + remove          2         8
5:      3 0                        walk          3         5
6:      3 1      delete + talk + remove          6         8

Answer 3

setorder(DT, person, stop_time)
DT[, 
   break_here := start_time > shift(stop_time, 1, stop_time[1]) , 
   by = person
   ][, 
     .(activity = paste(activity, collapse = " + "), start_time = start_time[1], stop_time = stop_time[.N]), 
     keyby = .(person, helper_var = cumsum(break_here))
     ][, !"helper_var"]


   person                    activity start_time stop_time
1:      1        grab + walk + remove          0         5
2:      1                      delete          6         7
3:      2                         run          0         1
4:      2 talk + walk + grab + remove          2         8
5:      3                        walk          3         5
6:      3      delete + talk + remove          6         8

Answer 4

Используя dplyr, мы arrange получаем данные person и время запуска и остановки. Мы создаем group, где время перекрывается для каждого person, и выбираем first start_time и last stop_time в каждой группе и объединяем все действия в каждой группе.

library(dplyr)

DT %>%
  arrange(person, start_time, stop_time) %>%
  group_by(person, group = cumsum(start_time > 
                lag(stop_time, default = first(stop_time)))) %>%
  summarise(start_time = first(start_time), 
            stop_time = last(stop_time), 
            activity = paste(activity, collapse = " + ")) %>%
  select(-group)

#  person start_time stop_time activity                   
#   <dbl>      <dbl>     <dbl> <chr>                      
#1      1          0         5 grab + walk + remove       
#2      1          6         7 delete                     
#3      2          0         1 run                        
#4      2          2         8 talk + walk + grab + remove
#5      3          3         5 walk                       
#6      3          6         8 delete + talk + remove