mirror of
				https://github.com/msberends/AMR.git
				synced 2025-10-31 07:28:17 +01:00 
			
		
		
		
	| @@ -1,6 +1,6 @@ | ||||
| Package: AMR | ||||
| Version: 3.0.0.9026 | ||||
| Date: 2025-09-04 | ||||
| Version: 3.0.0.9027 | ||||
| Date: 2025-09-10 | ||||
| Title: Antimicrobial Resistance Data Analysis | ||||
| Description: Functions to simplify and standardise antimicrobial resistance (AMR) | ||||
|   data analysis and to work with microbial and antimicrobial properties by | ||||
|   | ||||
| @@ -388,6 +388,7 @@ if(getRversion() >= "3.0.0") S3method(pillar::type_sum, av) | ||||
| if(getRversion() >= "3.0.0") S3method(pillar::type_sum, mic) | ||||
| if(getRversion() >= "3.0.0") S3method(pillar::type_sum, mo) | ||||
| if(getRversion() >= "3.0.0") S3method(pillar::type_sum, sir) | ||||
| if(getRversion() >= "3.0.0") S3method(skimr::get_skimmers, ab) | ||||
| if(getRversion() >= "3.0.0") S3method(skimr::get_skimmers, disk) | ||||
| if(getRversion() >= "3.0.0") S3method(skimr::get_skimmers, mic) | ||||
| if(getRversion() >= "3.0.0") S3method(skimr::get_skimmers, mo) | ||||
|   | ||||
							
								
								
									
										4
									
								
								NEWS.md
									
									
									
									
									
								
							
							
						
						
									
										4
									
								
								NEWS.md
									
									
									
									
									
								
							| @@ -1,4 +1,4 @@ | ||||
