Don't copy whole data

Yunuuuu · Nov 6, 2023 · d912683 · d912683
1 parent c6fa4a4
commit d912683
Show file tree

Hide file tree

Showing 2 changed files with 29 additions and 27 deletions.
diff --git 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
@@ -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)