P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2025-07-08 21:22:01 +02:00
Code Releases Activity

(v1.6.0.9016) website update and c() fixes

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2021-05-03 13:06:43 +02:00
parent 12a8d59869
commit f33e61bac7
25 changed files with 97 additions and 47 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
R/aa_helper_functions.R
View File

@ -458,7 +458,7 @@ stop_ifnot <- function(expr, ..., call = TRUE) {
ifelse(!is.na(y), y, NA))
}
class_integrity_check <- function(value, type, check_vector) {
return_after_integrity_check <- function(value, type, check_vector) {
if (!all(value[!is.na(value)] %in% check_vector)) {
warning_(paste0("invalid ", type, ", NA generated"), call = FALSE)
value[!value %in% check_vector] <- NA

9
R/ab.R
View File

@ -551,7 +551,7 @@ as.data.frame.ab <- function(x, ...) {
"[<-.ab" <- function(i, j, ..., value) {
y <- NextMethod()
attributes(y) <- attributes(i)
class_integrity_check(y, "antimicrobial code", antibiotics$ab)
return_after_integrity_check(y, "antimicrobial code", antibiotics$ab)
}
#' @method [[<- ab
#' @export
@ -559,15 +559,16 @@ as.data.frame.ab <- function(x, ...) {
"[[<-.ab" <- function(i, j, ..., value) {
y <- NextMethod()
attributes(y) <- attributes(i)
class_integrity_check(y, "antimicrobial code", antibiotics$ab)
return_after_integrity_check(y, "antimicrobial code", antibiotics$ab)
}
#' @method c ab
#' @export
#' @noRd
c.ab <- function(x, ...) {
c.ab <- function(...) {
x <- list(...)[[1L]]
y <- NextMethod()
attributes(y) <- attributes(x)
class_integrity_check(y, "antimicrobial code", antibiotics$ab)
return_after_integrity_check(y, "antimicrobial code", antibiotics$ab)
}
#' @method unique ab

7
R/disk.R
View File

@ -182,11 +182,8 @@ print.disk <- function(x, ...) {
#' @method c disk
#' @export
#' @noRd
c.disk <- function(x, ...) {
y <- NextMethod()
y <- as.disk(y)
attributes(y) <- attributes(x)
y
c.disk <- function(...) {
as.disk(unlist(lapply(list(...), as.character)))
}
#' @method unique disk

5
R/italicise_taxonomy.R
View File

@ -115,5 +115,8 @@ italicise_taxonomy <- function(string, type = c("markdown", "ansi")) {
#' @rdname italicise_taxonomy
#' @export
italicize_taxonomy <- function(string, type = c("markdown", "ansi")) {
italicise(string = string, type = type)
if (missing(type)) {
type <- "markdown"
}
italicise_taxonomy(string = string, type = type)
}

6
R/mic.R
View File

@ -307,10 +307,8 @@ as.matrix.mic <- function(x, ...) {
#' @method c mic
#' @export
#' @noRd
c.mic <- function(x, ...) {
y <- unlist(lapply(list(...), as.character))
x <- as.character(x)
as.mic(c(x, y))
c.mic <- function(...) {
as.mic(unlist(lapply(list(...), as.character)))
}
#' @method unique mic

31
R/mo.R
View File

@ -1677,7 +1677,7 @@ pillar_shaft.mo <- function(x, ...) {
} else {
col <- "The data"
}
warning_(col, " contains old microbial codes (from a previous AMR package version). ",
warning_(col, " contains old MO codes (from a previous AMR package version). ",
"Please update your MO codes with `as.mo()`.",
call = FALSE)
}
@ -1751,6 +1751,11 @@ print.mo <- function(x, print.shortnames = FALSE, ...) {
}
x <- as.character(x)
names(x) <- x_names
if (!all(x[!is.na(x)] %in% MO_lookup$mo)) {
warning_("Some MO codes are from a previous AMR package version. ",
"Please update these MO codes with `as.mo()`.",
call = FALSE)
}
print.default(x, quote = FALSE)
}
@ -1777,7 +1782,7 @@ summary.mo <- function(object, ...) {
#' @noRd
as.data.frame.mo <- function(x, ...) {
if (!all(x[!is.na(x)] %in% MO_lookup$mo)) {
warning_("The data contains old microbial codes (from a previous AMR package version). ",
warning_("The data contains old MO codes (from a previous AMR package version). ",
"Please update your MO codes with `as.mo()`.",
call = FALSE)
}
@ -1812,8 +1817,8 @@ as.data.frame.mo <- function(x, ...) {
y <- NextMethod()
attributes(y) <- attributes(i)
# must only contain valid MOs
class_integrity_check(y, "microorganism code", c(as.character(microorganisms$mo),
as.character(microorganisms.translation$mo_old)))
return_after_integrity_check(y, "microorganism code", c(as.character(microorganisms$mo),
as.character(microorganisms.translation$mo_old)))
}
#' @method [[<- mo
#' @export
@ -1822,18 +1827,18 @@ as.data.frame.mo <- function(x, ...) {
y <- NextMethod()
attributes(y) <- attributes(i)
# must only contain valid MOs
class_integrity_check(y, "microorganism code", c(as.character(microorganisms$mo),
as.character(microorganisms.translation$mo_old)))
return_after_integrity_check(y, "microorganism code", c(as.character(microorganisms$mo),
as.character(microorganisms.translation$mo_old)))
}
#' @method c mo
#' @export
#' @noRd
c.mo <- function(x, ...) {
c.mo <- function(...) {
x <- list(...)[[1L]]
y <- NextMethod()
attributes(y) <- attributes(x)
# must only contain valid MOs
class_integrity_check(y, "microorganism code", c(as.character(microorganisms$mo),
as.character(microorganisms.translation$mo_old)))
return_after_integrity_check(y, "microorganism code", c(as.character(microorganisms$mo),
as.character(microorganisms.translation$mo_old)))
}
#' @method unique mo
@ -2058,10 +2063,10 @@ replace_old_mo_codes <- function(x, property) {
n_matched <- length(matched[!is.na(matched)])
if (property != "mo") {
message_(font_blue(paste0("The input contained ", n_matched,
" old microbial code", ifelse(n_matched == 1, "", "s"),
" old MO code", ifelse(n_matched == 1, "", "s"),
" (from a previous AMR package version). Please update your MO codes with `as.mo()`.")))
} else {
message_(font_blue(paste0(n_matched, " old microbial code", ifelse(n_matched == 1, "", "s"),
message_(font_blue(paste0(n_matched, " old MO code", ifelse(n_matched == 1, "", "s"),
" (from a previous AMR package version) ",
ifelse(n_matched == 1, "was", "were"),
" updated to ", ifelse(n_matched == 1, "a ", ""),
@ -2100,7 +2105,7 @@ repair_reference_df <- function(reference_df) {
reference_df[, "x"] <- as.character(reference_df[, "x", drop = TRUE])
reference_df[, "mo"] <- as.character(reference_df[, "mo", drop = TRUE])
# some microbial codes might be old
# some MO codes might be old
reference_df[, "mo"] <- as.mo(reference_df[, "mo", drop = TRUE])
reference_df
}