diff --git a/.github/workflows/codecovr.yaml b/.github/workflows/codecovr.yaml
index 51a7e508..d6552648 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 c575e498..11fa4ffb 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 146e7098..c9b5e694 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 89289231..65a7bc15 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 5811fa90..7a8019f4 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 03487c8a..841c8878 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 827a46a1..0f9fe37f 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 4f813c49..0e49b9ee 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 d84b201e..d9816272 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 a7621ac0..fef15802 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 aebcd21f..7203feb9 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 f3e318a5..14e8d05c 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 364cd51f..ed47c105 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 88043e09..b739ff7e 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 3b15fcdc..8f95a432 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
-
-
diff --git a/docs/reference/mo_matching_score.html b/docs/reference/mo_matching_score.html
index 93af2ea2..ac0067dc 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 127bf9ee..2852ed0a 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 dad18db7..7672eccf 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 25a1f831..2dff0bf3 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 3637a801..dc4a398e 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")
})