(v1.2.0.9034) code cleaning

This commit is contained in:
dr. M.S. (Matthijs) Berends 2020-07-13 09:17:24 +02:00
parent c0cf7ab02b
commit 6ab468362d
36 changed files with 266 additions and 265 deletions

View File

@ -1,6 +1,6 @@
Package: AMR
Version: 1.2.0.9033
Date: 2020-07-12
Version: 1.2.0.9034
Date: 2020-07-13
Title: Antimicrobial Resistance Analysis
Authors@R: c(
person(role = c("aut", "cre"),

View File

@ -1,5 +1,5 @@
# AMR 1.2.0.9033
## <small>Last updated: 12-Jul-2020</small>
# AMR 1.2.0.9034
## <small>Last updated: 13-Jul-2020</small>
### New
* Function `ab_from_text()` to retrieve antimicrobial drug names, doses and forms of administration from clinical texts in e.g. health care records, which also corrects for misspelling since it uses `as.ab()` internally

2
R/ab.R
View File

@ -188,7 +188,7 @@ as.ab <- function(x, flag_multiple_results = TRUE, ...) {
# exact LOINC code
loinc_found <- unlist(lapply(antibiotics$loinc,
function(s) x[i] %in% s))
function(s) x[i] %in% s))
found <- antibiotics$ab[loinc_found == TRUE]
if (length(found) > 0) {
x_new[i] <- note_if_more_than_one_found(found, i, from_text)

View File

@ -136,8 +136,8 @@ ab_from_text <- function(text,
text_split[text_split %like_case% to_regex(names_atc)],
text_split[text_split %like_case% to_regex(synonyms_part1)],
text_split[text_split %like_case% to_regex(synonyms_part2)])
),
...)
),
...)
)
})
}

View File

@ -51,8 +51,8 @@ age <- function(x, reference = Sys.Date(), exact = FALSE, na.rm = FALSE) {
# from https://stackoverflow.com/a/25450756/4575331
years_gap <- reference$year - x$year
ages <- ifelse(reference$mon < x$mon | (reference$mon == x$mon & reference$mday < x$mday),
as.integer(years_gap - 1),
as.integer(years_gap))
as.integer(years_gap - 1),
as.integer(years_gap))
# add decimals
if (exact == TRUE) {

View File

@ -172,8 +172,8 @@ format.bug_drug_combinations <- function(x,
y <- y %>%
create_var(txt = paste0(percentage(y$isolates / y$total, decimal.mark = decimal.mark, big.mark = big.mark),
" (", trimws(format(y$isolates, big.mark = big.mark)), "/",
trimws(format(y$total, big.mark = big.mark)), ")")) %>%
" (", trimws(format(y$isolates, big.mark = big.mark)), "/",
trimws(format(y$total, big.mark = big.mark)), ")")) %>%
select(ab, ab_txt, mo, txt) %>%
arrange(mo)

View File

@ -117,7 +117,7 @@ print.catalogue_of_life_version <- function(x, ...) {
" Available at: ", lst$catalogue_of_life$url, "\n",
" Number of included species: ", format(lst$catalogue_of_life$n, big.mark = ","), "\n",
font_underline(paste0(lst$deutsche_sammlung_von_mikroorganismen_und_zellkulturen$version, " (",
lst$deutsche_sammlung_von_mikroorganismen_und_zellkulturen$yearmonth, ")")), "\n",
lst$deutsche_sammlung_von_mikroorganismen_und_zellkulturen$yearmonth, ")")), "\n",
" Available at: ", lst$deutsche_sammlung_von_mikroorganismen_und_zellkulturen$url, "\n",
" Number of included species: ", format(lst$deutsche_sammlung_von_mikroorganismen_und_zellkulturen$n, big.mark = ","), "\n\n",
"=> Total number of species included: ", format(lst$total_included$n_total_species, big.mark = ","), "\n",

View File

