From 856135993c055bc2f74a509db098a15e9afcaf4f Mon Sep 17 00:00:00 2001
From: yun <yunyunpp96@outlook.com>
Date: Wed, 8 Nov 2023 13:07:42 +0800
Subject: [PATCH] use data.table for faers_period

---
 R/class-FAERS.R             | 27 ++++-----------------------
 R/combine.R                 |  9 +--------
 man/FAERS-class.Rd          |  4 ++--
 tests/testthat/test_class.R |  6 +++---
 4 files changed, 10 insertions(+), 36 deletions(-)

diff --git a/R/class-FAERS.R b/R/class-FAERS.R
index 5f16a7f..aeb2f50 100644
--- a/R/class-FAERS.R
+++ b/R/class-FAERS.R
@@ -18,8 +18,8 @@
 #'  - `faers_data`: Extract the `data` slot.
 #'  - `faers_year`: Extract the `year` slot.
 #'  - `faers_quarter`: Extract the `quarter` slot.
-#'  - `faers_period`: Extract the `period` slot (just Concatenate the year and
-#'    quarter slot).
+#'  - `faers_period`: A [data.table][data.table::data.table] combine the `year`
+#'    and `quarter` slot.
 #'  - `faers_meddra`: Extract the `meddra` slot. If `object` have never been
 #'    standardized, always return `NULL`.
 #'  - `faers_deleted_cases`: Extract the `deletedCases` slot.
@@ -64,18 +64,6 @@ methods::setClass(
 ## Validator for FAERS
 
 ################ utils methods ########################
-# methods::setGeneric("faers_data_period", function(object) {
-#     methods::makeStandardGeneric("faers_data_period")
-# })
-
-# methods::setMethod("faers_data_period", "FAERSxml", function(object) {
-#     faers_period(object)
-# })
-
-# methods::setMethod("faers_data_period", "FAERSascii", function(object) {
-#     object@data$demo
-# })
-
 validate_faers <- function(object) {
     if (length(object@year) != length(object@quarter)) {
         return("the length of `@year` and `@quarter` must be the same")
@@ -96,19 +84,12 @@ validate_faers <- function(object) {
     if (length(object@deduplication) != 1L || is.na(object@deduplication)) {
         return("@deduplication must be a bool, `TRUE` or `FALSE`")
     }
-
     if (!rlang::is_string(object@format, faers_file_format)) {
         return(sprintf(
             "`@format` must be a string of %s",
             oxford_comma(faers_file_format, final = "or")
         ))
     }
-    ### Also, we check if year-quarter in @data slot contain all data from
-    # @year-@quarter
-    # period <- faers_period(object)
-    # if (!setequal(period, faers_data_period(object))) {
-    #     return("`@data` must be compatible with `@year` and `@quarter`")
-    # }
     TRUE
 }
 
@@ -160,7 +141,7 @@ methods::setClass(
 #' @method show FAERS
 #' @rdname FAERS-class
 methods::setMethod("show", "FAERS", function(object) {
-    l <- length(faers_period(object))
+    l <- nrow(faers_period(object))
     msg <- sprintf(
         "FAERS data from %s Quarterly %s file%s",
         l, object@format, if (l > 1L) "s" else ""
@@ -260,7 +241,7 @@ methods::setGeneric("faers_period", function(object) {
 #' @aliases faers_period
 #' @rdname FAERS-class
 methods::setMethod("faers_period", "FAERS", function(object) {
-    paste0(object@year, object@quarter)
+    data.table(year = object@year, quarter = object@quarter)
 })
 
 #' @export
diff --git a/R/combine.R b/R/combine.R
index b53f888..cbbf059 100644
--- a/R/combine.R
+++ b/R/combine.R
@@ -77,14 +77,7 @@ check_faers_list_type <- function(lst, call = rlang::caller_env()) {
 }
 
 check_faers_period <- function(lst, call = rlang::caller_env()) {
-    out <- data.table(
-        year = unlist(lapply(lst, function(obj) obj@year),
-            recursive = FALSE, use.names = FALSE
-        ),
-        quarter = unlist(lapply(lst, function(obj) obj@quarter),
-            recursive = FALSE, use.names = FALSE
-        )
-    )
+    out <- data.table::rbindlist(lapply(lst, faers_period))
     if (anyDuplicated(out)) {
         cli::cli_abort(c(
             "Duplicated FAERS quarterly datas are not allowed",
diff --git a/man/FAERS-class.Rd b/man/FAERS-class.Rd
index 0d166f0..c0a66e1 100644
--- a/man/FAERS-class.Rd
+++ b/man/FAERS-class.Rd
@@ -79,8 +79,8 @@ Provide a container for FAERS Quarterly Data file
 \item \code{faers_data}: Extract the \code{data} slot.
 \item \code{faers_year}: Extract the \code{year} slot.
 \item \code{faers_quarter}: Extract the \code{quarter} slot.
-\item \code{faers_period}: Extract the \code{period} slot (just Concatenate the year and
-quarter slot).
+\item \code{faers_period}: A \link[data.table:data.table]{data.table} combine the \code{year}
+and \code{quarter} slot.
 \item \code{faers_meddra}: Extract the \code{meddra} slot. If \code{object} have never been
 standardized, always return \code{NULL}.
 \item \code{faers_deleted_cases}: Extract the \code{deletedCases} slot.
diff --git a/tests/testthat/test_class.R b/tests/testthat/test_class.R
index 730710d..3cb9341 100644
--- a/tests/testthat/test_class.R
+++ b/tests/testthat/test_class.R
@@ -12,9 +12,9 @@ testthat::test_that("FAERS object and extractor works well", {
     testthat::expect_true(all(grepl("^20\\d{2}$", faers_year(data))))
     testthat::expect_true(is.character(faers_quarter(data)))
     testthat::expect_true(all(faers_quarter(data) %in% paste0("q", 1:4)))
-    testthat::expect_true(all(
-        paste0(faers_year(data), faers_quarter(data)) ==
-            faers_period(data)
+    testthat::expect_true(identical(
+        data.table(year = faers_year(data), quarter = faers_quarter(data)),
+        faers_period(data)
     ))
     testthat::expect_null(data@meddra)
     testthat::expect_null(faers_meddra(data))