diff --git a/.github/workflows/check.yaml b/.github/workflows/check.yaml index 0fb9fb97..56779b0e 100644 --- a/.github/workflows/check.yaml +++ b/.github/workflows/check.yaml @@ -120,16 +120,7 @@ jobs: sessioninfo::session_info(pkgs, include_base = TRUE) shell: Rscript {0} - - name: Check on older R versions - # no vignettes here, since they rely on R 3.3 and higher - if: matrix.config.r == '3.2' - env: - _R_CHECK_CRAN_INCOMING_: false - run: rcmdcheck::rcmdcheck(args = c("--no-manual", "--as-cran", "--ignore-vignettes"), build_args = "--no-build-vignettes" , error_on = "warning", check_dir = "check") - shell: Rscript {0} - - - name: Check on newer R versions - if: matrix.config.r != '3.2' + - name: Run Check env: _R_CHECK_CRAN_INCOMING_: false run: rcmdcheck::rcmdcheck(args = c("--no-manual", "--as-cran"), error_on = "warning", check_dir = "check") diff --git a/.github/workflows/codecovr.yaml b/.github/workflows/codecovr.yaml index 62aa728e..ad03f567 100644 --- a/.github/workflows/codecovr.yaml +++ b/.github/workflows/codecovr.yaml @@ -67,5 +67,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.R", "R/aa_helper_pm_functions.R", "R/zzz.R"), quiet = FALSE) + run: covr::codecov(line_exclusions = list("R/atc_online.R", "R/mo_source.R", "R/translate.R", "R/resistance_predict.R", "R/aa_helper_functions.R", "R/aa_helper_pm_functions.R", "R/zzz.R"), quiet = FALSE) shell: Rscript {0} diff --git a/DESCRIPTION b/DESCRIPTION index 4b8334d7..494c8ac9 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,5 +1,5 @@ Package: AMR -Version: 1.4.0.9038 +Version: 1.4.0.9039 Date: 2020-12-13 Title: Antimicrobial Resistance Analysis Authors@R: c( diff --git a/NEWS.md b/NEWS.md index 016ed0f5..ab499e7b 100755 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# AMR 1.4.0.9038 +# AMR 1.4.0.9039 ## Last updated: 13 December 2020 ### New diff --git a/R/aa_helper_functions.R b/R/aa_helper_functions.R index 9c208bc2..18b55a4c 100755 --- a/R/aa_helper_functions.R +++ b/R/aa_helper_functions.R @@ -187,7 +187,7 @@ search_type_in_df <- function(x, type, info = TRUE) { } if (!is.null(found) & info == TRUE) { - msg <- paste0("Using column '", found, "' as input for `col_", type, "`.") + msg <- paste0("Using column '", font_bold(found), "' as input for `col_", type, "`.") if (type %in% c("keyantibiotics", "specimen")) { msg <- paste(msg, "Use", font_bold(paste0("col_", type), "= FALSE"), "to prevent this.") } diff --git a/R/pca.R b/R/pca.R index 334eaaa7..1e2c2bc8 100755 --- a/R/pca.R +++ b/R/pca.R @@ -111,7 +111,7 @@ pca <- function(x, x <- cbind(x.bak[, sapply(x.bak, function(y) !is.numeric(y) & !all(is.na(y))), drop = FALSE], x) } - x <- pm_ungroup(x) # would otherwise select the grouping vars + x <- pm_ungroup(x) # would otherwise select the grouping vars x <- x[rowSums(is.na(x)) == 0, ] # remove columns containing NAs pca_data <- x[, which(sapply(x, function(x) is.numeric(x)))] diff --git a/R/random.R b/R/random.R index 24d51f73..0e1ee272 100644 --- a/R/random.R +++ b/R/random.R @@ -130,4 +130,3 @@ random_exec <- function(type, size, mo = NULL, ab = NULL) { return(as.disk(out)) } } - diff --git a/R/rsi.R b/R/rsi.R index f75f577b..f0cd96e1 100755 --- a/R/rsi.R +++ b/R/rsi.R @@ -316,22 +316,21 @@ as.rsi.mic <- function(x, # for auto-determining mo mo_var_found <- "" if (is.null(mo)) { - peek_mask_dplyr <- import_fn("peek_mask", "dplyr", error_on_fail = FALSE) - if (!is.null(peek_mask_dplyr)) { + tryCatch({ + df <- get_current_data(arg_name = "mo", call = -3) # will return an error if not found + mo <- NULL try({ - df <- as.data.frame(peek_mask_dplyr()$across_cols(), stringsAsFactors = FALSE) mo <- suppressMessages(search_type_in_df(df, "mo")) - if (!is.null(mo)) { - mo_var_found <- paste0(" based on column `", font_bold(mo), "`") - mo <- df[, mo, drop = TRUE] - } }, silent = TRUE) - } - } - if (is.null(mo)) { - stop_('No information was supplied about the microorganisms (missing parameter "mo"). See ?as.rsi.\n\n', - "To transform certain columns with e.g. mutate_at(), use `data %>% mutate_at(vars(...), as.rsi, mo = .$x)`, where x is your column with microorganisms.\n", - "To tranform all MIC values in a data set, use `data %>% as.rsi()` or data %>% mutate_if(is.mic, as.rsi).", call = FALSE) + if (!is.null(df) && !is.null(mo) && is.data.frame(df)) { + mo_var_found <- paste0(" based on column `", font_bold(mo), "`") + mo <- df[, mo, drop = TRUE] + } + }, error = function(e) + stop_('No information was supplied about the microorganisms (missing parameter "mo"). See ?as.rsi.\n\n', + "To transform certain columns with e.g. mutate_at(), use `data %>% mutate_at(vars(...), as.rsi, mo = .$x)`, where x is your column with microorganisms.\n", + "To tranform all disk diffusion zones in a data set, use `data %>% as.rsi()` or data %>% mutate_if(is.disk, as.rsi).", call = FALSE) + ) } if (length(ab) == 1 && ab %like% "as.mic") { stop_('No unambiguous name was supplied about the antibiotic (parameter "ab"). See ?as.rsi.', call = FALSE) @@ -406,22 +405,21 @@ as.rsi.disk <- function(x, # for auto-determining mo mo_var_found <- "" if (is.null(mo)) { - peek_mask_dplyr <- import_fn("peek_mask", "dplyr", error_on_fail = FALSE) - if (!is.null(peek_mask_dplyr)) { + tryCatch({ + df <- get_current_data(arg_name = "mo", call = -3) # will return an error if not found + mo <- NULL try({ - df <- as.data.frame(peek_mask_dplyr()$across_cols(), stringsAsFactors = FALSE) mo <- suppressMessages(search_type_in_df(df, "mo")) - if (!is.null(mo)) { - mo_var_found <- paste0(" based on column `", font_bold(mo), "`") - mo <- df[, mo, drop = TRUE] - } }, silent = TRUE) - } - } - if (is.null(mo)) { - stop_('No information was supplied about the microorganisms (missing parameter "mo"). See ?as.rsi.\n\n', - "To transform certain columns with e.g. mutate_at(), use `data %>% mutate_at(vars(...), as.rsi, mo = .$x)`, where x is your column with microorganisms.\n", - "To tranform all disk diffusion zones in a data set, use `data %>% as.rsi()` or data %>% mutate_if(is.disk, as.rsi).", call = FALSE) + if (!is.null(df) && !is.null(mo) && is.data.frame(df)) { + mo_var_found <- paste0(" based on column `", font_bold(mo), "`") + mo <- df[, mo, drop = TRUE] + } + }, error = function(e) + stop_('No information was supplied about the microorganisms (missing parameter "mo"). See ?as.rsi.\n\n', + "To transform certain columns with e.g. mutate_at(), use `data %>% mutate_at(vars(...), as.rsi, mo = .$x)`, where x is your column with microorganisms.\n", + "To tranform all disk diffusion zones in a data set, use `data %>% as.rsi()` or data %>% mutate_if(is.disk, as.rsi).", call = FALSE) + ) } if (length(ab) == 1 && ab %like% "as.disk") { stop_('No unambiguous name was supplied about the antibiotic (parameter "ab"). See ?as.rsi.', call = FALSE) diff --git a/README.md b/README.md index a38e91b7..efeca949 100755 --- a/README.md +++ b/README.md @@ -2,9 +2,8 @@ # `AMR` (for R) - - - +[![CRAN_Badge](https://www.r-pkg.org/badges/version-ago/AMR)](https://cran.R-project.org/package=AMR) [![CRAN_Downloads](https://cranlogs.r-pkg.org/badges/grand-total/AMR)](https://cran.R-project.org/package=AMR) +[![CodeCov](https://codecov.io/gh/msberends/AMR/branch/master/graph/badge.svg)](https://codecov.io/gh/msberends/AMR/branch/master) @@ -21,6 +20,8 @@ This is the development source of the `AMR` package for R. Not a developer? Then ### How to get this package Please see [our website](https://msberends.github.io/AMR/#get-this-package). +Bottom line: `install.packages("AMR")` + ### Copyright This R package is licensed under the [GNU General Public License (GPL) v2.0](https://github.com/msberends/AMR/blob/master/LICENSE). In a nutshell, this means that this package: diff --git a/docs/404.html b/docs/404.html index dbf886ae..43eb4ec6 100644 --- a/docs/404.html +++ b/docs/404.html @@ -81,7 +81,7 @@ AMR (for R) - 1.4.0.9038 + 1.4.0.9039 diff --git a/docs/LICENSE-text.html b/docs/LICENSE-text.html index 69c72d07..c62b6afc 100644 --- a/docs/LICENSE-text.html +++ b/docs/LICENSE-text.html @@ -81,7 +81,7 @@ AMR (for R) - 1.4.0.9038 + 1.4.0.9039 diff --git a/docs/articles/index.html b/docs/articles/index.html index 9ba50a61..c8934c30 100644 --- a/docs/articles/index.html +++ b/docs/articles/index.html @@ -81,7 +81,7 @@ AMR (for R) - 1.4.0.9038 + 1.4.0.9039 diff --git a/docs/authors.html b/docs/authors.html index af3c49ca..c6302938 100644 --- a/docs/authors.html +++ b/docs/authors.html @@ -81,7 +81,7 @@ AMR (for R) - 1.4.0.9038 + 1.4.0.9039 diff --git a/docs/index.html b/docs/index.html index da51250a..01591ea7 100644 --- a/docs/index.html +++ b/docs/index.html @@ -43,7 +43,7 @@ AMR (for R) - 1.4.0.9038 + 1.4.0.9039 diff --git a/docs/news/index.html b/docs/news/index.html index dfca8ed0..ad7a474a 100644 --- a/docs/news/index.html +++ b/docs/news/index.html @@ -81,7 +81,7 @@ AMR (for R) - 1.4.0.9038 + 1.4.0.9039 @@ -236,9 +236,9 @@ Source: NEWS.md -
-

