From d9126839cd9eee135f0f5e4ac74afe05713fda34 Mon Sep 17 00:00:00 2001 From: yun Date: Mon, 6 Nov 2023 18:15:26 +0800 Subject: [PATCH] Don't copy whole data --- R/merge.R | 52 ++++++++++++++++++------------------- tests/testthat/test_merge.R | 4 +++ 2 files changed, 29 insertions(+), 27 deletions(-) diff --git a/R/merge.R b/R/merge.R index eeb11fe..7f048dc 100644 --- a/R/merge.R +++ b/R/merge.R @@ -45,47 +45,45 @@ methods::setMethod("faers_merge", "FAERSascii", function(object, fields = NULL, lst <- faers_mget(object, fields = fields) # indi_reference: check if we need copy indi # to prevent modify in place (change the input object) - if (object@standardization && all(c("indi", "reac") %in% fields)) { - hierarchy_columns <- c( - meddra_columns(meddra_hierarchy_fields), - "meddra_hierarchy_from", "meddra_code", "meddra_pt" - ) - lst$indi <- data.table::copy(lst$indi) + if (object@standardization) { indi_reference <- FALSE - data.table::setnames( - lst$indi, hierarchy_columns, - function(x) paste("indi", x, sep = "_"), - skip_absent = TRUE - ) - lst$reac <- data.table::copy(lst$reac) - data.table::setnames( - lst$reac, hierarchy_columns, - function(x) paste("reac", x, sep = "_"), - skip_absent = TRUE - ) + if (all(c("indi", "reac") %in% fields)) { + hierarchy_columns <- c( + meddra_columns(meddra_hierarchy_fields), + "meddra_hierarchy_from", "meddra_code", "meddra_pt" + ) + data.table::setnames( + lst$indi, hierarchy_columns, + function(x) paste("indi", x, sep = "_") + ) + data.table::setnames( + lst$reac, hierarchy_columns, + function(x) paste("reac", x, sep = "_") + ) + } } else { indi_reference <- TRUE } - # check if drug_seq should be matched + # check if `drug_seq` should be matched if (sum(fields %in% c("indi", "ther", "drug")) >= 2L) { if (any(fields == "indi")) { - if (indi_reference) lst$indi <- data.table::copy(lst$indi) - data.table::setnames(lst$indi, "indi_drug_seq", "drug_seq") + if (indi_reference) { + lst$indi$drug_seq <- lst$indi$indi_drug_seq + lst$indi$indi_drug_seq <- NULL + } else { + data.table::setnames(lst$indi, "indi_drug_seq", "drug_seq") + } } if (any(fields == "ther")) { - lst$ther <- data.table::copy(lst$ther) - data.table::setnames(lst$ther, "dsg_drug_seq", "drug_seq") + lst$ther$drug_seq <- lst$ther$dsg_drug_seq + lst$ther$dsg_drug_seq <- NULL } } - Reduce(function(x, y) { if (has_name(y, "caseid") && has_name(x, "caseid")) { - y <- y[, .SD, .SDcols = !"caseid"] + y <- y[, !"caseid"] } - # y[x, on = intersect(names(x), names(y)), - # allow.cartesian = TRUE - # ] merge(x, y, by = intersect(names(x), names(y)), allow.cartesian = TRUE, sort = FALSE, diff --git a/tests/testthat/test_merge.R b/tests/testthat/test_merge.R index 83a1188..08ade45 100644 --- a/tests/testthat/test_merge.R +++ b/tests/testthat/test_merge.R @@ -4,6 +4,10 @@ testthat::test_that("`faers_merge` for FAERS ascii data works well", { dir = internal_file("extdata"), compress_dir = tempdir() ) + # demo and drug + demo_drug <- faers_merge(data, c("demo", "drug")) + testthat::expect_s3_class(demo_drug, "data.table") + # internal don't modify data by reference and drug_seq match well raw_indi <- data.table::copy(data$indi) raw_ther <- data.table::copy(data$ther)