In einem großen Datensatz (~ 1 Million Fälle) hat jeder Fall ein "erstelltes" und ein "zensiertes"dateTime. Ich möchte die Anzahl der anderen Fälle zählen, die zum Zeitpunkt der Erstellung der einzelnen Fälle geöffnet waren. Fälle sind offen zwischen "erstellt" und "zensiert"dataTimes.

Mehrere Lösungen eignen sich gut für kleine Datensätze (<100.000 Fälle), aber die Rechenzeit nimmt exponentiell zu. Meine Schätzung ist, dass sich die Rechenzeit als Funktion 3n ^ 2 erhöht. In n = 100.000 Fällen beträgt die Rechenzeit auf meinem Server mit 6 * 4-GHz-Kernen und 64 GB RAM> 20 Minuten. Selbst mit Multi-Core-Bibliotheken könnte ich die Zeit bestenfalls um den Faktor 8 oder 10 verkürzen. Nicht genug, um ~ 1 Million Fälle zu bearbeiten.

Ich suche nach einer effizienteren Methode, um diese Berechnung durchzuführen. Im Folgenden habe ich eine Funktion bereitgestellt, mit der Sie auf einfache Weise eine große Anzahl von "erstellten" und "zensierten" @ erstellen könnedateTime Paare zusammen mit zwei bisher ausprobierten Lösungen unter Verwendung vondplyr unddata.table Bibliotheken. Die Timings werden dem Benutzer zur Vereinfachung mitgeteilt. Sie können einfach die Variable "CASE_COUNT" oben ändern, um die Zeiten erneut auszuführen und anzuzeigen und das Timing anderer Lösungen zu vergleichen, die Sie möglicherweise vorschlagen müssen.

Ich werde den ursprünglichen Beitrag mit anderen Lösungen aktualisieren, um den Autoren die gebührende Ehre zu erweisen. Vielen Dank im Voraus für Ihre Hilfe!

# 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");

Dasdata.table::foverlaps()ie @ -Lösung ist in weniger Fällen schneller (<5000 oder so; hängt von der Zufälligkeit zusätzlich zu n ab, da die Optimierung über die binäre Suche erfolgt). Dasdplyr::summarize()ie @ -Lösung ist schneller für mehr Fälle (> 5.000 oder so). Bei weitem über 100.000 ist keine der beiden Lösungen realisierbar, da beide zu langsam sind.

EDIT: Es wurde eine dritte Lösung hinzugefügt, die auf der von @jangorecki vorgeschlagenen Idee basiert und @ verwendedata.table Aggregation anstelle vondplyr::summarize() und ist ansonsten dem @ ähnlidplyr Lösung. Für bis zu 50.000 Fälle ist es die schnellste Lösung. Über 50.000 Fälle hinaus hat dasdplyr::summarize() Lösung ist etwas schneller, aber nicht viel. Leider ist dies für 1 Million Fälle immer noch nicht praktikabel.

EDIT2: Es wurde eine vierte Lösung hinzugefügt, die von der von @alexis_laz vorgeschlagenen Lösung abgeleitet ist und die @ verwendeIRanges package und seincountOverlaps Funktion. Es ist deutlich schneller als die 3 anderen Lösungen. Mit 50.000 Fällen war es fast 400% schneller als die Lösungen 1 und 3.

EDIT3: Die Funktion zur Erzeugung von Groß- und Kleinschreibung wurde geändert, um die "zensierte" Bedingung ordnungsgemäß zu erfüllen. Vielen Dank an @jangorecki, der die Einschränkungen der Vorgängerversion abgefangen hat.

EDIT4: Neu geschrieben, um dem Benutzer die Auswahl der auszuführenden und zu verwendenden Lösungen zu ermöglichen.system.time() für den zeitlichen Vergleich mit der Speicherbereinigung vor jeder Ausführung zur genaueren zeitlichen Steuerung (gemäß @ jangoreckis scharfsinniger Beobachtung) - Außerdem wurden einige Bedingungsprüfungen für Absturzfälle hinzugefügt.

EDIT5: Es wurde eine fünfte Lösung hinzugefügt, die der von @ danas.zuokas vorgeschlagenen Lösung mit @ angepasst wurdrank(). Meine Experimente legen nahe, dass es immer mindestens eine Größenordnung langsamer ist als die anderen Lösungen. Bei 10.000 Fällen dauert es 44 Sekunden gegenüber 3,5 Sekunden fürdplyr::summarize und 0,36 Sekunden fürIRanges solutions.

FINAL EDIT: Ich habe geringfügige Änderungen an Lösung 5 vorgenommen, die von @ danas.zuokas vorgeschlagen wurden, und die der Beobachtung von @ Khashaa über Typen entsprechen. Ich habe den Typ @ eingestelas.numeric in demdataTime Generierungsfunktion, die drastisch beschleunigtrank wie es funktioniert aufintegers oderdoubles Anstatt vondateTime objects (erhöht die Geschwindigkeit anderer Funktionen, aber nicht so drastisch). Bei einigen Tests wird das Setzen vonties.method='first' ergibt Ergebnisse, die mit der Absicht übereinstimmen.data.table::frank ist schneller als beidebase::rank undIRanges::rank. bit64::rank ist am schnellsten, scheint aber anders mit Bindungen umzugehen alsdata.table::frank und ich kann es nicht dazu bringen, sie wie gewünscht zu behandeln. Einmalbit64 wird geladen, maskiert eine große Anzahl von Typen und Funktionen und ändert die Ergebnisse vondata.table::frank nach dem Weg. Die konkreten Gründe dafür sprengen den Rahmen dieser Frage.

POST END HINWEIS: Stellt sich heraus, dassdata.table::frank behandeltPOSIXct dateTimes effizient, während wederbase::rank NochIRanges::rank scheint. Selbst dasas.numeric (oderas.integer) Typeinstellung ist bei @ nicht erforderlidata.table::frank und es gibt keinen Präzisionsverlust durch die Konvertierung, daher gibt es wenigerties.method Unstimmigkeiten. Vielen Dank an alle, die dazu beigetragen haben! Ich habe viel gelernt! Sehr geschätzt! :) Das Guthaben wird in meinen Quellcode aufgenommen.

ENDNOTE: Diese Frage ist eine verfeinerte und geklärte Version von @, die benutzerfreundlicher und lesbarer isMehr effiziente Methode zum Zählen offener Fälle ab dem Erstellungszeitpunkt jedes Falls - Ich habe es hier getrennt, um den ursprünglichen Beitrag nicht mit zu vielen Bearbeitungen zu überfordern und die Erstellung einer großen Anzahl von @ zu vereinfachedataTime Paare im Beispielcode. Auf diese Weise müssen Sie nicht so hart arbeiten, um zu antworten. Danke noch einmal