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))