Мне интересно, есть ли эффективное решение 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, так как количество сотрудников довольно велико.
Одно возможное решение с 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")
Что произойдет, если 2 emp не перекрываются, например data.table(emp = c(1,2,3),start_time = c(90,90,1540),duration = c(480, 480,480 ))
?
@Waldi Я понимаю вашу точку зрения, но в этом случае (смена сотрудников) это работает быстрее; однако ваше решение лучше. Добавил текст над моим ответом.
Спасибо за подробный отчет и предложения.