-AMR 1.4.0.9038 Unreleased +
+

+AMR 1.4.0.9039 Unreleased

diff --git a/docs/pkgdown.yml b/docs/pkgdown.yml index 1a66715a..bda3fc4e 100644 --- a/docs/pkgdown.yml +++ b/docs/pkgdown.yml @@ -12,7 +12,7 @@ articles: datasets: datasets.html resistance_predict: resistance_predict.html welcome_to_AMR: welcome_to_AMR.html -last_built: 2020-12-13T12:43Z +last_built: 2020-12-13T19:44Z urls: reference: https://msberends.github.io/AMR//reference article: https://msberends.github.io/AMR//articles diff --git a/docs/reference/index.html b/docs/reference/index.html index 0c5dac81..c478b21e 100644 --- a/docs/reference/index.html +++ b/docs/reference/index.html @@ -81,7 +81,7 @@ AMR (for R) - 1.4.0.9038 + 1.4.0.9039

diff --git a/docs/reference/is_new_episode.html b/docs/reference/is_new_episode.html index 3ee4124c..555eaac4 100644 --- a/docs/reference/is_new_episode.html +++ b/docs/reference/is_new_episode.html @@ -82,7 +82,7 @@ AMR (for R) - 1.4.0.9037 + 1.4.0.9039
diff --git a/docs/reference/plot.html b/docs/reference/plot.html index cec4d02d..ca8d4d46 100644 --- a/docs/reference/plot.html +++ b/docs/reference/plot.html @@ -82,7 +82,7 @@ AMR (for R) - 1.4.0.9037 + 1.4.0.9039