@ -702,8 +702,8 @@ eucast_rules <- function(x,
if (info == TRUE & !rule_group_current %like% "other" & eucast_notification_shown == FALSE) {
cat(paste0("\n", font_grey(strrep("-", options()$width - 1)),
"\nRules by the ", font_bold("European Committee on Antimicrobial Susceptibility Testing (EUCAST)"),
"\n", font_blue("http://eucast.org/"), "\n"))
"\nRules by the ", font_bold("European Committee on Antimicrobial Susceptibility Testing (EUCAST)"),
"\n", font_blue("http://eucast.org/"), "\n"))
eucast_notification_shown <- TRUE
}
@ -843,9 +843,9 @@ eucast_rules <- function(x,
cat(paste0("\n", font_grey(strrep("-", options()$width - 1)), "\n"))
cat(font_bold(paste("The rules", paste0(wouldve, "affected"),
formatnr(n_distinct(verbose_info$row)),
"out of", formatnr(nrow(x_original)),
"rows, making a total of", formatnr(nrow(verbose_info)), "edits\n")))
formatnr(n_distinct(verbose_info$row)),
"out of", formatnr(nrow(x_original)),
"rows, making a total of", formatnr(nrow(verbose_info)), "edits\n")))
n_added <- verbose_info %>% filter(is.na(old)) %>% nrow()
n_changed <- verbose_info %>% filter(!is.na(old)) %>% nrow()
@ -858,8 +858,8 @@ eucast_rules <- function(x,
}
cat(colour(paste0("=> ", wouldve, "added ",
font_bold(formatnr(verbose_info %>%
filter(is.na(old)) %>%
nrow()), "test results"),
filter(is.na(old)) %>%
nrow()), "test results"),
"\n")))
if (n_added > 0) {
added_summary <- verbose_info %>%
@ -882,8 +882,8 @@ eucast_rules <- function(x,
}
cat(colour(paste0("=> ", wouldve, "changed ",
font_bold(formatnr(verbose_info %>%
filter(!is.na(old)) %>%
nrow()), "test results"),
filter(!is.na(old)) %>%
nrow()), "test results"),
"\n")))
if (n_changed > 0) {
changed_summary <- verbose_info %>%

View File

@ -387,9 +387,9 @@ labels_rsi_count <- function(position = NULL,
lineheight = 0.75,
data = function(x) {
transformed <- rsi_df(data = x,
translate_ab = translate_ab,
combine_SI = combine_SI,
combine_IR = combine_IR)
translate_ab = translate_ab,
combine_SI = combine_SI,
combine_IR = combine_IR)
transformed$gr <- transformed[, x_name, drop = TRUE]
transformed %>%
group_by(gr) %>%

View File

@ -100,7 +100,7 @@ guess_ab_col <- function(x = NULL, search_string = NULL, verbose = FALSE) {
} else {
if (verbose == TRUE) {
message(font_blue(paste0("NOTE: Using column `", font_bold(ab_result), "` as input for `", search_string,
"` (", ab_name(search_string, language = NULL, tolower = TRUE), ").")))
"` (", ab_name(search_string, language = NULL, tolower = TRUE), ").")))
}
return(ab_result)
}
@ -183,12 +183,12 @@ get_column_abx <- function(x,
for (i in seq_len(length(x))) {
if (verbose == TRUE & !names(x[i]) %in% names(duplicates)) {
message(font_blue(paste0("NOTE: Using column `", font_bold(x[i]), "` as input for `", names(x)[i],
"` (", ab_name(names(x)[i], tolower = TRUE, language = NULL), ").")))
"` (", ab_name(names(x)[i], tolower = TRUE, language = NULL), ").")))
}
if (names(x[i]) %in% names(duplicates)) {
warning(font_red(paste0("Using column `", font_bold(x[i]), "` as input for `", names(x)[i],
"` (", ab_name(names(x)[i], tolower = TRUE, language = NULL),
"), although it was matched for multiple antibiotics or columns.")),
"` (", ab_name(names(x)[i], tolower = TRUE, language = NULL),
"), although it was matched for multiple antibiotics or columns.")),
call. = FALSE,
immediate. = verbose)
}
@ -210,8 +210,8 @@ get_column_abx <- function(x,
# missing a soft dependency may lower the reliability
missing <- soft_dependencies[!soft_dependencies %in% names(x)]
missing_txt <- paste(paste0(ab_name(missing, tolower = TRUE, language = NULL),
" (", font_bold(missing, collapse = NULL), ")"),
collapse = ", ")
" (", font_bold(missing, collapse = NULL), ")"),
collapse = ", ")
message(font_blue("NOTE: Reliability would be improved if these antimicrobial results would be available too:",
missing_txt))
}

View File

