From 3c3cd1772f0308f91e7cde3506b7ccb6d9e57f16 Mon Sep 17 00:00:00 2001 From: yun Date: Mon, 6 Nov 2023 18:30:33 +0800 Subject: [PATCH] add `invert` argument for faers_filter --- R/methods-utils.R | 10 ++++---- man/FAERS-methods.Rd | 8 ++++--- tests/testthat/test_methods.R | 43 +++++++++++++++++++++++++++++++++++ 3 files changed, 54 insertions(+), 7 deletions(-) diff --git a/R/methods-utils.R b/R/methods-utils.R index 7268402..fe11956 100644 --- a/R/methods-utils.R +++ b/R/methods-utils.R @@ -143,7 +143,7 @@ methods::setGeneric("faers_keep", function(object, ...) { #' @export #' @param primaryid An atomic character or integer specifies the reports to #' keep. If `NULL`, will do nothing. -#' @param invert A bool. If `TRUE`, will keep reports no in `primaryid`. +#' @param invert A bool. If `TRUE`, will keep reports not in `primaryid`. #' @method faers_keep FAERSascii #' @rdname FAERS-methods methods::setMethod("faers_keep", "FAERSascii", function(object, primaryid = NULL, invert = FALSE) { @@ -172,7 +172,9 @@ methods::setGeneric("faers_filter", function(object, ...) { methods::makeStandardGeneric("faers_filter") }) -#' @param .fn A function or formula. +#' @param .fn A function or formula, accept the field data as the input and +#' return an atomic integer or character of `primaryid` you want to keep or +#' remove based on argument `invert`. #' #' If a **function**, it is used as is. #' @@ -185,7 +187,7 @@ methods::setGeneric("faers_filter", function(object, ...) { #' @export #' @method faers_filter FAERSascii #' @rdname FAERS-methods -methods::setMethod("faers_filter", "FAERSascii", function(object, .fn, ..., field = NULL) { +methods::setMethod("faers_filter", "FAERSascii", function(object, .fn, ..., field = NULL, invert = FALSE) { if (is.null(field)) { data <- object } else { @@ -195,7 +197,7 @@ methods::setMethod("faers_filter", "FAERSascii", function(object, .fn, ..., fiel if (!(is.numeric(ids) || is.character(ids))) { cli::cli_abort("{.arg .fn} must return an atomic integer or character") } - faers_keep(object, primaryid = ids) + faers_keep(object, primaryid = ids, invert = invert) }) ######################################################### diff --git a/man/FAERS-methods.Rd b/man/FAERS-methods.Rd index 09f361e..e991d57 100644 --- a/man/FAERS-methods.Rd +++ b/man/FAERS-methods.Rd @@ -41,7 +41,7 @@ faers_keep(object, ...) faers_filter(object, ...) -\S4method{faers_filter}{FAERSascii}(object, .fn, ..., field = NULL) +\S4method{faers_filter}{FAERSascii}(object, .fn, ..., field = NULL, invert = FALSE) } \arguments{ \item{object}{A \link{FAERSascii} object.} @@ -65,9 +65,11 @@ okay to use integer indices.} \item{primaryid}{An atomic character or integer specifies the reports to keep. If \code{NULL}, will do nothing.} -\item{invert}{A bool. If \code{TRUE}, will keep reports no in \code{primaryid}.} +\item{invert}{A bool. If \code{TRUE}, will keep reports not in \code{primaryid}.} -\item{.fn}{A function or formula. +\item{.fn}{A function or formula, accept the field data as the input and +return an atomic integer or character of \code{primaryid} you want to keep or +remove based on argument \code{invert}. If a \strong{function}, it is used as is. diff --git a/tests/testthat/test_methods.R b/tests/testthat/test_methods.R index 7e2e776..9b3f274 100644 --- a/tests/testthat/test_methods.R +++ b/tests/testthat/test_methods.R @@ -120,3 +120,46 @@ testthat::test_that("faers_keep works well", { testthat::expect_in(data2_invert$rpsr$primaryid, ids2_invert) testthat::expect_in(data2_invert$outc$primaryid, ids2_invert) }) + +testthat::test_that("faers_filter works well", { + testthat::expect_error(faers_filter(data, ~ FALSE)) + ids1 <- sample(faers_primaryid(data), 1L) + ids1_invert <- setdiff(faers_primaryid(data), ids1) + data1 <- faers_filter(data, ~ ids1) + data1_invert <- faers_filter(data, ~ ids1, invert = TRUE) + testthat::expect_setequal(data1$demo$primaryid, ids1) + testthat::expect_in(data1$indi$primaryid, ids1) + testthat::expect_in(data1$reac$primaryid, ids1) + testthat::expect_in(data1$drug$primaryid, ids1) + testthat::expect_in(data1$ther$primaryid, ids1) + testthat::expect_in(data1$rpsr$primaryid, ids1) + testthat::expect_in(data1$outc$primaryid, ids1) + + testthat::expect_setequal(data1_invert$demo$primaryid, ids1_invert) + testthat::expect_in(data1_invert$indi$primaryid, ids1_invert) + testthat::expect_in(data1_invert$reac$primaryid, ids1_invert) + testthat::expect_in(data1_invert$drug$primaryid, ids1_invert) + testthat::expect_in(data1_invert$ther$primaryid, ids1_invert) + testthat::expect_in(data1_invert$rpsr$primaryid, ids1_invert) + testthat::expect_in(data1_invert$outc$primaryid, ids1_invert) + + ids2 <- sample(faers_primaryid(data), 10L) + ids2_invert <- setdiff(faers_primaryid(data), ids2) + data2 <- faers_filter(data, ~ ids2) + data2_invert <- faers_filter(data, ~ ids2, invert = TRUE) + testthat::expect_setequal(data2$demo$primaryid, ids2) + testthat::expect_in(data2$drug$primaryid, ids2) + testthat::expect_in(data2$indi$primaryid, ids2) + testthat::expect_in(data2$reac$primaryid, ids2) + testthat::expect_in(data2$ther$primaryid, ids2) + testthat::expect_in(data2$rpsr$primaryid, ids2) + testthat::expect_in(data2$outc$primaryid, ids2) + + testthat::expect_setequal(data2_invert$demo$primaryid, ids2_invert) + testthat::expect_in(data2_invert$drug$primaryid, ids2_invert) + testthat::expect_in(data2_invert$indi$primaryid, ids2_invert) + testthat::expect_in(data2_invert$reac$primaryid, ids2_invert) + testthat::expect_in(data2_invert$ther$primaryid, ids2_invert) + testthat::expect_in(data2_invert$rpsr$primaryid, ids2_invert) + testthat::expect_in(data2_invert$outc$primaryid, ids2_invert) +})