【发布时间】：2016-03-18 15:36:52
【问题描述】：
在一个大型数据集（约 100 万个案例）中，每个案例都有一个“创建”和一个“审查”dateTime。我想计算每个案例创建时打开的其他案例的数量。案例在其“创建”和“审查”dataTimes 之间处于开放状态。
一些解决方案在小型数据集（
我正在寻找一种更有效的方法来进行此计算。下面我提供了一个函数，可以让您轻松创建大量“已创建”和“已审查”dateTime 对以及迄今为止尝试的两种解决方案，使用 dplyr 和 data.table 库。为简单起见，将时间报告给用户。您只需更改顶部的“CASE_COUNT”变量即可重新执行和再次查看时间，并轻松比较您可能需要建议的其他解决方案的时间。
我将使用其他解决方案更新原始帖子，以适当地感谢他们的作者。在此先感谢您的帮助！
# Load libraries used in this example
library(dplyr);
library(data.table);
# Not on CRAN. See: http://bioconductor.org/packages/release/bioc/html/IRanges.html
library(IRanges);
# Set seed for reproducibility
set.seed(123)
# Set number of cases & date range variables
CASE_COUNT <<- 1000;
RANGE_START <- as.POSIXct("2000-01-01 00:00:00",
format="%Y-%m-%d %H:%M:%S",
tz="UTC", origin="1970-01-01");
RANGE_END <- as.POSIXct("2012-01-01 00:00:00",
format="%Y-%m-%d %H:%M:%S",
tz="UTC", origin="1970-01-01");
# Select which solutions you want to run in this test
RUN_SOLUTION_1 <- TRUE; # dplyr::summarize() + comparisons
RUN_SOLUTION_2 <- TRUE; # data.table:foverlaps()
RUN_SOLUTION_3 <- TRUE; # data.table aggregation + comparisons
RUN_SOLUTION_4 <- TRUE; # IRanges::IRanges + countOverlaps()
RUN_SOLUTION_5 <- TRUE; # data.table::frank()
# Function to generate random creation & censor dateTime pairs
# The censor time always has to be after the creation time
# Credit to @DirkEddelbuettel for this smart function
# (https://stackoverflow.com/users/143305/dirk-eddelbuettel)
generate_cases_table <- function(n = CASE_COUNT, start_val=RANGE_START, end_val=RANGE_END) {
# Measure duration between start_val & end_val
duration <- as.numeric(difftime(end_val, start_val, unit="secs"));
# Select random values in duration to create start_offset
start_offset <- runif(n, 0, duration);
# Calculate the creation time list
created_list <- start_offset + start_val;
# Calculate acceptable time range for censored values
# since they must always be after their respective creation value
censored_range <- as.numeric(difftime(RANGE_END, created_list, unit="secs"));
# Select random values in duration to create end_offset
creation_to_censored_times <- runif(n, 0, censored_range);
censored_list <- created_list + creation_to_censored_times;
# Create and return a data.table with creation & censor values
# calculated from start or end with random offsets
return_table <- data.table(id = 1:n,
created = created_list,
censored = censored_list);
return(return_table);
}
# Create the data table with the desired number of cases specified by CASE_COUNT above
cases_table <- generate_cases_table();
solution_1_function <- function (cases_table) {
# SOLUTION 1: Using dplyr::summarize:
# Group by id to set parameters for summarize() function
cases_table_grouped <- group_by(cases_table, id);
# Count the instances where other cases were created before
# and censored after each case using vectorized sum() within summarize()
cases_table_summary <- summarize(cases_table_grouped,
open_cases_at_creation = sum((cases_table$created < created &
cases_table$censored > created)));
solution_1_table <<- as.data.table(cases_table_summary, key="id");
} # End solution_1_function
solution_2_function <- function (cases_table) {
# SOLUTION 2: Using data.table::foverlaps:
# Adapted from solution provided by @Davidarenburg
# (https://stackoverflow.com/users/3001626/david-arenburg)
# The foverlaps() solution tends to crash R with large case counts
# I suspect it has to do with memory assignment of the very large objects
# It maxes RAM on my system (64GB) before crashing, possibly attempting
# to write beyond its assigned memory limits.
# I'll submit a reproduceable bug to the data.table team since
# foverlaps() is pretty new and known to be occasionally unstable
if (CASE_COUNT > 50000) {
stop("The foverlaps() solution tends to crash R with large case counts. Not running.");
}
setDT(cases_table)[, created_dupe := created];
setkey(cases_table, created, censored);
foverlaps_table <- foverlaps(cases_table[,c("id","created","created_dupe"), with=FALSE],
cases_table[,c("id","created","censored"), with=FALSE],
by.x=c("created","created_dupe"))[order(i.id),.N-1,by=i.id];
foverlaps_table <- dplyr::rename(foverlaps_table, id=i.id, open_cases_at_creation=V1);
solution_2_table <<- as.data.table(foverlaps_table, key="id");
} # End solution_2_function
solution_3_function <- function (cases_table) {
# SOLUTION 3: Using data.table aggregation instead of dplyr::summarize
# Idea suggested by @jangorecki
# (https://stackoverflow.com/users/2490497/jangorecki)
# Count the instances where other cases were created before
# and censored after each case using vectorized sum() with data.table aggregation
cases_table_aggregated <- cases_table[order(id), sum((cases_table$created < created &
cases_table$censored > created)),by=id];
solution_3_table <<- as.data.table(dplyr::rename(cases_table_aggregated, open_cases_at_creation=V1), key="id");
} # End solution_3_function
solution_4_function <- function (cases_table) {
# SOLUTION 4: Using IRanges package
# Adapted from solution suggested by @alexis_laz
# (https://stackoverflow.com/users/2414948/alexis-laz)
# The IRanges package generates ranges efficiently, intended for genome sequencing
# but working perfectly well on this data, since POSIXct values are numeric-representable
solution_4_table <<- data.table(id = cases_table$id,
open_cases_at_creation = countOverlaps(IRanges(cases_table$created,
cases_table$created),
IRanges(cases_table$created,
cases_table$censored))-1, key="id");
} # End solution_4_function
solution_5_function <- function (cases_table) {
# SOLUTION 5: Using data.table::frank()
# Adapted from solution suggested by @danas.zuokas
# (https://stackoverflow.com/users/1249481/danas-zuokas)
n <- CASE_COUNT;
# For every case compute the number of other cases
# with `created` less than `created` of other cases
r1 <- data.table::frank(c(cases_table[, created], cases_table[, created]), ties.method = 'first')[1:n];
# For every case compute the number of other cases
# with `censored` less than `created`
r2 <- data.table::frank(c(cases_table[, created], cases_table[, censored]), ties.method = 'first')[1:n];
solution_5_table <<- data.table(id = cases_table$id,
open_cases_at_creation = r1 - r2, key="id");
} # End solution_5_function;
# Execute user specified functions;
if (RUN_SOLUTION_1)
solution_1_timing <- system.time(solution_1_function(cases_table));
if (RUN_SOLUTION_2) {
solution_2_timing <- try(system.time(solution_2_function(cases_table)));
cases_table <- select(cases_table, -created_dupe);
}
if (RUN_SOLUTION_3)
solution_3_timing <- system.time(solution_3_function(cases_table));
if (RUN_SOLUTION_4)
solution_4_timing <- system.time(solution_4_function(cases_table));
if (RUN_SOLUTION_5)
solution_5_timing <- system.time(solution_5_function(cases_table));
# Check generated tables for comparison
if (RUN_SOLUTION_1 && RUN_SOLUTION_2 && class(solution_2_timing)!="try-error") {
same_check1_2 <- all(solution_1_table$open_cases_at_creation == solution_2_table$open_cases_at_creation);
} else {same_check1_2 <- TRUE;}
if (RUN_SOLUTION_1 && RUN_SOLUTION_3) {
same_check1_3 <- all(solution_1_table$open_cases_at_creation == solution_3_table$open_cases_at_creation);
} else {same_check1_3 <- TRUE;}
if (RUN_SOLUTION_1 && RUN_SOLUTION_4) {
same_check1_4 <- all(solution_1_table$open_cases_at_creation == solution_4_table$open_cases_at_creation);
} else {same_check1_4 <- TRUE;}
if (RUN_SOLUTION_1 && RUN_SOLUTION_5) {
same_check1_5 <- all(solution_1_table$open_cases_at_creation == solution_5_table$open_cases_at_creation);
} else {same_check1_5 <- TRUE;}
if (RUN_SOLUTION_2 && RUN_SOLUTION_3 && class(solution_2_timing)!="try-error") {
same_check2_3 <- all(solution_2_table$open_cases_at_creation == solution_3_table$open_cases_at_creation);
} else {same_check2_3 <- TRUE;}
if (RUN_SOLUTION_2 && RUN_SOLUTION_4 && class(solution_2_timing)!="try-error") {
same_check2_4 <- all(solution_2_table$open_cases_at_creation == solution_4_table$open_cases_at_creation);
} else {same_check2_4 <- TRUE;}
if (RUN_SOLUTION_2 && RUN_SOLUTION_5 && class(solution_2_timing)!="try-error") {
same_check2_5 <- all(solution_2_table$open_cases_at_creation == solution_5_table$open_cases_at_creation);
} else {same_check2_5 <- TRUE;}
if (RUN_SOLUTION_3 && RUN_SOLUTION_4) {
same_check3_4 <- all(solution_3_table$open_cases_at_creation == solution_4_table$open_cases_at_creation);
} else {same_check3_4 <- TRUE;}
if (RUN_SOLUTION_3 && RUN_SOLUTION_5) {
same_check3_5 <- all(solution_3_table$open_cases_at_creation == solution_5_table$open_cases_at_creation);
} else {same_check3_5 <- TRUE;}
if (RUN_SOLUTION_4 && RUN_SOLUTION_5) {
same_check4_5 <- all(solution_4_table$open_cases_at_creation == solution_5_table$open_cases_at_creation);
} else {same_check4_5 <- TRUE;}
same_check <- all(same_check1_2, same_check1_3, same_check1_4, same_check1_5,
same_check2_3, same_check2_4, same_check2_5, same_check3_4,
same_check3_5, same_check4_5);
# Report summary of results to user
cat("This execution was for", CASE_COUNT, "cases.\n",
"It is", same_check, "that all solutions match.\n");
if (RUN_SOLUTION_1)
cat("The dplyr::summarize() solution took", solution_1_timing[3], "seconds.\n");
if (RUN_SOLUTION_2 && class(solution_2_timing)!="try-error")
cat("The data.table::foverlaps() solution took", solution_2_timing[3], "seconds.\n");
if (RUN_SOLUTION_3)
cat("The data.table aggregation solution took", solution_3_timing[3], "seconds.\n");
if (RUN_SOLUTION_4)
cat("The IRanges solution solution took", solution_4_timing[3], "seconds.\n");
if (RUN_SOLUTION_5)
cat("The data.table:frank() solution solution took", solution_5_timing[3], "seconds.\n\n");
data.table::foverlaps() 解决方案在更少的情况下更快（dplyr::summarize() 解决方案对于更多情况（> 5,000 左右）更快。远远超过 100,000，这两种解决方案都不可行，因为它们都太慢了。
编辑：根据@jangorecki 建议的想法添加了第三个解决方案，它使用data.table 聚合而不是dplyr::summarize()，在其他方面类似于dplyr 解决方案。对于多达约 50,000 个案例，它是最快的解决方案。超过 50,000 个案例时，dplyr::summarize() 解决方案会稍微快一些，但不会快很多。可悲的是，对于 100 万个案例，它仍然不实用。
EDIT2：添加了根据@alexis_laz 建议的解决方案改编的第四个解决方案，该解决方案使用IRanges 包及其countOverlaps 函数。
它比其他 3 种解决方案要快得多。在 50,000 个案例中，它比解决方案 1 和 3 快了近 400%。
EDIT3：修改案例生成函数以正确执行“审查”条件。感谢@jangorecki 发现了之前版本的限制。
EDIT4：重写以允许用户选择要执行的解决方案并使用system.time() 在每次执行之前与垃圾收集进行时间比较，以获得更准确的时间（根据@jangorecki 的敏锐观察） - 还添加了一些条件检查以防止崩溃案例。
EDIT5：添加了第五个解决方案，该解决方案改编自@danas.zuokas 使用rank() 建议的解决方案。我的实验表明，它总是至少比其他解决方案慢一个数量级。在 10,000 个案例中，dplyr::summarize 需要 44 秒，而IRanges 解决方案需要 3.5 秒和 0.36 秒。
最终编辑：我对@danas.zuokas 建议的解决方案 5 进行了轻微修改，并与@Khashaa 关于类型的观察相匹配。我在dataTime 生成函数中设置了as.numeric 类型，它大大加快了rank，因为它在integers 或doubles 而不是dateTime 对象上运行（也提高了其他函数的速度，但不是一样剧烈）。通过一些测试，设置ties.method='first' 会产生与意图一致的结果。 data.table::frank 比 base::rank 和 IRanges::rank 都快。 bit64::rank 最快，但它处理关系的方式似乎与data.table::frank 不同，我无法让它按需要处理它们。一旦bit64 被加载，它会屏蔽大量的类型和函数，同时改变data.table::frank 的结果。具体原因超出了本题的范围。
POST END NOTE: 结果表明data.table::frank 可以有效地处理POSIXct dateTimes，而base::rank 和IRanges::rank 似乎都没有。因此，即使as.numeric（或as.integer）类型设置对于data.table::frank 也不是必需的，并且转换不会损失精度，因此ties.method 差异更少。
感谢所有贡献的人！我学到了很多！非常感激！ :)
信用将包含在我的源代码中。
ENDNOTE：这个问题是一个精炼和清晰的版本，具有更易于使用和更易读的示例代码，More efficient method for counting open cases as of creation time of each case - 我在这里将其分开，以免过多的编辑压倒原始帖子并简化创建示例代码中有大量 dataTime 对。这样，您就不必费力地回答。再次感谢！
【问题讨论】：
-
@RichardScrivens - Khashaa 的解决方案有效，所以我给了他一个支持。但它并没有解决效率问题，所以它并没有真正回答这个问题。话虽如此，我确实想认可他的工作，所以我现在也将原始问题的答案归功于他。我希望这是合适的？
-
将数据集拆分成更小的块？
-
你尝试过data.table聚合吗？它应该与
dplyr::summarize一样，对于大量组，您应该获得更大的加速。 -
顺便说一句。如果要比较时间，请使用
system.time而不是Sys.time。 -
对于这个问题，可能很适合用C代码试试；即使是幼稚的实现也应该比任何其他方法（包括并行计算）都快。 （顺便说一句，请随意构建一个紧凑的答案，将所有信息收集在一个地方；尽管您在此 Q 中付出了所有努力，但如果我发布 2 行答案会感觉有点尴尬.. :-)）
标签： r performance data.table dplyr vectorization