| # AMR 3.0.0.9026 | ||||
| # AMR 3.0.0.9027 | ||||
|  | ||||
| This is a bugfix release following the release of v3.0.0 in June 2025. | ||||
|  | ||||
| @@ -13,8 +13,10 @@ This is a bugfix release following the release of v3.0.0 in June 2025. | ||||
| * Fixed a bug the `antimicrobials` data set to remove statins (#229) | ||||
| * Fixed a bug in `mdro()` to make sure all genes specified in arguments are acknowledged | ||||
| * Fixed ATC J01CR05 to map to piperacillin/tazobactam rather than piperacillin/sulbactam (#230) | ||||
| * Fixed skimmers (`skimr` package) of class `ab`, `sir`, and `disk` (#234) | ||||
| * Fixed all plotting to contain a separate colour for SDD (susceptible dose-dependent) (#223) | ||||
| * Fixed some specific Dutch translations for antimicrobials | ||||
| * Added a warning to `as.ab()` if input resembles antiviral codes or names (#232) | ||||
| * Added all reasons in verbose output of `mdro()` (#227) | ||||
| * Added `names` to `age_groups()` so that custom names can be given (#215) | ||||
| * Added note to `as.sir()` to make it explicit when higher-level taxonomic breakpoints are used (#218) | ||||
|   | ||||
							
								
								
									
										19
									
								
								R/ab.R
									
									
									
									
									
								
							
							
						
						
									
										19
									
								
								R/ab.R
									
									
									
									
									
								
							| @@ -202,6 +202,9 @@ as.ab <- function(x, flag_multiple_results = TRUE, language = get_AMR_locale(), | ||||
|   if (sum(already_known) < length(x)) { | ||||
|     progress <- progress_ticker(n = sum(!already_known), n_min = 25, print = info) # start if n >= 25 | ||||
|     on.exit(close(progress)) | ||||
|     if (any(x_new[!already_known] %in% unlist(AMR_env$AV_lookup$generalised_all, use.names = FALSE), na.rm = TRUE)) { | ||||
|       warning_("in `as.ab()`: some input seem to resemble antiviral drugs - use `as.av()` or e.g. `av_name()` for these, not `as.ab()` or e.g. `ab_name()`.") | ||||
|     } | ||||
|   } | ||||
|  | ||||
|   for (i in which(!already_known)) { | ||||
| @@ -448,7 +451,7 @@ as.ab <- function(x, flag_multiple_results = TRUE, language = get_AMR_locale(), | ||||
|   x_unknown <- x_unknown[!x_unknown %in% c("", NA)] | ||||
|   if (length(x_unknown) > 0 && fast_mode == FALSE) { | ||||
|     warning_( | ||||
|       "in `as.ab()`: these values could not be coerced to a valid antimicrobial ID: ", | ||||
|       "in `as.ab()`: ", ifelse(length(unique(x_unknown)) == 1, "this value", "these values"), " could not be coerced to a valid antimicrobial ID: ", | ||||
|       vector_and(x_unknown), "." | ||||
|     ) | ||||
|   } | ||||
| @@ -627,6 +630,20 @@ rep.ab <- function(x, ...) { | ||||
|   out | ||||
| } | ||||
|  | ||||
| # this prevents the requirement for putting the dependency in Imports: | ||||
| #' @rawNamespace if(getRversion() >= "3.0.0") S3method(skimr::get_skimmers, ab) | ||||
| get_skimmers.ab <- function(column) { | ||||
|   ab <- as.ab(column, info = FALSE) | ||||
|   ab <- ab[!is.na(ab)] | ||||
|   skimr::sfl( | ||||
|     skim_type = "ab", | ||||
|     n_unique = ~ length(unique(ab)), | ||||
|     top_ab = ~ names(sort(-table(ab)))[1L], | ||||
|     top_ab_name = ~ names(sort(-table(ab_name(ab, info = FALSE))))[1L], | ||||
|     top_group = ~ names(sort(-table(ab_group(ab, info = FALSE))))[1L] | ||||
|   ) | ||||
| } | ||||
|  | ||||
| generalise_antibiotic_name <- function(x) { | ||||
|   x <- toupper(x) | ||||
|   # remove suffices | ||||
|   | ||||
							
								
								
									
										12
									
								
								R/disk.R
									
									
									
									
									
								
							
							
						
						
									
										12
									
								
								R/disk.R
									
									
									
									
									
								
							| @@ -236,12 +236,14 @@ rep.disk <- function(x, ...) { | ||||
| # this prevents the requirement for putting the dependency in Imports: | ||||
| #' @rawNamespace if(getRversion() >= "3.0.0") S3method(skimr::get_skimmers, disk) | ||||
| get_skimmers.disk <- function(column) { | ||||
|   column <- as.integer(column) | ||||
|   skimr::sfl( | ||||
|     skim_type = "disk", | ||||
|     min = ~ min(as.double(.), na.rm = TRUE), | ||||
|     max = ~ max(as.double(.), na.rm = TRUE), | ||||
|     median = ~ stats::median(as.double(.), na.rm = TRUE), | ||||
|     n_unique = ~ length(unique(stats::na.omit(.))), | ||||
|     hist = ~ skimr::inline_hist(stats::na.omit(as.double(.))) | ||||
|     p0 = ~ stats::quantile(column, probs = 0, na.rm = TRUE, names = FALSE), | ||||
|     p25 = ~ stats::quantile(column, probs = 0.25, na.rm = TRUE, names = FALSE), | ||||
|     p50 = ~ stats::quantile(column, probs = 0.5, na.rm = TRUE, names = FALSE), | ||||
|     p75 = ~ stats::quantile(column, probs = 0.75, na.rm = TRUE, names = FALSE), | ||||
|     p100 = ~ stats::quantile(column, probs = 1, na.rm = TRUE, names = FALSE), | ||||
|     hist = ~ skimr::inline_hist(stats::na.omit(column), 10) | ||||
|   ) | ||||
| } | ||||
|   | ||||
							
								
								
									
										12
									
								
								R/mic.R
									
									
									
									
									
								
							
							
						
						
									
										12
									
								
								R/mic.R
									
									
									
									
									
								
							| @@ -596,12 +596,12 @@ get_skimmers.mic <- function(column) { | ||||
|   column <- as.mic(column) # make sure that currently implemented MIC levels are used | ||||
|   skimr::sfl( | ||||
|     skim_type = "mic", | ||||
|     p0 = ~ stats::quantile(., probs = 0, na.rm = TRUE, names = FALSE), | ||||
|     p25 = ~ stats::quantile(., probs = 0.25, na.rm = TRUE, names = FALSE), | ||||
|     p50 = ~ stats::quantile(., probs = 0.5, na.rm = TRUE, names = FALSE), | ||||
|     p75 = ~ stats::quantile(., probs = 0.75, na.rm = TRUE, names = FALSE), | ||||
|     p100 = ~ stats::quantile(., probs = 1, na.rm = TRUE, names = FALSE), | ||||
|     hist = ~ skimr::inline_hist(log2(stats::na.omit(.)), 5) | ||||
|     p0 = ~ stats::quantile(column, probs = 0, na.rm = TRUE, names = FALSE), | ||||
|     p25 = ~ stats::quantile(column, probs = 0.25, na.rm = TRUE, names = FALSE), | ||||
|     p50 = ~ stats::quantile(column, probs = 0.5, na.rm = TRUE, names = FALSE), | ||||
|     p75 = ~ stats::quantile(column, probs = 0.75, na.rm = TRUE, names = FALSE), | ||||
|     p100 = ~ stats::quantile(column, probs = 1, na.rm = TRUE, names = FALSE), | ||||
|     hist = ~ skimr::inline_hist(log2(stats::na.omit(column)), 10) | ||||
|   ) | ||||
| } | ||||
|  | ||||
|   | ||||
							
								
								
									
										14
									
								
								R/mo.R
									
									
									
									
									
								
							
							
						
						
									
										14
									
								
								R/mo.R
									
									
									
									
									
								
							| @@ -747,13 +747,17 @@ freq.mo <- function(x, ...) { | ||||
| # this prevents the requirement for putting the dependency in Imports: | ||||
| #' @rawNamespace if(getRversion() >= "3.0.0") S3method(skimr::get_skimmers, mo) | ||||
| get_skimmers.mo <- function(column) { | ||||
|   mo <- as.mo(column, keep_synonyms = TRUE, language = NULL, info = FALSE) | ||||
|   mo <- mo[!is.na(mo)] | ||||
|   spp <- mo[mo_species(mo, keep_synonyms = TRUE, language = NULL, info = FALSE) != ""] | ||||
|   skimr::sfl( | ||||
|     skim_type = "mo", | ||||
|     unique_total = ~ length(unique(stats::na.omit(.))), | ||||
|     gram_negative = ~ sum(mo_is_gram_negative(.), na.rm = TRUE), | ||||
|     gram_positive = ~ sum(mo_is_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] | ||||
|     n_unique = ~ length(unique(mo)), | ||||
|     gram_negative = ~ sum(mo_is_gram_negative(mo, keep_synonyms = TRUE, language = NULL, info = FALSE), na.rm = TRUE), | ||||
|     gram_positive = ~ sum(mo_is_gram_positive(mo, keep_synonyms = TRUE, language = NULL, info = FALSE), na.rm = TRUE), | ||||
|     yeast = ~ sum(mo_is_yeast(mo, keep_synonyms = TRUE, language = NULL, info = FALSE), na.rm = TRUE), | ||||
|     top_genus = ~ names(sort(-table(mo_genus(mo, keep_synonyms = TRUE, language = NULL, info = FALSE))))[1L], | ||||
|     top_species = ~ names(sort(-table(mo_name(spp, keep_synonyms = TRUE, language = NULL, info = FALSE))))[1L], | ||||
|   ) | ||||
| } | ||||
|  | ||||
|   | ||||
							
								
								
									
										33
									
								
								R/sir.R
									
									
									
									
									
								
							
							
						
						
									
										33
									
								
								R/sir.R
									
									
									
									
									
								
							| @@ -1974,33 +1974,18 @@ freq.sir <- function(x, ...) { | ||||
| # this prevents the requirement for putting the dependency in Imports: | ||||
| #' @rawNamespace if(getRversion() >= "3.0.0") S3method(skimr::get_skimmers, sir) | ||||
| get_skimmers.sir <- function(column) { | ||||
|   # get the variable name 'skim_variable' | ||||
|   name_call <- function(.data) { | ||||
|     calls <- sys.calls() | ||||
|     frms <- sys.frames() | ||||
|     calls_txt <- vapply(calls, function(x) paste(deparse(x), collapse = ""), FUN.VALUE = character(1)) | ||||
|     if (any(calls_txt %like% "skim_variable", na.rm = TRUE)) { | ||||
|       ind <- which(calls_txt %like% "skim_variable")[1L] | ||||
|       vars <- tryCatch(eval(parse(text = ".data$skim_variable$sir"), envir = frms[[ind]]), | ||||
|         error = function(e) NULL | ||||
|       ) | ||||
|       tryCatch(ab_name(as.character(calls[[length(calls)]][[2]]), language = NULL, info = FALSE), | ||||
|         error = function(e) NA_character_ | ||||
|       ) | ||||
|     } else { | ||||
|       NA_character_ | ||||
|     } | ||||
|   } | ||||
|  | ||||
|   # TODO add here in AMR 3.1.0 details about guideline | ||||
|   skimr::sfl( | ||||
|     skim_type = "sir", | ||||
|     ab_name = name_call, | ||||
|     count_R = count_R, | ||||
|     count_S = count_susceptible, | ||||
|     # guideline = function(x) "EUCAST 2025", # or "Multiple" | ||||
|     # origin = function(x) "MIC", # or "Multiple" | ||||
|     count_S = count_S, | ||||
|     count_I = count_I, | ||||
|     prop_R = ~ proportion_R(., minimum = 0), | ||||
|     prop_S = ~ susceptibility(., minimum = 0), | ||||
|     prop_I = ~ proportion_I(., minimum = 0) | ||||
|     count_R = count_R, | ||||
|     prop_S = ~ round(proportion_S(., minimum = 0) * 100, 1), | ||||
|     prop_I = ~ round(proportion_I(., minimum = 0) * 100, 1), | ||||
|     prop_R = ~ round(proportion_R(., minimum = 0) * 100, 1), | ||||
|     hist = ~ skimr::inline_hist(as.double(stats::na.omit(.)), 3) | ||||
|   ) | ||||
| } | ||||
|  | ||||
|   | ||||
| @@ -96,6 +96,14 @@ test_that("test-ab.R", { | ||||
|     rep("GEH", 8) | ||||
|   ) | ||||
|  | ||||
|   # skimr | ||||
|   if (AMR:::pkg_is_available("skimr", min_version = "2.0.0", also_load = TRUE)) { | ||||
|     expect_named( | ||||
|       skim(clinical_breakpoints$ab), | ||||
|       c("skim_type", "skim_variable", "n_missing", "complete_rate", "ab.n_unique", "ab.top_ab", "ab.top_ab_name", "ab.top_group") | ||||
|     ) | ||||
|   } | ||||
|  | ||||
|   # assigning and subsetting | ||||
|   x <- AMR::antimicrobials$ab | ||||
|   expect_inherits(x[1], "ab") | ||||
|   | ||||
| @@ -60,4 +60,12 @@ test_that("test-disk.R", { | ||||
|   if (AMR:::pkg_is_available("tibble")) { | ||||
|     expect_output(print(tibble::tibble(d = as.disk(12)))) | ||||
|   } | ||||
|  | ||||
|   # skimr | ||||
|   if (AMR:::pkg_is_available("skimr", min_version = "2.0.0", also_load = TRUE)) { | ||||
|     expect_named( | ||||
|       skim(random_disk(100)), | ||||
|       c("skim_type", "skim_variable", "n_missing", "complete_rate", "disk.p0", "disk.p25", "disk.p50", "disk.p75", "disk.p100", "disk.hist") | ||||
|     ) | ||||
|   } | ||||
| }) | ||||
|   | ||||
| @@ -81,6 +81,14 @@ test_that("test-mic.R", { | ||||
|     expect_output(print(tibble::tibble(m = as.mic(2:4)))) | ||||
|   } | ||||
|  | ||||
|   # skimr | ||||
|   if (AMR:::pkg_is_available("skimr", min_version = "2.0.0", also_load = TRUE)) { | ||||
|     expect_named( | ||||
|       skim(random_mic(100)), | ||||
|       c("skim_type", "skim_variable", "n_missing", "complete_rate", "mic.p0", "mic.p25", "mic.p50", "mic.p75", "mic.p100", "mic.hist") | ||||
|     ) | ||||
|   } | ||||
|  | ||||
|   # all mathematical operations | ||||
|   x <- random_mic(50) | ||||
|   x_double <- as.double(gsub("[<=>]+", "", as.character(x))) | ||||
|   | ||||
| @@ -321,4 +321,12 @@ test_that("test-mo.R", { | ||||
|   if (AMR:::pkg_is_available("cleaner")) { | ||||
|     expect_inherits(cleaner::freq(example_isolates$mo), "freq") | ||||
|   } | ||||
|  | ||||
|   # skimr | ||||
|   if (AMR:::pkg_is_available("skimr", min_version = "2.0.0", also_load = TRUE)) { | ||||
|     expect_named( | ||||
|       skim(example_isolates$mo), | ||||
|       c("skim_type", "skim_variable", "n_missing", "complete_rate", "mo.n_unique", "mo.gram_negative", "mo.gram_positive", "mo.yeast", "mo.top_genus", "mo.top_species") | ||||
|     ) | ||||
|   } | ||||
| }) | ||||
|   | ||||
| @@ -103,22 +103,13 @@ test_that("test-sir.R", { | ||||
|       pull(MEM) %>% | ||||
|       is.sir()) | ||||
|   } | ||||
|  | ||||
|   # skimr | ||||
|   if (AMR:::pkg_is_available("skimr", min_version = "2.0.0", also_load = TRUE)) { | ||||
|     expect_inherits( | ||||
|       skim(example_isolates), | ||||
|       "data.frame" | ||||
|     expect_named( | ||||
|       skim(example_isolates$PEN), | ||||
|       c("skim_type", "skim_variable", "n_missing", "complete_rate", "sir.count_S", "sir.count_I", "sir.count_R", "sir.prop_S", "sir.prop_I", "sir.prop_R", "sir.hist") | ||||
|     ) | ||||
|     if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) { | ||||
|       expect_inherits( | ||||
|         example_isolates %>% | ||||
|           mutate( | ||||
|             m = as.mic(2), | ||||
|             d = as.disk(20) | ||||
|           ) %>% | ||||
|           skim(), | ||||
|         "data.frame" | ||||
|       ) | ||||
|     } | ||||
|   } | ||||
|  | ||||
|   expect_equal(as.sir(c("", "-", NA, "NULL")), c(NA_sir_, NA_sir_, NA_sir_, NA_sir_)) | ||||
|   | ||||
		Reference in New Issue
	
	Block a user