add invert argument for faers_filter

Yunuuuu · Nov 6, 2023 · 3c3cd17 · 3c3cd17
1 parent cd7a8ad
commit 3c3cd17
Show file tree

Hide file tree

Showing 3 changed files with 54 additions and 7 deletions.
diff --git 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
diff --git 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)
+})