Поиск перекрывающихся единиц на основе времени начала и окончания

Мне интересно, есть ли эффективное решение data.table для следующей проблемы.

Предположим, что у меня есть следующий набор данных:

library(data.table)


DT <- data.table(emp = c(1,2,3),
                 start_time = c(90,90,540),
                 duration = c(480, 480,480 ))

DT[, end_time := start_time + duration]

который выглядит так:

     emp   start_time duration end_time
   <num>      <num>    <num>    <num>
1:     1         90      480      570
2:     2         90      480      570
3:     3        540      480     1020

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

     emp emp_1 emp_2 emp_3
   <num> <num> <num> <num>
1:     1   480   480    30
2:     2   480   480    30
3:     3    30    30   480

где столбцы основаны на полном наборе сотрудников.

Я ищу решение для data.table, так как количество сотрудников довольно велико.

Стоит ли изучать PHP в 2023-2024 годах?
Стоит ли изучать PHP в 2023-2024 годах?
Привет всем, сегодня я хочу высказать свои соображения по поводу вопроса, который я уже много раз получал в своем сообществе: "Стоит ли изучать PHP в...
Поведение ключевого слова "this" в стрелочной функции в сравнении с нормальной функцией
Поведение ключевого слова "this" в стрелочной функции в сравнении с нормальной функцией
В JavaScript одним из самых запутанных понятий является поведение ключевого слова "this" в стрелочной и обычной функциях.
Приемы CSS-макетирования - floats и Flexbox
Приемы CSS-макетирования - floats и Flexbox
Здравствуйте, друзья-студенты! Готовы совершенствовать свои навыки веб-дизайна? Сегодня в нашем путешествии мы рассмотрим приемы CSS-верстки - в...
Тестирование функциональных ngrx-эффектов в Angular 16 с помощью Jest
В системе управления состояниями ngrx, совместимой с Angular 16, появились функциональные эффекты. Это здорово и делает код определенно легче для...
Концепция локализации и ее применение в приложениях React ⚡️
Концепция локализации и ее применение в приложениях React ⚡️
Локализация - это процесс адаптации приложения к различным языкам и культурным требованиям. Это позволяет пользователям получить опыт, соответствующий...
Пользовательский скаляр GraphQL
Пользовательский скаляр GraphQL
Листовые узлы системы типов GraphQL называются скалярами. Достигнув скалярного типа, невозможно спуститься дальше по иерархии типов. Скалярный тип...
2
0
91
2
Перейти к ответу Данный вопрос помечен как решенный

Ответы 2

Одно возможное решение с foverlaps и dcast:

library(data.table)

#Key needed for foverlaps
setkey(DT,start_time,end_time)

dcast(foverlaps(DT,DT)[,ol:=pmin(end_time,i.end_time)-pmax(start_time,i.start_time)],
      emp~i.emp,value.var = "ol")

Key: <emp>
     emp     1     2     3
   <num> <num> <num> <num>
1:     1   480   480    30
2:     2   480   480    30
3:     3    30    30   480
Ответ принят как подходящий

Использование pmin и pmax с моим методом перекрестного соединения является самым быстрым; однако другой ответ лучше обрабатывает исключения и не сильно отстает от моего с точки зрения производительности.

dcast(setkey(DT[,c(k=1,.SD)],k)[
  setNames(DT, paste0(names(DT), '_2'))[,c(k=1,.SD)],allow.cartesian=TRUE][,k:=NULL][ , 
          overlap :=  pmin(end_time,end_time_2)-pmax(start_time,start_time_2)],
  emp~ emp_2, value.var = "overlap")

Ориентир:

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

library(data.table)
library(DescTools)
library(dplyr)
library(tidyr)

set.seed(123)
DT <- data.table(emp = 1:100,
                 start_time = sample.int(1000, 100),
                 duration = sample.int(1000, 100) + 1000)

DT[, end_time := start_time + duration]

DT2 <- copy(DT)
DT3 <- copy(DT)
DT4 <- copy(DT)


