P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2024-12-25 18:46:11 +01:00
Code Releases Activity

fix for binding rows

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends 2023-02-12 11:20:14 +01:00
parent c51fb24363
commit c740967cf2
15 changed files with 40 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
DESCRIPTION
View File

@ -1,6 +1,6 @@
Package: AMR Package: AMR
Version: 1.8.2.9118 Version: 1.8.2.9119
Date: 2023-02-11 Date: 2023-02-12
Title: Antimicrobial Resistance Data Analysis Title: Antimicrobial Resistance Data Analysis
Description: Functions to simplify and standardise antimicrobial resistance (AMR) Description: Functions to simplify and standardise antimicrobial resistance (AMR)
data analysis and to work with microbial and antimicrobial properties by data analysis and to work with microbial and antimicrobial properties by

2
NEWS.md
View File

@ -1,4 +1,4 @@
# AMR 1.8.2.9118 # AMR 1.8.2.9119
*(this beta version will eventually become v2.0! We're happy to reach a new major milestone soon!)* *(this beta version will eventually become v2.0! We're happy to reach a new major milestone soon!)*

27
R/aa_helper_functions.R
View File

@ -163,26 +163,23 @@ quick_case_when <- function(...) {
out out
} }
# copied and slightly rewritten from {poorman} under permissive license (2023-02-11) rbind2 <- function (...) {
# https://github.com/nathaneastwood/poorman, MIT licensed, Nathan Eastwood, 2020 # this is just rbind(), but then with the functionality of dplyr::bind_rows(),
pm_bind_rows <- function (..., stringsAsFactors = FALSE) { # to allow differences in available columns
lsts <- Filter(Negate(is.null), list(...)) l <- list(...)
nms <- unique(unlist(lapply(lsts, names))) l_names <- unique(unlist(lapply(l, names)))
lsts <- lapply(lsts, function(x) { l_new <- lapply(l, function(df) {
if (!is.data.frame(x)) { rownames(df) <- NULL
x <- data.frame(as.list(x), stringsAsFactors = stringsAsFactors) for (col in l_names[!l_names %in% colnames(df)]) {
}
for (i in nms[!nms %in% names(x)]) {
# create the new column, could also be length 0 # create the new column, could also be length 0
x[[i]] <- rep(NA, NROW(x)) df[, col] <- rep(NA, NROW(df))
} }
x df
}) })
names(lsts) <- NULL fun <- function(...) rbind(..., stringsAsFactors = FALSE)
do.call(rbind, lsts) do.call(fun, l_new)
} }
# No export, no Rd # No export, no Rd
addin_insert_in <- function() { addin_insert_in <- function() {
import_fn("insertText", "rstudioapi")(" %in% ") import_fn("insertText", "rstudioapi")(" %in% ")

6
R/ab.R
View File

@ -495,15 +495,13 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
# save to package env to save time for next time # save to package env to save time for next time
if (isTRUE(initial_search)) { if (isTRUE(initial_search)) {
AMR_env$ab_previously_coerced <- AMR_env$ab_previously_coerced[which(!AMR_env$ab_previously_coerced$x %in% x), , drop = FALSE] AMR_env$ab_previously_coerced <- AMR_env$ab_previously_coerced[which(!AMR_env$ab_previously_coerced$x %in% x), , drop = FALSE]
AMR_env$ab_previously_coerced <- unique(pm_bind_rows(AMR_env$ab_previously_coerced, AMR_env$ab_previously_coerced <- unique(rbind2(AMR_env$ab_previously_coerced,
data.frame( data.frame(
x = x, x = x,
ab = x_new, ab = x_new,
x_bak = x_bak[match(x, x_bak_clean)], x_bak = x_bak[match(x, x_bak_clean)],
stringsAsFactors = FALSE stringsAsFactors = FALSE
), )))
stringsAsFactors = FALSE
))
} }
# take failed ATC codes apart from rest # take failed ATC codes apart from rest

4
R/antibiogram.R
View File

@ -404,8 +404,8 @@ antibiogram <- function(x,
if (i == 1) { if (i == 1) {
new_df <- long_to_wide(out[which(out$syndromic_group == grp), , drop = FALSE], digs = digits) new_df <- long_to_wide(out[which(out$syndromic_group == grp), , drop = FALSE], digs = digits)
} else { } else {
new_df <- pm_bind_rows(new_df, new_df <- rbind2(new_df,
long_to_wide(out[which(out$syndromic_group == grp), , drop = FALSE], digs = digits)) long_to_wide(out[which(out$syndromic_group == grp), , drop = FALSE], digs = digits))
} }
} }
# sort rows # sort rows

6
R/av.R
View File

@ -461,15 +461,13 @@ as.av <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
# save to package env to save time for next time # save to package env to save time for next time
if (isTRUE(initial_search)) { if (isTRUE(initial_search)) {
AMR_env$av_previously_coerced <- AMR_env$av_previously_coerced[which(!AMR_env$av_previously_coerced$x %in% x), , drop = FALSE] AMR_env$av_previously_coerced <- AMR_env$av_previously_coerced[which(!AMR_env$av_previously_coerced$x %in% x), , drop = FALSE]
AMR_env$av_previously_coerced <- unique(pm_bind_rows(AMR_env$av_previously_coerced, AMR_env$av_previously_coerced <- unique(rbind2(AMR_env$av_previously_coerced,
data.frame( data.frame(
x = x, x = x,
av = x_new, av = x_new,
x_bak = x_bak[match(x, x_bak_clean)], x_bak = x_bak[match(x, x_bak_clean)],
stringsAsFactors = FALSE stringsAsFactors = FALSE
), )))
stringsAsFactors = FALSE
))
} }
# take failed ATC codes apart from rest # take failed ATC codes apart from rest

6
R/bug_drug_combinations.R
View File

@ -124,7 +124,7 @@ bug_drug_combinations <- function(x,
m <- as.matrix(table(x)) m <- as.matrix(table(x))
data.frame(S = m["S", ], I = m["I", ], R = m["R", ], stringsAsFactors = FALSE) data.frame(S = m["S", ], I = m["I", ], R = m["R", ], stringsAsFactors = FALSE)
}) })
merged <- do.call(pm_bind_rows, pivot) merged <- do.call(rbind2, pivot)
out_group <- data.frame( out_group <- data.frame(
mo = rep(unique_mo[i], NROW(merged)), mo = rep(unique_mo[i], NROW(merged)),
ab = rownames(merged), ab = rownames(merged),
@ -144,14 +144,14 @@ bug_drug_combinations <- function(x,
} }
out_group <- cbind(group_values, out_group) out_group <- cbind(group_values, out_group)
} }
out <- pm_bind_rows(out, out_group) out <- rbind2(out, out_group)
} }
out out
} }
# based on pm_apply_grouped_function # based on pm_apply_grouped_function
apply_group <- function(.data, fn, groups, drop = FALSE, ...) { apply_group <- function(.data, fn, groups, drop = FALSE, ...) {
grouped <- pm_split_into_groups(.data, groups, drop) grouped <- pm_split_into_groups(.data, groups, drop)
res <- do.call(pm_bind_rows, unname(lapply(grouped, fn, ...))) res <- do.call(rbind2, unname(lapply(grouped, fn, ...)))
if (any(groups %in% colnames(res))) { if (any(groups %in% colnames(res))) {
class(res) <- c("grouped_data", class(res)) class(res) <- c("grouped_data", class(res))
res <- pm_set_groups(res, groups[groups %in% colnames(res)]) res <- pm_set_groups(res, groups[groups %in% colnames(res)])

2
R/custom_antimicrobials.R
View File

@ -153,7 +153,7 @@ add_custom_antimicrobials <- function(x) {
# assign new values # assign new values
new_df[, col] <- x[, col, drop = TRUE] new_df[, col] <- x[, col, drop = TRUE]
} }
AMR_env$AB_lookup <- unique(pm_bind_rows(AMR_env$AB_lookup, new_df)) AMR_env$AB_lookup <- unique(rbind2(AMR_env$AB_lookup, new_df))
AMR_env$ab_previously_coerced <- AMR_env$ab_previously_coerced[which(!AMR_env$ab_previously_coerced$ab %in% x$ab), , drop = FALSE] AMR_env$ab_previously_coerced <- AMR_env$ab_previously_coerced[which(!AMR_env$ab_previously_coerced$ab %in% x$ab), , drop = FALSE]
class(AMR_env$AB_lookup$ab) <- c("ab", "character") class(AMR_env$AB_lookup$ab) <- c("ab", "character")

2
R/custom_microorganisms.R
View File

@ -279,7 +279,7 @@ add_custom_microorganisms <- function(x) {
# clear previous coercions # clear previous coercions
suppressMessages(mo_reset_session()) suppressMessages(mo_reset_session())
AMR_env$MO_lookup <- unique(pm_bind_rows(AMR_env$MO_lookup, new_df)) AMR_env$MO_lookup <- unique(rbind2(AMR_env$MO_lookup, new_df))
class(AMR_env$MO_lookup$mo) <- c("mo", "character") class(AMR_env$MO_lookup$mo) <- c("mo", "character")
if (nrow(x) <= 3) { if (nrow(x) <= 3) {
message_("Added ", vector_and(italicise(x$fullname), quotes = FALSE), " to the internal `microorganisms` data set.") message_("Added ", vector_and(italicise(x$fullname), quotes = FALSE), " to the internal `microorganisms` data set.")

6
R/eucast_rules.R
View File

@ -475,7 +475,7 @@ eucast_rules <- function(x,
amox$base_ab <- "AMX" amox$base_ab <- "AMX"
amox$base_name <- ab_name("AMX", language = NULL) amox$base_name <- ab_name("AMX", language = NULL)
# merge and sort # merge and sort
ab_enzyme <- pm_bind_rows(ab_enzyme, ampi, amox) ab_enzyme <- rbind2(ab_enzyme, ampi, amox)
ab_enzyme <- ab_enzyme[order(ab_enzyme$enzyme_name), , drop = FALSE] ab_enzyme <- ab_enzyme[order(ab_enzyme$enzyme_name), , drop = FALSE]
for (i in seq_len(nrow(ab_enzyme))) { for (i in seq_len(nrow(ab_enzyme))) {
@ -1161,7 +1161,7 @@ edit_sir <- function(x,
) )
verbose_new <- verbose_new %pm>% pm_filter(old != new | is.na(old) | is.na(new) & !is.na(old)) verbose_new <- verbose_new %pm>% pm_filter(old != new | is.na(old) | is.na(new) & !is.na(old))
# save changes to data set 'verbose_info' # save changes to data set 'verbose_info'
track_changes$verbose_info <- pm_bind_rows(track_changes$verbose_info, track_changes$verbose_info <- rbind2(track_changes$verbose_info,
verbose_new) verbose_new)
# count adds and changes # count adds and changes
track_changes$added <- track_changes$added + verbose_new %pm>% track_changes$added <- track_changes$added + verbose_new %pm>%
@ -1213,7 +1213,7 @@ eucast_dosage <- function(ab, administration = "iv", version_breakpoints = 12.0)
) )
) )
} }
out <- do.call("pm_bind_rows", lapply(lst, as.data.frame, stringsAsFactors = FALSE)) out <- do.call(rbind2, lapply(lst, as.data.frame, stringsAsFactors = FALSE))
rownames(out) <- NULL rownames(out) <- NULL
out$ab <- ab out$ab <- ab
out$name <- ab_name(ab, language = NULL) out$name <- ab_name(ab, language = NULL)

12
R/mo.R
View File

@ -325,7 +325,7 @@ as.mo <- function(x,
result_mo <- NA_character_ result_mo <- NA_character_
} else { } else {
result_mo <- AMR_env$MO_lookup$mo[match(top_hits[1], AMR_env$MO_lookup$fullname)] result_mo <- AMR_env$MO_lookup$mo[match(top_hits[1], AMR_env$MO_lookup$fullname)]
AMR_env$mo_uncertainties <- pm_bind_rows(AMR_env$mo_uncertainties, AMR_env$mo_uncertainties <- rbind2(AMR_env$mo_uncertainties,
data.frame( data.frame(
original_input = x_search, original_input = x_search,
input = x_search_cleaned, input = x_search_cleaned,
@ -335,18 +335,14 @@ as.mo <- function(x,
minimum_matching_score = ifelse(is.null(minimum_matching_score), "NULL", minimum_matching_score), minimum_matching_score = ifelse(is.null(minimum_matching_score), "NULL", minimum_matching_score),
keep_synonyms = keep_synonyms, keep_synonyms = keep_synonyms,
stringsAsFactors = FALSE stringsAsFactors = FALSE
), ))
stringsAsFactors = FALSE
)
# save to package env to save time for next time # save to package env to save time for next time
AMR_env$mo_previously_coerced <- unique(pm_bind_rows(AMR_env$mo_previously_coerced, AMR_env$mo_previously_coerced <- unique(rbind2(AMR_env$mo_previously_coerced,
data.frame( data.frame(
x = paste(x_search, minimum_matching_score), x = paste(x_search, minimum_matching_score),
mo = result_mo, mo = result_mo,
stringsAsFactors = FALSE stringsAsFactors = FALSE
), )))
stringsAsFactors = FALSE
))
} }
# the actual result: # the actual result:
as.character(result_mo) as.character(result_mo)

12
R/plot.R
View File

@ -585,19 +585,13 @@ plot.sir <- function(x,
data$s <- round((data$n / sum(data$n)) * 100, 1) data$s <- round((data$n / sum(data$n)) * 100, 1)
if (!"S" %in% data$x) { if (!"S" %in% data$x) {
data <- pm_bind_rows(data, data.frame(x = "S", n = 0, s = 0, stringsAsFactors = FALSE), data <- rbind2(data, data.frame(x = "S", n = 0, s = 0, stringsAsFactors = FALSE))
stringsAsFactors = FALSE
)
} }
if (!"I" %in% data$x) { if (!"I" %in% data$x) {
data <- pm_bind_rows(data, data.frame(x = "I", n = 0, s = 0, stringsAsFactors = FALSE), data <- rbind2(data, data.frame(x = "I", n = 0, s = 0, stringsAsFactors = FALSE))
stringsAsFactors = FALSE
)
} }
if (!"R" %in% data$x) { if (!"R" %in% data$x) {
data <- pm_bind_rows(data, data.frame(x = "R", n = 0, s = 0, stringsAsFactors = FALSE), data <- rbind2(data, data.frame(x = "R", n = 0, s = 0, stringsAsFactors = FALSE))
stringsAsFactors = FALSE
)
} }
data$x <- factor(data$x, levels = c("S", "I", "R"), ordered = TRUE) data$x <- factor(data$x, levels = c("S", "I", "R"), ordered = TRUE)

2
R/sir.R
View File

@ -998,7 +998,7 @@ as_sir_method <- function(method_short,
} }
# write to verbose output # write to verbose output
AMR_env$sir_interpretation_history <- pm_bind_rows( AMR_env$sir_interpretation_history <- rbind2(
AMR_env$sir_interpretation_history, AMR_env$sir_interpretation_history,
# recycling 1 to 2 rows does not seem to work, which is why rep() was added # recycling 1 to 2 rows does not seem to work, which is why rep() was added
data.frame( data.frame(

4
R/sir_calc.R
View File

@ -322,7 +322,7 @@ sir_calc_df <- function(type, # "proportion", "count" or "both"
} }
out_new <- cbind(group_values, out_new) out_new <- cbind(group_values, out_new)
} }
out <- pm_bind_rows(out, out_new) out <- rbind2(out, out_new)
} }
} }
out out
@ -331,7 +331,7 @@ sir_calc_df <- function(type, # "proportion", "count" or "both"
# based on pm_apply_grouped_function # based on pm_apply_grouped_function
apply_group <- function(.data, fn, groups, drop = FALSE, ...) { apply_group <- function(.data, fn, groups, drop = FALSE, ...) {
grouped <- pm_split_into_groups(.data, groups, drop) grouped <- pm_split_into_groups(.data, groups, drop)
res <- do.call(pm_bind_rows, unname(lapply(grouped, fn, ...))) res <- do.call(rbind2, unname(lapply(grouped, fn, ...)))
if (any(groups %in% colnames(res))) { if (any(groups %in% colnames(res))) {
class(res) <- c("grouped_data", class(res)) class(res) <- c("grouped_data", class(res))
res <- pm_set_groups(res, groups[groups %in% colnames(res)]) res <- pm_set_groups(res, groups[groups %in% colnames(res)])

2
index.md
View File

@ -28,7 +28,7 @@ After installing this package, R knows [**~52,000 distinct microbial species**](
Since its first public release in early 2018, this R package has been used in almost all countries in the world. Click the map to enlarge and to see the country names. Since its first public release in early 2018, this R package has been used in almost all countries in the world. Click the map to enlarge and to see the country names.
With the help of contributors from all corners of the world, the `AMR` package is available in <img src="lang_en.svg" style="height: 13px !important; border: 1px solid #cccccc; vertical-align: initial !important;"> English, <img src="lang_cs.svg" style="height: 13px !important; border: 1px solid #cccccc; vertical-align: initial !important;"> Czech, <img src="lang_zh.svg" style="height: 13px !important; border: 1px solid #cccccc; vertical-align: initial !important;"> Chinese, <img src="lang_da.svg" style="height: 13px !important; border: 1px solid #cccccc; vertical-align: initial !important;"> Danish, <img src="lang_nl.svg" style="height: 13px !important; border: 1px solid #cccccc; vertical-align: initial !important;"> Dutch, <img src="lang_fi.svg" style="height: 13px !important; border: 1px solid #cccccc; vertical-align: initial !important;"> Finnish, <img src="lang_fr.svg" style="height: 13px !important; border: 1px solid #cccccc; vertical-align: initial !important;"> French, <img src="lang_de.svg" style="height: 13px !important; border: 1px solid #cccccc; vertical-align: initial !important;"> German, <img src="lang_el.svg" style="height: 13px !important; border: 1px solid #cccccc; vertical-align: initial !important;"> Greek, <img src="lang_it.svg" style="height: 13px !important; border: 1px solid #cccccc; vertical-align: initial !important;"> Italian, <img src="lang_ja.svg" style="height: 13px !important; border: 1px solid #cccccc; vertical-align: initial !important;"> Japanese, <img src="lang_pl.svg" style="height: 13px !important; border: 1px solid #cccccc; vertical-align: initial !important;"> Polish, <img src="lang_pt.svg" style="height: 13px !important; border: 1px solid #cccccc; vertical-align: initial !important;"> Portuguese, <img src="lang_ru.svg" style="height: 13px !important; border: 1px solid #cccccc; vertical-align: initial !important;"> Russian, <img src="lang_es.svg" style="height: 13px !important; border: 1px solid #cccccc; vertical-align: initial !important;"> Spanish, <img src="lang_sv.svg" style="height: 13px !important; border: 1px solid #cccccc; vertical-align: initial !important;"> Swedish, <img src="lang_tr.svg" style="height: 13px !important; border: 1px solid #cccccc; vertical-align: initial !important;"> Turkish, and <img src="lang_uk.svg" style="height: 13px !important; border: 1px solid #cccccc; vertical-align: initial !important;"> Ukrainian. Antimicrobial drug (group) names and colloquial microorganism names are provided in these languages. With the help of contributors from all corners of the world, the `AMR` package is available in <img src="lang_en.svg" style="height: 13px !important; border: 1px solid #cccccc; vertical-align: initial !important;"> English, <img src="lang_cs.svg" style="height: 13px !important; border: 1px solid #cccccc; vertical-align: initial !important;"> Czech, <img src="lang_zh.svg" style="height: 13px !important; border: 1px solid #cccccc; vertical-align: initial !important;"> Chinese, <img src="lang_da.svg" style="height: 13px !important; border: 1px solid #cccccc; vertical-align: initial !important;"> Danish, <img src="lang_nl.svg" style="height: 13px !important; border: 1px solid #cccccc; vertical-align: initial !important;"> Dutch, <img src="lang_fi.svg" style="height: 13px !important; border: 1px solid #cccccc; vertical-align: initial !important;"> Finnish, <img src="lang_fr.svg" style="height: 13px !important; border: 1px solid #cccccc; vertical-align: initial !important;"> French, <img src="lang_de.svg" style="height: 13px !important; border: 1px solid #cccccc; vertical-align: initial !important;"> German, <img src="lang_el.svg" style="height: 13px !important; border: 1px solid #cccccc; vertical-align: initial !important;"> Greek, <img src="lang_it.svg" style="height: 13px !important; border: 1px solid #cccccc; vertical-align: initial !important;"> Italian, <img src="lang_ja.svg" style="height: 13px !important; border: 1px solid #cccccc; vertical-align: initial !important;"> Japanese, <img src="lang_no.svg" style="height: 13px !important; border: 1px solid #cccccc; vertical-align: initial !important;"> Norwegian, <img src="lang_pl.svg" style="height: 13px !important; border: 1px solid #cccccc; vertical-align: initial !important;"> Polish, <img src="lang_pt.svg" style="height: 13px !important; border: 1px solid #cccccc; vertical-align: initial !important;"> Portuguese, <img src="lang_ro.svg" style="height: 13px !important; border: 1px solid #cccccc; vertical-align: initial !important;"> Romanian, <img src="lang_ru.svg" style="height: 13px !important; border: 1px solid #cccccc; vertical-align: initial !important;"> Russian, <img src="lang_es.svg" style="height: 13px !important; border: 1px solid #cccccc; vertical-align: initial !important;"> Spanish, <img src="lang_sv.svg" style="height: 13px !important; border: 1px solid #cccccc; vertical-align: initial !important;"> Swedish, <img src="lang_tr.svg" style="height: 13px !important; border: 1px solid #cccccc; vertical-align: initial !important;"> Turkish, and <img src="lang_uk.svg" style="height: 13px !important; border: 1px solid #cccccc; vertical-align: initial !important;"> Ukrainian. Antimicrobial drug (group) names and colloquial microorganism names are provided in these languages.
### Practical examples ### Practical examples