diff --git a/docs/reference/random.html b/docs/reference/random.html index 86475dc8..db8e4f22 100644 --- a/docs/reference/random.html +++ b/docs/reference/random.html @@ -82,7 +82,7 @@ AMR (for R) - 1.4.0.9037 + 1.4.0.9039 diff --git a/docs/survey.html b/docs/survey.html index ce61316c..d00777af 100644 --- a/docs/survey.html +++ b/docs/survey.html @@ -81,7 +81,7 @@ AMR (for R) - 1.4.0.9038 + 1.4.0.9039 diff --git a/tests/testthat/test-count.R b/tests/testthat/test-count.R index affb696d..f42b8f52 100644 --- a/tests/testthat/test-count.R +++ b/tests/testthat/test-count.R @@ -92,4 +92,11 @@ test_that("counts work", { expect_error(count_df(c("A", "B", "C"))) expect_error(count_df(example_isolates[, "date"])) + # grouping in rsi_calc_df() (= backbone of rsi_df()) + expect_true("hospital_id" %in% (example_isolates %>% + group_by(hospital_id) %>% + select(hospital_id, AMX, CIP, gender) %>% + rsi_df() %>% + colnames())) + }) diff --git a/tests/testthat/test-disk.R b/tests/testthat/test-disk.R index df6eb05f..f7a433ef 100755 --- a/tests/testthat/test-disk.R +++ b/tests/testthat/test-disk.R @@ -39,7 +39,12 @@ test_that("disk works", { expect_s3_class(c(x[1], x[9]), "disk") expect_s3_class(unique(x[1], x[9]), "disk") expect_warning(as.disk("INVALID VALUE")) + x[2] <- 32 + expect_s3_class(x, "disk") + pdf(NULL) # prevent Rplots.pdf being created + expect_silent(plot(as.disk(c(10, 20, 40)))) + expect_output(print(as.disk(12))) library(dplyr, warn.conflicts = FALSE) expect_output(print(tibble(d = as.disk(12)))) diff --git a/tests/testthat/test-first_isolate.R b/tests/testthat/test-first_isolate.R index 16ee89d0..ae4bd8e6 100755 --- a/tests/testthat/test-first_isolate.R +++ b/tests/testthat/test-first_isolate.R @@ -150,6 +150,8 @@ test_that("first isolates work", { col_date = "non-existing col", col_mo = "mo")) + require("dplyr") + # look for columns itself expect_message(first_isolate(example_isolates)) expect_message(first_isolate(example_isolates %>% @@ -166,6 +168,14 @@ test_that("first isolates work", { first_isolate(col_date = "date", col_mo = "mo", col_patient_id = "patient_id")) + + # support for WHONET + expect_message(example_isolates %>% + select(-patient_id) %>% + mutate(`First name` = "test", + `Last name` = "test", + Sex = "Female") %>% + first_isolate(info = TRUE)) # missing dates should be no problem df <- example_isolates @@ -203,6 +213,9 @@ test_that("first isolates work", { # notice that all mo's are distinct, so all are TRUE expect_true(all(example_isolates %pm>% pm_distinct(mo, .keep_all = TRUE) %pm>% - first_isolate() == TRUE)) + first_isolate(info = TRUE) == TRUE)) + + # only one isolate, so return fast + expect_true(first_isolate(data.frame(mo = "Escherichia coli", date = Sys.Date(), patient = "patient"), info = TRUE)) }) diff --git a/tests/testthat/test-like.R b/tests/testthat/test-like.R index 661b0dd8..3621e850 100644 --- a/tests/testthat/test-like.R +++ b/tests/testthat/test-like.R @@ -31,8 +31,15 @@ test_that("`like` works", { expect_true("test" %like% "test") expect_false("test" %like_case% "TEST") + expect_true(factor("test") %like% factor("t")) + expect_true(factor("test") %like% "t") + expect_true("test" %like% factor("t")) expect_true(as.factor("test") %like% "TEST") expect_identical(factor(c("Test case", "Something different", "Yet another thing")) %like% c("case", "diff", "yet"), c(TRUE, TRUE, TRUE)) + expect_identical("test" %like% c("t", "e", "s", "t"), + c(TRUE, TRUE, TRUE, TRUE)) + expect_identical(factor("test") %like% factor(c("t", "e", "s", "t")), + c(TRUE, TRUE, TRUE, TRUE)) }) diff --git a/tests/testthat/test-mic.R b/tests/testthat/test-mic.R index 432300a2..b5b66745 100755 --- a/tests/testthat/test-mic.R +++ b/tests/testthat/test-mic.R @@ -43,9 +43,11 @@ test_that("mic works", { expect_s3_class(x[[1]], "mic") expect_s3_class(c(x[1], x[9]), "mic") expect_s3_class(unique(x[1], x[9]), "mic") + expect_s3_class(droplevels(c(x[1], x[9])), "mic") + x[2] <- 32 + expect_s3_class(x, "mic") expect_warning(as.mic("INVALID VALUE")) - pdf(NULL) # prevent Rplots.pdf being created expect_silent(barplot(as.mic(c(1, 2, 4, 8)))) expect_silent(plot(as.mic(c(1, 2, 4, 8)))) @@ -56,4 +58,7 @@ test_that("mic works", { "" = "0", "Min." = "2", "Max." = "8"), class = c("summaryDefault", "table"))) + + library(dplyr, warn.conflicts = FALSE) + expect_output(print(tibble(m = as.mic(2:4)))) }) diff --git a/tests/testthat/test-pca.R b/tests/testthat/test-pca.R index 6de4c095..4265ec17 100644 --- a/tests/testthat/test-pca.R +++ b/tests/testthat/test-pca.R @@ -49,7 +49,18 @@ test_that("PCA works", { expect_s3_class(pca_model, "pca") pdf(NULL) # prevent Rplots.pdf being created - ggplot_pca(pca_model, ellipse = TRUE) ggplot_pca(pca_model, arrows_textangled = FALSE) + + if (require("dplyr")) { + resistance_data <- example_isolates %>% + group_by(order = mo_order(mo), + genus = mo_genus(mo)) %>% + summarise_if(is.rsi, resistance, minimum = 0) + pca_result <- resistance_data %>% + pca(AMC, CXM, CTX, CAZ, GEN, TOB, TMP, "SXT") + expect_s3_class(pca_result, "prcomp") + ggplot_pca(pca_result, ellipse = TRUE) + ggplot_pca(pca_result, ellipse = FALSE, arrows_textangled = FALSE, scale = FALSE) + } })