WvM <- microbenchmark::microbenchmark(

M_DT_Desc = dcast(setkey(DT2[,c(k=1,.SD)],k)[
      setNames(DT2, paste0(names(DT2), '_2'))[,c(k=1,.SD)],allow.cartesian=TRUE][,k:=NULL][ , 
         overlap :=  Overlap(c(start_time , end_time), c(start_time_2, end_time_2)), 
                                                                            by = 1:NROW(DT2)^2],
          emp~ emp_2, value.var = "overlap"),


M_DT_pminmax = dcast(setkey(DT2[,c(k=1,.SD)],k)[
  setNames(DT2, paste0(names(DT2), '_2'))[,c(k=1,.SD)],allow.cartesian=TRUE][,k:=NULL][ , 
          overlap :=  pmin(end_time,end_time_2)-pmax(start_time,start_time_2)],
  emp~ emp_2, value.var = "overlap"),


M_foverlap_Desc = {setkey(DT3,start_time,end_time);dcast(foverlaps(DT3,DT3)[, irow := .I][,
                    overlap :=  Overlap(c(start_time , end_time), c(i.start_time, i.end_time)), 
                                                                              by = irow],
            emp~i.emp,value.var = "overlap")},


M_dplyr_Desc = DT4 %>% 
  setNames(paste0(names(.), '_2')) %>% 
  crossing(DT4, .) %>% 
  rowwise() %>%
  mutate(overlap = Overlap(c(start_time , end_time), c(start_time_2, end_time_2))) %>%
  ungroup() %>% 
  pivot_wider(id_cols = "emp", names_from = "emp_2", values_from = "overlap"),


M_dplyr_pminmax = DT4 %>% 
  setNames(paste0(names(.), '_2')) %>% 
  crossing(DT4, .) %>% 
  rowwise() %>%
  mutate(overlap = pmin(end_time,end_time_2)-pmax(start_time,start_time_2)) %>%
  ungroup() %>% 
  pivot_wider(id_cols = "emp", names_from = "emp_2", values_from = "overlap"),


Waldi  = {setkey(DT,start_time,end_time); dcast(foverlaps(DT,DT)[,
                  ol:=pmin(end_time,i.end_time)-pmax(start_time,i.start_time)],
      emp~i.emp,value.var = "ol")},

times = 10)
Unit: milliseconds
            expr       min        lq       mean    median        uq       max neval
       M_DT_Desc  967.6728  992.4321 1063.98096 1053.6871 1093.5663 1258.7258    10
    M_DT_pminmax    7.3910    8.3103    8.86385    8.4347    9.8666   10.5503    10
 M_foverlap_Desc  966.2051 1001.8745 1043.72299 1034.6016 1095.6339 1128.2970    10
    M_dplyr_Desc 1040.0847 1060.8663 1132.24239 1101.4212 1150.1816 1444.9537    10
 M_dplyr_pminmax  168.4051  172.5951  185.10149  179.1346  197.1055  223.4941    10
           Waldi    8.5117    9.3202   10.54267    9.6550   10.2424   17.6923    10

Оригинальный ответ:

Вот еще один подход к перекрестному соединению и получению перекрытий с использованием пакета DescTools.

library(data.table)
library(DescTools)

dcast(setkey(DT[,c(k=1,.SD)],k)[
        setNames(DT, paste0(names(DT), '_2'))[,c(k=1,.SD)],allow.cartesian=TRUE][,k:=NULL][ , 
              overlap :=  DescTools::Overlap(c(start_time , end_time), c(start_time_2, end_time_2)), 
                by = 1:NROW(DT)^2],
      emp~ emp_2, value.var = "overlap")

Спасибо за подробный отчет и предложения.

plausibly_exogenous 15.11.2022 02:15

Что произойдет, если 2 emp не перекрываются, например data.table(emp = c(1,2,3),start_time = c(90,90,1540),duration = c(480, 480,480 ))?

Waldi 16.11.2022 19:29

@Waldi Я понимаю вашу точку зрения, но в этом случае (смена сотрудников) это работает быстрее; однако ваше решение лучше. Добавил текст над моим ответом.

M-- 16.11.2022 21:40

Другие вопросы по теме