@ -195,8 +195,8 @@ key_antibiotics <- function(x,
universal_4, universal_5, universal_6)
gram_positive <- c(universal,
GramPos_1, GramPos_2, GramPos_3,
GramPos_4, GramPos_5, GramPos_6)
GramPos_1, GramPos_2, GramPos_3,
GramPos_4, GramPos_5, GramPos_6)
gram_positive <- gram_positive[!is.null(gram_positive)]
gram_positive <- gram_positive[!is.na(gram_positive)]
if (length(gram_positive) < 12) {
@ -204,8 +204,8 @@ key_antibiotics <- function(x,
}
gram_negative <- c(universal,
GramNeg_1, GramNeg_2, GramNeg_3,
GramNeg_4, GramNeg_5, GramNeg_6)
GramNeg_1, GramNeg_2, GramNeg_3,
GramNeg_4, GramNeg_5, GramNeg_6)
gram_negative <- gram_negative[!is.null(gram_negative)]
gram_negative <- gram_negative[!is.na(gram_negative)]
if (length(gram_negative) < 12) {

View File

@ -145,7 +145,7 @@ mdro <- function(x,
}
if (is.null(col_mo) & guideline$code == "tb") {
message(font_blue("NOTE: No column found as input for `col_mo`,",
font_bold("assuming all records contain", font_italic("Mycobacterium tuberculosis."))))
font_bold("assuming all records contain", font_italic("Mycobacterium tuberculosis."))))
x$mo <- as.mo("Mycobacterium tuberculosis")
col_mo <- "mo"
}
@ -470,7 +470,7 @@ mdro <- function(x,
}
x_transposed <- as.list(as.data.frame(t(x[, cols, drop = FALSE])))
row_filter <- sapply(x_transposed, function(y) search_function(y %in% search_result, na.rm = TRUE))
row_filter <- x[row_filter, "row_number", drop = TRUE]
row_filter <- x[which(row_filter), "row_number", drop = TRUE]
rows <- rows[rows %in% row_filter]
x[rows, "MDRO"] <<- to
x[rows, "reason"] <<- paste0(any_all, " of the required antibiotics ", ifelse(any_all == "any", "is", "are"), " R")
@ -492,23 +492,23 @@ mdro <- function(x,
if (verbose == TRUE) {
x[rows, "columns_nonsusceptible"] <<- sapply(rows,
function(row, group_vct = lst_vector) {
cols_nonsus <- sapply(x[row, group_vct, drop = FALSE], function(y) y %in% search_result)
paste(sort(names(cols_nonsus)[cols_nonsus]), collapse = ", ")
})
function(row, group_vct = lst_vector) {
cols_nonsus <- sapply(x[row, group_vct, drop = FALSE], function(y) y %in% search_result)
paste(sort(names(cols_nonsus)[cols_nonsus]), collapse = ", ")
})
}
x[rows, "classes_affected"] <<- sapply(rows,
function(row, group_tbl = lst) {
sum(sapply(group_tbl,
function(group) {
any(unlist(x[row, group[!is.na(group)], drop = TRUE]) %in% search_result, na.rm = TRUE)
}),
na.rm = TRUE)
})
function(row, group_tbl = lst) {
sum(sapply(group_tbl,
function(group) {
any(unlist(x[row, group[!is.na(group)], drop = TRUE]) %in% search_result, na.rm = TRUE)
}),
na.rm = TRUE)
})
# for PDR; all agents are R (or I if combine_SI = FALSE)
x_transposed <- as.list(as.data.frame(t(x[rows, lst_vector, drop = FALSE])))
row_filter <- sapply(x_transposed, function(y) all(y %in% search_result, na.rm = TRUE))
x[row_filter, "classes_affected"] <<- 999
x[which(row_filter), "classes_affected"] <<- 999
}
if (info == TRUE) {
@ -718,7 +718,7 @@ mdro <- function(x,
x[which((x$classes_in_guideline - x$classes_affected) <= 2), "MDRO"] <- 3
if (verbose == TRUE) {
x[which(x$MDRO == 3), "reason"] <- paste0("less than 3 classes remain susceptible (", x$classes_in_guideline[which((x$classes_in_guideline - x$classes_affected) <= 2)] - x$classes_affected[which(x$MDRO == 3)],
" out of ", x$classes_in_guideline[which(x$MDRO == 3)], " classes)")
" out of ", x$classes_in_guideline[which(x$MDRO == 3)], " classes)")
}
# PDR (=4): all agents are R
@ -1002,7 +1002,7 @@ mdro <- function(x,
# some more info on negative results
if (verbose == TRUE) {
if (guideline$code == "cmi2012") {
x[which(x$MDRO == 1 & !is.na(x$classes_affected)), "reason"] <- paste0(x$classes_affected[which(x$MDRO == 1 & !is.na(x$classes_affected))], " of ", x$classes_available[which(x$MDRO == 1 & !is.na(x$classes_affected))], " available classes contain R or I (3 required for MDR)")
x[which(x$MDRO == 1 & !is.na(x$classes_affected)), "reason"] <- paste0(x$classes_affected[which(x$MDRO == 1 & !is.na(x$classes_affected))], " of ", x$classes_available[which(x$MDRO == 1 & !is.na(x$classes_affected))], " available classes contain R or I (3 required for MDR)")
} else {
x[which(x$MDRO == 1), "reason"] <- "too few antibiotics are R"
}

View File

@ -304,13 +304,13 @@ mo_taxonomy <- function(x, language = get_locale(), ...) {
metadata <- get_mo_failures_uncertainties_renamed()
result <- base::list(kingdom = mo_kingdom(x, language = language),
phylum = mo_phylum(x, language = language),
class = mo_class(x, language = language),
order = mo_order(x, language = language),
family = mo_family(x, language = language),
genus = mo_genus(x, language = language),
species = mo_species(x, language = language),
subspecies = mo_subspecies(x, language = language))
phylum = mo_phylum(x, language = language),
class = mo_class(x, language = language),
order = mo_order(x, language = language),
family = mo_family(x, language = language),
genus = mo_genus(x, language = language),
species = mo_species(x, language = language),
subspecies = mo_subspecies(x, language = language))
load_mo_failures_uncertainties_renamed(metadata)
result

View File

@ -127,7 +127,7 @@ resistance_predict <- function(x,
stop_if(any(dim(x) == 0), "`x` must contain rows and columns")
stop_if(is.null(model), 'choose a regression model with the `model` parameter, e.g. resistance_predict(..., model = "binomial")')
stop_ifnot(col_ab %in% colnames(x),
"column `", col_ab, "` not found")
"column `", col_ab, "` not found")
dots <- unlist(list(...))
if (length(dots) != 0) {

22
R/rsi.R
View File

@ -232,8 +232,8 @@ as.rsi.mic <- function(x, mo, ab = deparse(substitute(x)), guideline = "EUCAST",
}
message(font_blue(paste0("=> Interpreting MIC values of `", font_bold(ab), "` (",
ifelse(ab_coerced != ab, paste0(ab_coerced, ", "), ""),
ab_name(ab_coerced, tolower = TRUE), ") using guideline ", font_bold(guideline_coerced), " ... ")),
ifelse(ab_coerced != ab, paste0(ab_coerced, ", "), ""),
ab_name(ab_coerced, tolower = TRUE), ") using guideline ", font_bold(guideline_coerced), " ... ")),
appendLF = FALSE)
result <- exec_as.rsi(method = "mic",
x = x,
@ -268,8 +268,8 @@ as.rsi.disk <- function(x, mo, ab = deparse(substitute(x)), guideline = "EUCAST"
}
message(font_blue(paste0("=> Interpreting disk zones of `", font_bold(ab), "` (",
ifelse(ab_coerced != ab, paste0(ab_coerced, ", "), ""),
ab_name(ab_coerced, tolower = TRUE), ") using guideline ", font_bold(guideline_coerced), " ... ")),
ifelse(ab_coerced != ab, paste0(ab_coerced, ", "), ""),
ab_name(ab_coerced, tolower = TRUE), ") using guideline ", font_bold(guideline_coerced), " ... ")),
appendLF = FALSE)
result <- exec_as.rsi(method = "disk",
x = x,
@ -319,9 +319,9 @@ as.rsi.data.frame <- function(x, col_mo = NULL, guideline = "EUCAST", uti = NULL
plural <- c("", "s", "a ")
}
message(font_blue(paste0("NOTE: Assuming value", plural[1], " ",
paste(paste0('"', values, '"'), collapse = ", "),
" in column `", font_bold(col_specimen),
"` reflect", plural[2], " ", plural[3], "urinary tract infection", plural[1], ".\n Use `as.rsi(uti = FALSE)` to prevent this.")))
paste(paste0('"', values, '"'), collapse = ", "),
" in column `", font_bold(col_specimen),
"` reflect", plural[2], " ", plural[3], "urinary tract infection", plural[1], ".\n Use `as.rsi(uti = FALSE)` to prevent this.")))
} else {
# no data about UTI's found
uti <- FALSE
@ -339,13 +339,13 @@ as.rsi.data.frame <- function(x, col_mo = NULL, guideline = "EUCAST", uti = NULL
return(FALSE)
} else if (!check & all_valid_mics(y)) {
message(font_blue(paste0("NOTE: Assuming column `", ab, "` (",
ifelse(ab_coerced != ab, paste0(ab_coerced, ", "), ""),
ab_name(ab_coerced, tolower = TRUE), ") contains MIC values.")))
ifelse(ab_coerced != ab, paste0(ab_coerced, ", "), ""),
ab_name(ab_coerced, tolower = TRUE), ") contains MIC values.")))
return(TRUE)
} else if (!check & all_valid_disks(y)) {
message(font_blue(paste0("NOTE: Assuming column `", ab, "` (",
ifelse(ab_coerced != ab, paste0(ab_coerced, ", "), ""),
ab_name(ab_coerced, tolower = TRUE), ") contains disk zones.")))
ifelse(ab_coerced != ab, paste0(ab_coerced, ", "), ""),
ab_name(ab_coerced, tolower = TRUE), ") contains disk zones.")))
return(TRUE)
} else {
return(check)

View File

@ -21,6 +21,7 @@
codecov:
require_ci_to_pass: no # allow fail
branch: master
comment: no

View File

@ -81,7 +81,7 @@
</button>
<span class="navbar-brand">
<a class="navbar-link" href="https://msberends.github.io/AMR/index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.2.0.9033</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.2.0.9034</span>
</span>
</div>

View File

@ -81,7 +81,7 @@
</button>
<span class="navbar-brand">
<a class="navbar-link" href="index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.2.0.9033</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.2.0.9034</span>
</span>
</div>

View File

@ -81,7 +81,7 @@
</button>
<span class="navbar-brand">
<a class="navbar-link" href="../index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.2.0.9033</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.2.0.9034</span>
</span>
</div>

View File

@ -81,7 +81,7 @@
</button>
<span class="navbar-brand">
<a class="navbar-link" href="index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.2.0.9033</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.2.0.9034</span>
</span>
</div>

View File

@ -43,7 +43,7 @@
</button>
<span class="navbar-brand">
<a class="navbar-link" href="index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.2.0.9033</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.2.0.9034</span>
</span>
</div>

View File

@ -81,7 +81,7 @@
</button>
<span class="navbar-brand">
<a class="navbar-link" href="../index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.2.0.9033</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.2.0.9034</span>
</span>
</div>
@ -229,13 +229,13 @@
<small>Source: <a href='https://github.com/msberends/AMR/blob/master/NEWS.md'><code>NEWS.md</code></a></small>
</div>
<div id="amr-1209033" class="section level1">
<h1 class="page-header" data-toc-text="1.2.0.9033">
<a href="#amr-1209033" class="anchor"></a>AMR 1.2.0.9033<small> Unreleased </small>
<div id="amr-1209034" class="section level1">
<h1 class="page-header" data-toc-text="1.2.0.9034">
<a href="#amr-1209034" class="anchor"></a>AMR 1.2.0.9034<small> Unreleased </small>
</h1>
<div id="last-updated-12-jul-2020" class="section level2">
<div id="last-updated-13-jul-2020" class="section level2">
<h2 class="hasAnchor">
<a href="#last-updated-12-jul-2020" class="anchor"></a><small>Last updated: 12-Jul-2020</small>
<a href="#last-updated-13-jul-2020" class="anchor"></a><small>Last updated: 13-Jul-2020</small>
</h2>
<div id="new" class="section level3">
<h3 class="hasAnchor">

View File

@ -10,7 +10,7 @@ articles:
WHONET: WHONET.html
benchmarks: benchmarks.html
resistance_predict: resistance_predict.html
last_built: 2020-07-12T09:42Z
last_built: 2020-07-13T07:17Z
urls:
reference: https://msberends.github.io/AMR/reference
article: https://msberends.github.io/AMR/articles

View File

@ -81,7 +81,7 @@
</button>
<span class="navbar-brand">
<a class="navbar-link" href="../index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.2.0.9033</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.2.0.9034</span>
</span>
</div>