add faers_mget

NAMESPACE

@@ -14,6 +14,7 @@ export(faers_keep)
 export(faers_meddra)
 export(faers_merge)
 export(faers_meta)
+export(faers_mget)
 export(faers_parse)
 export(faers_period)
 export(faers_phv_signal)
@@ -42,6 +43,7 @@ exportMethods(faers_header)
 exportMethods(faers_keep)
 exportMethods(faers_meddra)
 exportMethods(faers_merge)
+exportMethods(faers_mget)
 exportMethods(faers_period)
 exportMethods(faers_primaryid)
 exportMethods(faers_quarter)

R/dedup.R

@@ -31,7 +31,10 @@ methods::setMethod("faers_dedup", "FAERSascii", function(object, remove_deleted_
     deduplicated_data <- do.call(
         dedup_faers_ascii,
         list(
-            data = object[c("demo", "drug", "indi", "ther", "reac")],
+            data = faers_mget(
+                object,
+                c("demo", "drug", "indi", "ther", "reac")
+            ),
             deleted_cases = deleted_cases
         )
     )

R/merge.R

@@ -5,7 +5,7 @@
 #' Each pair of field data are merged based on "year", "quarter" and
 #' "primaryid". In cases where any pair of data contains information related to
 #' "drug_seq" elements, such as "drug_seq", "indi_drug_seq", or "dsg_drug_seq",
-#' "drug_seq" will be aligned as well. `use` shall be organized in the
+#' "drug_seq" will be aligned as well. `fields` shall be organized in the
 #' subsequent sequence: 'demo', 'drug', 'indi', 'reac', 'ther', 'rpsr', and
 #' 'outc' and the merging sequence will correspondingly adhere to this order.
 #' Only the initial instance, of the "caseid" column will be preserved.
@@ -17,31 +17,31 @@ methods::setGeneric("faers_merge", function(object, ...) {
     methods::makeStandardGeneric("faers_merge")
 })
 
-#' @param use A character vector specifying the fields to use. If `NULL`, all
-#' fields will be used. Note: You'd better only merge necessary data, otherwise
-#' all fields will consume a lot of memory.
+#' @inheritParams faers_mget
+#' @note You'd better only merge necessary data, otherwise a lot of memory will
+#' be consumed to merge all fields data.
 #' @inheritParams data.table::merge.data.table
 #' @export
 #' @method faers_merge FAERSascii
 #' @rdname faers_merge
-methods::setMethod("faers_merge", "FAERSascii", function(object, use = NULL, all = TRUE, all.x = all, all.y = all) {
-    assert_inclusive(use, faers_ascii_file_fields, null_ok = TRUE)
-    if (is.null(use)) {
-        use <- faers_ascii_file_fields
+methods::setMethod("faers_merge", "FAERSascii", function(object, fields = NULL, all = TRUE, all.x = all, all.y = all) {
+    assert_inclusive(fields, faers_ascii_file_fields, null_ok = TRUE)
+    if (is.null(fields)) {
+        fields <- faers_ascii_file_fields
     } else {
-        use <- intersect(faers_ascii_file_fields, use)
+        fields <- intersect(faers_ascii_file_fields, fields)
     }
 
     # for LAERS, caseid only exist in `demo` data.
     # So we just keep the caseid of `demo`
-    if (length(use) == 1L) {
-        return(object[[use]])
+    if (length(fields) == 1L) {
+        return(faers_get(object, field = fields))
     }
-    lst <- object[use]
+    lst <- faers_mget(object, fields = fields)
     # check if we need copy indi
     # to prevent modify in place (change the input object)
     indi_reference <- TRUE
-    if (object@standardization && all(c("indi", "reac") %in% use)) {
+    if (object@standardization && all(c("indi", "reac") %in% fields)) {
         meddra_columns <- c(
             meddra_hierarchy_infos(meddra_hierarchy_fields),
             "primary_soc_fg", "meddra_hierarchy",
@@ -63,12 +63,12 @@ methods::setMethod("faers_merge", "FAERSascii", function(object, use = NULL, all
     }
 
     # check if drug_seq should be matched
-    if (sum(use %in% c("indi", "ther", "drug")) >= 2L) {
-        if (any(use == "indi")) {
+    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 (any(use == "ther")) {
+        if (any(fields == "ther")) {
             lst$ther <- data.table::copy(lst$ther)
             data.table::setnames(lst$ther, "dsg_drug_seq", "drug_seq")
         }

R/methods-utils.R

@@ -5,9 +5,17 @@
 #' @param ... Other arguments passed to specific methods. For `faers_filter`:
 #' other arguments passed to `.fn`.
 #' @details
-#'  - `faers_get`, `[[`, `$`, and `[`: Extract a specific field
+#'  - `faers_get`: Extract a specific field
+#'    [data.table][data.table::data.table]. For `reac` and `indi` field, meddra
+#'    data will be automatically added if avaliable.
+#'  - `faers_mget`: Extract a list of field
+#'    [data.table][data.table::data.table]. For `reac` and `indi` field, meddra
+#'    data will be automatically added if avaliable.
+#'  - `[[`, `$`, and `[`: Extract a specific field
 #'    [data.table][data.table::data.table] or a list of field
-#'    [data.table][data.table::data.table] from [FAERS] object.
+#'    [data.table][data.table::data.table] from [FAERS] object. Note: this just
+#'    extract field data from `@data` slot directly. For usual usage, just use
+#'    `faers_get` or `faers_mget`.
 #'  - `faers_primaryid`: Extract the `primaryid` from `demo` field.
 #'  - `faers_keep`: only keep data from specified `primaryid`. Note: `year`,
 #'    `quarter`, `deletedCases` will be kept as the original. So make sure you
@@ -23,7 +31,7 @@ methods::setGeneric("faers_get", function(object, ...) {
 
 #' @param field A string indicates the FAERS fields to use. Only values "demo",
 #' "drug", "indi", "ther", "reac", "rpsr", and "outc" can be used. For
-#' `faers_filter`, this filed data will be passed to `.fn` to extract primaryid;
+#' `faers_filter`, this field data will be passed to `.fn` to extract primaryid;
 #' if `NULL`, the `object` will be passed to `.fn` directly.
 #' @export
 #' @method faers_get FAERSascii
@@ -38,6 +46,35 @@ methods::setMethod("faers_get", "FAERSascii", function(object, field) {
     }
 })
 
+#######################################################
+#' @export
+#' @rdname FAERS-methods
+methods::setGeneric("faers_mget", function(object, ...) {
+    methods::makeStandardGeneric("faers_mget")
+})
+
+#' @param fields A character vector specifying the fields to use. Only values
+#' "demo", "drug", "indi", "ther", "reac", "rpsr", and "outc" can be used.
+#' @export
+#' @method faers_mget FAERSascii
+#' @rdname FAERS-methods
+methods::setMethod("faers_mget", "FAERSascii", function(object, fields) {
+    assert_inclusive(fields, faers_ascii_file_fields)
+    out <- object@data[fields]
+    if (object@standardization) {
+        ii <- intersect(names(out), c("indi", "reac"))
+        for (i in ii) {
+            meddra_idx <- out[[i]]$meddra_idx
+            out[[i]] <- cbind(
+                out[[i]][, !"meddra_idx"],
+                object@meddra[meddra_idx]
+            )
+        }
+    }
+    out
+})
+
+#######################################################
 #' @export
 #' @aliases faers_primaryid
 #' @rdname FAERS-methods
@@ -61,31 +98,21 @@ methods::setMethod("faers_primaryid", "FAERSascii", function(object) {
 #' @aliases [,FAERSascii-method
 #' @rdname FAERS-methods
 methods::setMethod("[", "FAERSascii", function(x, i) {
-    data <- x@data
-    out <- data[use_indices(i, names(data))]
-    if (x@standardization) {
-        ii <- intersect(names(out), c("indi", "reac"))
-        for (i in ii) {
-            meddra_idx <- out[[i]]$meddra_idx
-            out[[i]] <- cbind(out[[i]][, !"meddra_idx"], x@meddra[meddra_idx])
-        }
-    }
-    out
+    x@data[i]
 })
 
 #' @export
 #' @aliases [[,FAERSascii-method
 #' @rdname FAERS-methods
 methods::setMethod("[[", "FAERSascii", function(x, i) {
-    assert_length(i, 1L)
-    x[i][[1L]]
+    x@data[[i]]
 })
 
 #' @export
 #' @aliases $,FAERSascii-method
 #' @rdname FAERS-methods
 methods::setMethod("$", "FAERSascii", function(x, name) {
-    x[[rlang::as_name(rlang::ensym(name))]]
+    eval(substitute(x@data$name, list(name = rlang::ensym(name))))
 })
 
 ##############################################################

tests/testthat/test_methods.R

@@ -27,7 +27,6 @@ testthat::test_that("faers_primaryid works well", {
 })
 
 testthat::test_that("`[` works well", {
-    testthat::expect_error(data["aa"])
     data_list <- data[c("indi", "reac", "demo", "drug")]
     testthat::expect_true(is.list(data_list))
     testthat::expect_true(all(
@@ -46,7 +45,6 @@ testthat::test_that("`[` works well", {
 })
 
 testthat::test_that("`[[` works well", {
-    testthat::expect_error(data[["aa"]])
     testthat::expect_s3_class(data[["drug"]], "data.table")
     testthat::expect_s3_class(data[["indi"]], "data.table")
     testthat::expect_s3_class(data[["reac"]], "data.table")
@@ -73,13 +71,13 @@ testthat::test_that("`$` works well", {
     testthat::expect_s3_class(data$rpsr, "data.table")
     testthat::expect_s3_class(data$outc, "data.table")
 
-    testthat::expect_error(data$`1`)
-    testthat::expect_error(data$`2`)
-    testthat::expect_error(data$`3`)
-    testthat::expect_error(data$`4`)
-    testthat::expect_error(data$`5`)
-    testthat::expect_error(data$`6`)
-    testthat::expect_error(data$`7`)
+    testthat::expect_null(data$`1`)
+    testthat::expect_null(data$`2`)
+    testthat::expect_null(data$`3`)
+    testthat::expect_null(data$`4`)
+    testthat::expect_null(data$`5`)
+    testthat::expect_null(data$`6`)
+    testthat::expect_null(data$`7`)
 })
 
 testthat::test_that("faers_keep works well", {