diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
index 6a9f0c00b..20a6640b9 100644
--- a/.gitlab-ci.yml
+++ b/.gitlab-ci.yml
@@ -151,7 +151,7 @@ lintr:
- master
script:
# check all syntax with lintr
- - Rscript -e 'lintr::lint_package()'
+ - Rscript -e 'lintr::lint_package(exclusions = list("R/aa_helper_functions_dplyr.R"))'
cache:
key: release
paths:
diff --git a/DESCRIPTION b/DESCRIPTION
index 1432cddbc..4cad1a8af 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,5 +1,5 @@
Package: AMR
-Version: 1.1.0.9010
+Version: 1.1.0.9011
Date: 2020-05-18
Title: Antimicrobial Resistance Analysis
Authors@R: c(
@@ -37,10 +37,8 @@ Description: Functions to simplify the analysis and prediction of Antimicrobial
Depends:
R (>= 3.1.0)
Imports:
- backports,
cleaner,
pillar,
- tidyr (>= 1.0.0),
vctrs
Suggests:
covr,
@@ -51,6 +49,7 @@ Suggests:
rmarkdown,
rvest,
testthat,
+ tidyr,
utils
VignetteBuilder: knitr,rmarkdown
URL: https://msberends.gitlab.io/AMR, https://gitlab.com/msberends/AMR
diff --git a/NAMESPACE b/NAMESPACE
index 450283366..d8c8a54d0 100755
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -325,8 +325,6 @@ importFrom(stats,prcomp)
importFrom(stats,predict)
importFrom(stats,qchisq)
importFrom(stats,var)
-importFrom(tidyr,pivot_longer)
-importFrom(tidyr,pivot_wider)
importFrom(vctrs,vec_cast)
importFrom(vctrs,vec_cast.character)
importFrom(vctrs,vec_default_cast)
diff --git a/NEWS.md b/NEWS.md
index a74f22e77..8e74f381f 100755
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,4 +1,4 @@
-# AMR 1.1.0.9010
+# AMR 1.1.0.9011
## Last updated: 18-May-2020
### Breaking
@@ -11,7 +11,7 @@
* Added official drug names to verbose output of `eucast_rules()`
### Other
-* Removed dependency on **all** packages that were needed for the `AMR` package to work properly: `crayon`, `data.table`, `dplyr`, `ggplot2`, `R6`, `rlang` and `tidyr`. This is a major code change, but will probably not be noticeable by users. Making this package independent on especially the tidyverse (packages `dplyr`, `ggplot2` and `tidyr`) tremendously increases sustainability on the long term, since tidyverse functions change quite often. Most of our functions are replaced with versions that only rely on base R, which keeps this package fully functional for many years to come, without requiring a lot of maintenance to keep up with other packages anymore. The only dependencies that remained are for extending methods of other packages, like `pillar` and `vctrs` for printing and working with tibbles using our classes `mo` and `ab`.
+* Removed dependency on **all** packages that were needed for the `AMR` package to work properly: `backports`, `crayon`, `data.table`, `dplyr`, `ggplot2`, `R6`, `rlang` and `tidyr`. This is a major code change, but will probably not be noticeable by users. Making this package independent on especially the tidyverse (packages `dplyr`, `ggplot2` and `tidyr`) tremendously increases sustainability on the long term, since tidyverse functions change quite often. Most of our functions are replaced with versions that only rely on base R, which keeps this package fully functional for many years to come, without requiring a lot of maintenance to keep up with other packages anymore. The only dependencies that remained are for extending methods of other packages, like `pillar` and `vctrs` for printing and working with tibbles using our classes `mo` and `ab`.
* Removed function `read.4d()`, that was only useful for reading from an old test database.
# AMR 1.1.0
diff --git a/R/aa_helper_functions.R b/R/aa_helper_functions.R
index a0232f695..56a24bacd 100755
--- a/R/aa_helper_functions.R
+++ b/R/aa_helper_functions.R
@@ -338,12 +338,6 @@ font_stripstyle <- function(x) {
}
progress_estimated <- function(n = 1, n_min = 0, ...) {
- # initiate with:
- # progress <- progressbar(n)
- # on.exit(close(progress))
- #
- # update with:
- # progress$tick()
if (n >= n_min) {
pb <- utils::txtProgressBar(max = n, style = 3)
pb$tick <- function() {
@@ -431,3 +425,29 @@ percentage <- function(x, digits = NULL, ...) {
class = c("percentage", "numeric")),
digits = digits, ...)
}
+
+# prevent dependency on package 'backports'
+strrep = function(x, times) {
+ x = as.character(x)
+ if (length(x) == 0L)
+ return(x)
+ unlist(.mapply(function(x, times) {
+ if (is.na(x) || is.na(times))
+ return(NA_character_)
+ if (times <= 0L)
+ return("")
+ paste0(replicate(times, x), collapse = "")
+ }, list(x = x, times = times), MoreArgs = list()), use.names = FALSE)
+}
+trimws <- function (x, which = c("both", "left", "right")) {
+ which = match.arg(which)
+ mysub = function(re, x) sub(re, "", x, perl = TRUE)
+ if (which == "left")
+ return(mysub("^[ \t\r\n]+", x))
+ if (which == "right")
+ return(mysub("[ \t\r\n]+$", x))
+ mysub("[ \t\r\n]+$", mysub("^[ \t\r\n]+", x))
+}
+isFALSE <- function (x) {
+ is.logical(x) && length(x) == 1L && !is.na(x) && !x
+}
diff --git a/R/atc_online.R b/R/atc_online.R
index 00330f27f..2ddbc5993 100644
--- a/R/atc_online.R
+++ b/R/atc_online.R
@@ -129,7 +129,8 @@ atc_online_property <- function(atc_code,
}
progress <- progress_estimated(n = length(atc_code))
-
+ on.exit(close(progress))
+
for (i in seq_len(length(atc_code))) {
progress$tick()
diff --git a/R/bug_drug_combinations.R b/R/bug_drug_combinations.R
index 5df13f477..3e2405d98 100644
--- a/R/bug_drug_combinations.R
+++ b/R/bug_drug_combinations.R
@@ -32,7 +32,6 @@
#' @param ... arguments passed on to `FUN`
#' @inheritParams rsi_df
#' @inheritParams base::formatC
-#' @importFrom tidyr pivot_longer
#' @details The function [format()] calculates the resistance per bug-drug combination. Use `combine_IR = FALSE` (default) to test R vs. S+I and `combine_IR = TRUE` to test R+I vs. S.
#'
#' The language of the output can be overwritten with `options(AMR_locale)`, please see [translate].
@@ -73,28 +72,41 @@ bug_drug_combinations <- function(x,
stop("`col_mo` must be set.", call. = FALSE)
}
- select_rsi <- function(.data) {
- .data[, c(col_mo, names(which(sapply(.data, is.rsi))))]
+ x <- as.data.frame(x, stringsAsFactors = FALSE)
+ x[, col_mo] <- FUN(x[, col_mo, drop = TRUE])
+ x <- x[, c(col_mo, names(which(sapply(x, is.rsi))))]
+
+ unique_mo <- sort(unique(x[, col_mo, drop = TRUE]))
+
+ out <- data.frame(
+ mo = character(0),
+ ab = character(0),
+ S = integer(0),
+ I = integer(0),
+ R = integer(0),
+ total = integer(0))
+
+ for (i in seq_len(length(unique_mo))) {
+ # filter on MO group and only select R/SI columns
+ x_mo_filter <- x[which(x[, col_mo, drop = TRUE] == unique_mo[i]), names(which(sapply(x, is.rsi)))]
+ # turn and merge everything
+ pivot <- lapply(x_mo_filter, function(x) {
+ m <- as.matrix(table(x))
+ data.frame(S = m["S", ], I = m["I", ], R = m["R", ], stringsAsFactors = FALSE)
+ })
+ merged <- do.call(rbind, pivot)
+ out_group <- data.frame(mo = unique_mo[i],
+ ab = rownames(merged),
+ S = merged$S,
+ I = merged$I,
+ R = merged$R,
+ total = merged$S + merged$I + merged$R)
+ out <- rbind(out, out_group)
}
- x <- x %>% as.data.frame(stringsAsFactors = FALSE)
- x$mo <- FUN(x[, col_mo, drop = TRUE])
-
- x <- x %>%
- select_rsi() %>%
- pivot_longer(-mo, names_to = "ab") %>%
- group_by(mo, ab) %>%
- summarise(S = sum(value == "S", na.rm = TRUE),
- I = sum(value == "I", na.rm = TRUE),
- R = sum(value == "R", na.rm = TRUE)) %>%
- ungroup() %>%
- mutate(total = S + I + R) %>%
- as.data.frame(stringsAsFactors = FALSE)
-
- structure(.Data = x, class = c("bug_drug_combinations", class(x)))
+ structure(.Data = out, class = c("bug_drug_combinations", class(x)))
}
-#' @importFrom tidyr pivot_wider
#' @exportMethod format.bug_drug_combinations
#' @export
#' @rdname bug_drug_combinations
@@ -109,10 +121,10 @@ format.bug_drug_combinations <- function(x,
decimal.mark = getOption("OutDec"),
big.mark = ifelse(decimal.mark == ",", ".", ","),
...) {
- x <- x %>% subset(total >= minimum)
+ x <- subset(x, total >= minimum)
if (remove_intrinsic_resistant == TRUE) {
- x <- x %>% subset(R != total)
+ x <- subset(x, R != total)
}
if (combine_SI == TRUE | combine_IR == FALSE) {
x$isolates <- x$R
@@ -137,7 +149,10 @@ format.bug_drug_combinations <- function(x,
}
remove_NAs <- function(.data) {
- as.data.frame(sapply(.data, function(x) ifelse(is.na(x), "", x), simplify = FALSE))
+ cols <- colnames(.data)
+ .data <- as.data.frame(sapply(.data, function(x) ifelse(is.na(x), "", x), simplify = FALSE))
+ colnames(.data) <- cols
+ .data
}
create_var <- function(.data, ...) {
@@ -161,14 +176,26 @@ format.bug_drug_combinations <- function(x,
" (", trimws(format(y$isolates, big.mark = big.mark)), "/",
trimws(format(y$total, big.mark = big.mark)), ")")) %>%
select(ab, ab_txt, mo, txt) %>%
- arrange(mo) %>%
- pivot_wider(names_from = mo, values_from = txt) %>%
+ arrange(mo)
+
+ # replace tidyr::pivot_wider() from here
+ for (i in unique(y$mo)) {
+ mo_group <- y[which(y$mo == i), c("ab", "txt")]
+ colnames(mo_group) <- c("ab", i)
+ rownames(mo_group) <- NULL
+ y <- y %>%
+ left_join(mo_group, by = "ab")
+ }
+ y <- y %>%
+ distinct(ab, .keep_all = TRUE) %>%
+ select(-mo, -txt) %>%
+ # replace tidyr::pivot_wider() until here
remove_NAs()
select_ab_vars <- function(.data) {
.data[, c("ab_group", "ab_txt", colnames(.data)[!colnames(.data) %in% c("ab_group", "ab_txt", "ab")])]
}
-
+
y <- y %>%
create_var(ab_group = ab_group(y$ab, language = language)) %>%
select_ab_vars() %>%
@@ -177,13 +204,17 @@ format.bug_drug_combinations <- function(x,
create_var(ab_group = ifelse(y$ab_group != lag(y$ab_group) | is.na(lag(y$ab_group)), y$ab_group, ""))
if (add_ab_group == FALSE) {
- y <- y %>% select(-ab_group) %>% rename("Drug" = ab_txt)
+ y <- y %>%
+ select(-ab_group) %>%
+ rename("Drug" = ab_txt)
colnames(y)[1] <- translate_AMR(colnames(y)[1], language = get_locale(), only_unknown = FALSE)
} else {
y <- y %>% rename("Group" = ab_group,
"Drug" = ab_txt)
colnames(y)[1:2] <- translate_AMR(colnames(y)[1:2], language = get_locale(), only_unknown = FALSE)
}
+
+ rownames(y) <- NULL
y
}
diff --git a/R/rsi_calc.R b/R/rsi_calc.R
index ad6e3ec45..1c527d6ce 100755
--- a/R/rsi_calc.R
+++ b/R/rsi_calc.R
@@ -45,7 +45,7 @@ rsi_calc <- function(...,
stop("`only_all_tested` must be logical", call. = FALSE)
}
- dots_df <- ...elt(1) # it needs this evaluation
+ dots_df <- switch(1, ...) # it needs this evaluation
dots <- base::eval(base::substitute(base::alist(...)))
if ("also_single_tested" %in% names(dots)) {
stop("`also_single_tested` was replaced by `only_all_tested`. Please read Details in the help page (`?proportion`) as this may have a considerable impact on your analysis.", call. = FALSE)
diff --git a/R/zzz.R b/R/zzz.R
index 19062ce3e..fdbd08f13 100755
--- a/R/zzz.R
+++ b/R/zzz.R
@@ -20,9 +20,6 @@
# ==================================================================== #
.onLoad <- function(libname, pkgname) {
- # get new functions not available in older versions of R
- backports::import(pkgname)
-
assign(x = "MO_lookup",
value = create_MO_lookup(),
envir = asNamespace("AMR"))
@@ -34,7 +31,6 @@
assign(x = "mo_codes_v0.5.0",
value = make_trans_tbl(),
envir = asNamespace("AMR"))
-
}
# maybe add survey later: "https://www.surveymonkey.com/r/AMR_for_R"
@@ -55,13 +51,13 @@ create_MO_lookup <- function() {
MO_lookup$subspecies)))
MO_lookup[MO_lookup$genus == "" | grepl("^[(]unknown ", MO_lookup$fullname), "fullname_lower"] <- tolower(trimws(MO_lookup[MO_lookup$genus == "" | grepl("^[(]unknown ", MO_lookup$fullname),
"fullname"]))
- MO_lookup$fullname_lower <- gsub("[^.a-z0-9/ \\-]+", "",MO_lookup$fullname_lower)
+ MO_lookup$fullname_lower <- gsub("[^.a-z0-9/ \\-]+", "", MO_lookup$fullname_lower)
# add a column with only "e coli" like combinations
MO_lookup$g_species <- gsub("^([a-z])[a-z]+ ([a-z]+) ?.*", "\\1 \\2", MO_lookup$fullname_lower)
# so arrange data on prevalence first, then kingdom, then full name
- MO_lookup[order(MO_lookup$prevalence, MO_lookup$kingdom_index, MO_lookup$fullname_lower),]
+ MO_lookup[order(MO_lookup$prevalence, MO_lookup$kingdom_index, MO_lookup$fullname_lower), ]
}
create_MO.old_lookup <- function() {
@@ -75,7 +71,7 @@ create_MO.old_lookup <- function() {
MO.old_lookup$g_species <- gsub("^([a-z])[a-z]+ ([a-z]+) ?.*", "\\1 \\2", MO.old_lookup$fullname_lower)
# so arrange data on prevalence first, then full name
- MO.old_lookup[order(MO.old_lookup$prevalence, MO.old_lookup$fullname_lower),]
+ MO.old_lookup[order(MO.old_lookup$prevalence, MO.old_lookup$fullname_lower), ]
}
make_trans_tbl <- function() {
diff --git a/docs/404.html b/docs/404.html
index 96528771d..ceb363bee 100644
--- a/docs/404.html
+++ b/docs/404.html
@@ -81,7 +81,7 @@
AMR (for R)
- 1.1.0.9010
+ 1.1.0.9011
diff --git a/docs/LICENSE-text.html b/docs/LICENSE-text.html
index d72f6811d..e3f2fee66 100644
--- a/docs/LICENSE-text.html
+++ b/docs/LICENSE-text.html
@@ -81,7 +81,7 @@
AMR (for R)
- 1.1.0.9010
+ 1.1.0.9011
diff --git a/docs/articles/index.html b/docs/articles/index.html
index 9481d0a31..31cbb7a49 100644
--- a/docs/articles/index.html
+++ b/docs/articles/index.html
@@ -81,7 +81,7 @@
AMR (for R)
- 1.1.0.9010
+ 1.1.0.9011
diff --git a/docs/authors.html b/docs/authors.html
index 26f86f682..5655c6777 100644
--- a/docs/authors.html
+++ b/docs/authors.html
@@ -81,7 +81,7 @@
AMR (for R)
- 1.1.0.9010
+ 1.1.0.9011
diff --git a/docs/index.html b/docs/index.html
index 57c7851b0..34fcaa92d 100644
--- a/docs/index.html
+++ b/docs/index.html
@@ -43,7 +43,7 @@
AMR (for R)
- 1.1.0.9010
+ 1.1.0.9011
@@ -198,12 +198,12 @@ A methods paper about this package has been preprinted at bioRxiv (DOI: 10.1101/
What is AMR
(for R)?
(TLDR - to find out how to conduct AMR analysis, please continue reading here to get started.
-AMR
is a free and open-source R package to simplify the analysis and prediction of Antimicrobial Resistance (AMR) and to work with microbial and antimicrobial data and properties, by using evidence-based methods. Our aim is to provide a standard for clean and reproducible antimicrobial resistance data analysis, that can therefore empower epidemiological analyses to continuously enable surveillance and treatment evaluation in any setting.
+AMR
is a free, open-source and independent R package to simplify the analysis and prediction of Antimicrobial Resistance (AMR) and to work with microbial and antimicrobial data and properties, by using evidence-based methods. Our aim is to provide a standard for clean and reproducible antimicrobial resistance data analysis, that can therefore empower epidemiological analyses to continuously enable surveillance and treatment evaluation in any setting.
After installing this package, R knows ~70,000 distinct microbial species and all ~550 antibiotic, antimycotic and antiviral drugs by name and code (including ATC, LOINC and SNOMED CT), and knows all about valid R/SI and MIC values. It supports any data format, including WHONET/EARS-Net data.
We created this package for both routine data analysis and academic research (as part of our PhD theses) at the Faculty of Medical Sciences of the University of Groningen, the Netherlands, and the Medical Microbiology & Infection Prevention (MMBI) department of the University Medical Center Groningen (UMCG). This R package is actively maintained and is free software (see Copyright).
-
Used in more than 100 countries
Since its first public release in early 2018, this package has been downloaded from more than 100 countries (as of March 2020, CRAN logs). Click the map to enlarge, to see the names of the countries.
+
Used in more than 100 countries
Since its first public release in early 2018, this package has been downloaded from more than 100 countries (source: CRAN logs). Click the map to enlarge, to see the names of the countries.
diff --git a/docs/news/index.html b/docs/news/index.html
index f79d47bae..f17b64653 100644
--- a/docs/news/index.html
+++ b/docs/news/index.html
@@ -81,7 +81,7 @@
AMR (for R)
- 1.1.0.9010
+ 1.1.0.9011
@@ -229,9 +229,9 @@
Source: NEWS.md
-
-
Used in more than 100 countries
- Since its first public release in early 2018, this package has been downloaded from more than 100 countries (as of March 2020, CRAN logs). Click the map to enlarge, to see the names of the countries.
+ Since its first public release in early 2018, this package has been downloaded from more than 100 countries
(source: CRAN logs). Click the map to enlarge, to see the names of the countries.
#### Partners