From 519aada54ffb3ea0a5c8a967c1f99ac65968ee22 Mon Sep 17 00:00:00 2001 From: "Matthijs S. Berends" Date: Mon, 28 Sep 2020 01:08:55 +0200 Subject: [PATCH] (v1.3.0.9032) support skimr --- .github/workflows/codecovr.yaml | 2 +- DESCRIPTION | 5 +-- NEWS.md | 5 +-- R/disk.R | 14 +++++++++ R/mic.R | 14 +++++++++ R/mo.R | 17 +++++++++-- R/rsi.R | 37 +++++++++++++++++++++++ R/rsi_calc.R | 3 +- R/zzz.R | 7 ++++- docs/404.html | 2 +- docs/LICENSE-text.html | 2 +- docs/articles/index.html | 2 +- docs/authors.html | 2 +- docs/index.html | 2 +- docs/news/index.html | 13 ++++---- docs/pkgdown.yml | 2 +- docs/reference/as.mo.html | 2 +- docs/reference/as.rsi.html | 2 +- docs/reference/index.html | 2 +- docs/reference/join.html | 2 +- docs/reference/mo_matching_score.html | 2 +- docs/reference/mo_property.html | 2 +- docs/survey.html | 2 +- tests/testthat/test-join_microorganisms.R | 1 - tests/testthat/test-rsi.R | 9 +++++- 25 files changed, 123 insertions(+), 30 deletions(-) diff --git a/.github/workflows/codecovr.yaml b/.github/workflows/codecovr.yaml index 51a7e5086..d6552648e 100644 --- a/.github/workflows/codecovr.yaml +++ b/.github/workflows/codecovr.yaml @@ -63,5 +63,5 @@ jobs: shell: Rscript {0} - name: Test coverage - run: covr::codecov(line_exclusions = list("R/atc_online.R", "R/mo_source.R", "R/resistance_predict.R", "R/aa_helper_functions_dplyr.R"), quiet = FALSE) + run: covr::codecov(line_exclusions = list("R/atc_online.R", "R/mo_source.R", "R/resistance_predict.R", "R/aa_helper_pm_functions.R", "R/zzz.R"), quiet = FALSE) shell: Rscript {0} diff --git a/DESCRIPTION b/DESCRIPTION index c575e4981..11fa4ffb9 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: AMR -Version: 1.3.0.9031 -Date: 2020-09-26 +Version: 1.3.0.9032 +Date: 2020-09-28 Title: Antimicrobial Resistance Analysis Authors@R: c( person(role = c("aut", "cre"), @@ -51,6 +51,7 @@ Suggests: rmarkdown, rstudioapi, rvest, + skimr, testthat, tidyr, xml2 diff --git a/NEWS.md b/NEWS.md index 146e70981..c9b5e694d 100755 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,5 @@ -# AMR 1.3.0.9031 -## Last updated: 26 September 2020 +# AMR 1.3.0.9032 +## Last updated: 28 September 2020 Note: some changes in this version were suggested by anonymous reviewers from the journal we submitted our manuscipt to. We are those reviewers very grateful for going through our code so thoroughly! @@ -18,6 +18,7 @@ Note: some changes in this version were suggested by anonymous reviewers from th #> [1] "Enterococcus casseliflavus" "Enterococcus gallinarum" ``` * Support for veterinary ATC codes +* Support for skimming classes ``, ``, `` and `` with the `skimr` package ### Changed * Although advertised that this package should work under R 3.0.0, we still had a dependency on R 3.6.0. This is fixed, meaning that our package should now work under R 3.0.0. diff --git a/R/disk.R b/R/disk.R index 892892315..65a7bc157 100644 --- a/R/disk.R +++ b/R/disk.R @@ -186,3 +186,17 @@ unique.disk <- function(x, incomparables = FALSE, ...) { attributes(y) <- attributes(x) y } + +# will be exported using s3_register() in R/zzz.R +get_skimmers.disk <- function(column) { + sfl <- import_fn("sfl", "skimr", error_on_fail = FALSE) + inline_hist <- import_fn("inline_hist", "skimr", error_on_fail = FALSE) + sfl( + skim_type = "disk", + smallest = ~min(as.double(.), na.rm = TRUE), + largest = ~max(as.double(.), na.rm = TRUE), + median = ~stats::median(as.double(.), na.rm = TRUE), + n_unique = n_unique, + hist = ~inline_hist(stats::na.omit(as.double(.))) + ) +} diff --git a/R/mic.R b/R/mic.R index 5811fa902..7a8019f4b 100755 --- a/R/mic.R +++ b/R/mic.R @@ -296,3 +296,17 @@ unique.mic <- function(x, incomparables = FALSE, ...) { attributes(y) <- attributes(x) y } + +# will be exported using s3_register() in R/zzz.R +get_skimmers.mic <- function(column) { + sfl <- import_fn("sfl", "skimr", error_on_fail = FALSE) + inline_hist <- import_fn("inline_hist", "skimr", error_on_fail = FALSE) + sfl( + skim_type = "mic", + min = ~as.character(sort(na.omit(.))[1]), + max = ~as.character(sort(stats::na.omit(.))[length(stats::na.omit(.))]), + median = ~as.character(stats::na.omit(.)[as.double(stats::na.omit(.)) == median(as.double(stats::na.omit(.)))])[1], + n_unique = n_unique, + hist_log2 = ~inline_hist(log2(as.double(stats::na.omit(.)))) + ) +} diff --git a/R/mo.R b/R/mo.R index 03487c8ac..841c88788 100755 --- a/R/mo.R +++ b/R/mo.R @@ -1637,11 +1637,24 @@ freq.mo <- function(x, ...) { decimal.mark = "."), " (", percentage(sum(grams == "Gram-positive", na.rm = TRUE) / length(grams), digits = digits), ")"), - `No. of genera` = pm_n_distinct(mo_genus(x_noNA, language = NULL)), - `No. of species` = pm_n_distinct(paste(mo_genus(x_noNA, language = NULL), + `Nr. of genera` = pm_n_distinct(mo_genus(x_noNA, language = NULL)), + `Nr. of species` = pm_n_distinct(paste(mo_genus(x_noNA, language = NULL), mo_species(x_noNA, language = NULL))))) } +# will be exported using s3_register() in R/zzz.R +get_skimmers.mo <- function(column) { + sfl <- import_fn("sfl", "skimr", error_on_fail = FALSE) + sfl( + skim_type = "mo", + unique_total = n_unique, + gram_negative = ~sum(mo_gramstain(stats::na.omit(.), language = NULL) == "Gram-negative", na.rm = TRUE), + gram_positive = ~sum(mo_gramstain(stats::na.omit(.), language = NULL) == "Gram-positive", na.rm = TRUE), + top_genus = ~names(sort(-table(mo_genus(stats::na.omit(.), language = NULL))))[1L], + top_species = ~names(sort(-table(mo_name(stats::na.omit(.), language = NULL))))[1L] + ) +} + #' @method print mo #' @export #' @noRd diff --git a/R/rsi.R b/R/rsi.R index 827a46a1d..0f9fe37f7 100755 --- a/R/rsi.R +++ b/R/rsi.R @@ -743,6 +743,43 @@ freq.rsi <- function(x, ...) { } } + +# will be exported using s3_register() in R/zzz.R +get_skimmers.rsi <- function(column) { + # a bit of a crazy hack to get the variable name + name_call <- function(.data, name = deparse(substitute(column))) { + vars <- tryCatch(eval(parse(text = ".data$skim_variable"), envir = sys.frame(2)), + error = function(e) NULL) + calls <- sys.calls() + i <- tryCatch(attributes(calls[[length(calls)]])$position, + error = function(e) NULL) + if (is.null(vars) | is.null(i)) { + NA_character_ + } else{ + lengths <- sapply(vars, length) + lengths <- sum(lengths[!names(lengths) == "rsi"]) + var <- vars$rsi[i - lengths] + if (var == "data") { + NA_character_ + } else{ + ab_name(var) + } + } + } + + sfl <- import_fn("sfl", "skimr", error_on_fail = FALSE) + sfl( + skim_type = "rsi", + name = name_call, + count_R = count_R, + count_S = count_susceptible, + count_I = count_I, + prop_R = ~proportion_R(., minimum = 0), + prop_S = ~susceptibility(., minimum = 0), + prop_I = ~proportion_I(., minimum = 0) + ) +} + #' @method print rsi #' @export #' @noRd diff --git a/R/rsi_calc.R b/R/rsi_calc.R index 4f813c492..0e49b9ee7 100755 --- a/R/rsi_calc.R +++ b/R/rsi_calc.R @@ -151,9 +151,10 @@ rsi_calc <- function(..., data_vars <- paste(" for", data_vars) } warning("Introducing NA: only ", denominator, " results available", data_vars, " (`minimum` = ", minimum, ").", call. = FALSE) - fraction <- NA + fraction <- NA_real_ } else { fraction <- numerator / denominator + fraction[is.nan(fraction)] <- NA_real_ } if (as_percent == TRUE) { diff --git a/R/zzz.R b/R/zzz.R index d84b201e1..d98162728 100755 --- a/R/zzz.R +++ b/R/zzz.R @@ -49,9 +49,14 @@ s3_register("tibble::type_sum", "mic") s3_register("pillar::pillar_shaft", "disk") s3_register("tibble::type_sum", "disk") - # support for frequency tables + # support for frequency tables from the cleaner package s3_register("cleaner::freq", "mo") s3_register("cleaner::freq", "rsi") + # support from skim from the skimr package + s3_register("skimr::get_skimmers", "mo") + s3_register("skimr::get_skimmers", "rsi") + s3_register("skimr::get_skimmers", "mic") + s3_register("skimr::get_skimmers", "disk") } .onAttach <- function(...) { diff --git a/docs/404.html b/docs/404.html index a7621ac07..fef15802c 100644 --- a/docs/404.html +++ b/docs/404.html @@ -81,7 +81,7 @@ AMR (for R) - 1.3.0.9031 + 1.3.0.9032 diff --git a/docs/LICENSE-text.html b/docs/LICENSE-text.html index aebcd21f1..7203feb9c 100644 --- a/docs/LICENSE-text.html +++ b/docs/LICENSE-text.html @@ -81,7 +81,7 @@ AMR (for R) - 1.3.0.9031 + 1.3.0.9032 diff --git a/docs/articles/index.html b/docs/articles/index.html index f3e318a58..14e8d05cd 100644 --- a/docs/articles/index.html +++ b/docs/articles/index.html @@ -81,7 +81,7 @@ AMR (for R) - 1.3.0.9031 + 1.3.0.9032 diff --git a/docs/authors.html b/docs/authors.html index 364cd51f7..ed47c1052 100644 --- a/docs/authors.html +++ b/docs/authors.html @@ -81,7 +81,7 @@ AMR (for R) - 1.3.0.9031 + 1.3.0.9032 diff --git a/docs/index.html b/docs/index.html index 88043e09f..b739ff7e5 100644 --- a/docs/index.html +++ b/docs/index.html @@ -43,7 +43,7 @@ AMR (for R) - 1.3.0.9031 + 1.3.0.9032 diff --git a/docs/news/index.html b/docs/news/index.html index 3b15fcdce..8f95a4325 100644 --- a/docs/news/index.html +++ b/docs/news/index.html @@ -81,7 +81,7 @@ AMR (for R) - 1.3.0.9031 + 1.3.0.9032 @@ -236,13 +236,13 @@ Source: NEWS.md -
-

-AMR 1.3.0.9031 Unreleased +
+

+AMR 1.3.0.9032 Unreleased

-
+

-Last updated: 26 September 2020 +Last updated: 28 September 2020

Note: some changes in this version were suggested by anonymous reviewers from the journal we submitted our manuscipt to. We are those reviewers very grateful for going through our code so thoroughly!

@@ -264,6 +264,7 @@

  • Support for veterinary ATC codes

    • +

  • Support for skimming classes <rsi>, <mic>, <disk> and <mo> with the skimr package

    • diff --git a/docs/pkgdown.yml b/docs/pkgdown.yml index 6e64473f9..c63bbf647 100644 --- a/docs/pkgdown.yml +++ b/docs/pkgdown.yml @@ -2,7 +2,7 @@ pandoc: 2.7.3 pkgdown: 1.5.1.9000 pkgdown_sha: eae56f08694abebf93cdfc0dd8e9ede06d8c815f articles: [] -last_built: 2020-09-26T14:51Z +last_built: 2020-09-27T23:07Z urls: reference: https://msberends.github.io/AMR/reference article: https://msberends.github.io/AMR/articles diff --git a/docs/reference/as.mo.html b/docs/reference/as.mo.html index 42086cb2f..33ceb82e4 100644 --- a/docs/reference/as.mo.html +++ b/docs/reference/as.mo.html @@ -82,7 +82,7 @@ AMR (for R) - 1.3.0.9031 + 1.3.0.9032
    diff --git a/docs/reference/as.rsi.html b/docs/reference/as.rsi.html index dcedcd51d..ac2a0e3f9 100644 --- a/docs/reference/as.rsi.html +++ b/docs/reference/as.rsi.html @@ -82,7 +82,7 @@ AMR (for R) - 1.3.0.9029 + 1.3.0.9032
    diff --git a/docs/reference/index.html b/docs/reference/index.html index 837384bed..b937ee57f 100644 --- a/docs/reference/index.html +++ b/docs/reference/index.html @@ -81,7 +81,7 @@ AMR (for R) - 1.3.0.9031 + 1.3.0.9032
    diff --git a/docs/reference/join.html b/docs/reference/join.html index 349a4833c..1589915aa 100644 --- a/docs/reference/join.html +++ b/docs/reference/join.html @@ -82,7 +82,7 @@ AMR (for R) - 1.3.0.9029 + 1.3.0.9032

    diff --git a/docs/reference/mo_matching_score.html b/docs/reference/mo_matching_score.html index 93af2ea2d..ac0067dc1 100644 --- a/docs/reference/mo_matching_score.html +++ b/docs/reference/mo_matching_score.html @@ -82,7 +82,7 @@ AMR (for R) - 1.3.0.9031 + 1.3.0.9032 diff --git a/docs/reference/mo_property.html b/docs/reference/mo_property.html index 127bf9ee7..2852ed0a8 100644 --- a/docs/reference/mo_property.html +++ b/docs/reference/mo_property.html @@ -82,7 +82,7 @@ AMR (for R) - 1.3.0.9031 + 1.3.0.9032 diff --git a/docs/survey.html b/docs/survey.html index dad18db7f..7672eccfd 100644 --- a/docs/survey.html +++ b/docs/survey.html @@ -81,7 +81,7 @@ AMR (for R) - 1.3.0.9031 + 1.3.0.9032 diff --git a/tests/testthat/test-join_microorganisms.R b/tests/testthat/test-join_microorganisms.R index 25a1f8310..2dff0bf31 100755 --- a/tests/testthat/test-join_microorganisms.R +++ b/tests/testthat/test-join_microorganisms.R @@ -45,7 +45,6 @@ test_that("joins work", { expect_true(nrow(unjoined) < nrow(right)) expect_true(nrow(unjoined) < nrow(full)) - expect_equal(nrow(inner_join_microorganisms("B_ESCHR_COLI")), 1) expect_equal(nrow(inner_join_microorganisms("B_ESCHR_COLI", by = c("mo" = "mo"))), 1) diff --git a/tests/testthat/test-rsi.R b/tests/testthat/test-rsi.R index 3637a8019..dc4a398ef 100644 --- a/tests/testthat/test-rsi.R +++ b/tests/testthat/test-rsi.R @@ -28,7 +28,6 @@ test_that("rsi works", { expect_true(as.rsi("I") < as.rsi("R")) expect_true(is.rsi(as.rsi("S"))) - x <- example_isolates$AMX expect_s3_class(x[1], "rsi") expect_s3_class(x[[1]], "rsi") @@ -69,6 +68,14 @@ test_that("rsi works", { expect_error(as.rsi.disk(as.disk(16))) expect_error(get_guideline("this one does not exist")) + + expect_s3_class(example_isolates %>% + mutate(m = as.mic(2), + d = as.disk(20)) %>% + skimr::skim(), + "data.frame") + expect_s3_class(skimr::skim(example_isolates), + "data.frame") })