P281424
/
AMR
mirror of https://github.com/msberends/AMR.git
1
0
Fork 0
Code Releases Activity

fix for binding rows

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
Version: 1.8.2.9118
Date: 2023-02-11
Version: 1.8.2.9119
Date: 2023-02-12
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

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!)*

27
R/aa_helper_functions.R
View File

@ -163,26 +163,23 @@ quick_case_when <- function(...) {
out
}
# copied and slightly rewritten from {poorman} under permissive license (2023-02-11)
# https://github.com/nathaneastwood/poorman, MIT licensed, Nathan Eastwood, 2020
pm_bind_rows <- function (..., stringsAsFactors = FALSE) {
lsts <- Filter(Negate(is.null), list(...))
nms <- unique(unlist(lapply(lsts, names)))
lsts <- lapply(lsts, function(x) {
if (!is.data.frame(x)) {
x <- data.frame(as.list(x), stringsAsFactors = stringsAsFactors)
}
for (i in nms[!nms %in% names(x)]) {
rbind2 <- function (...) {
# this is just rbind(), but then with the functionality of dplyr::bind_rows(),
# to allow differences in available columns
l <- list(...)
l_names <- unique(unlist(lapply(l, names)))
l_new <- lapply(l, function(df) {
rownames(df) <- NULL
for (col in l_names[!l_names %in% colnames(df)]) {
# 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
do.call(rbind, lsts)
fun <- function(...) rbind(..., stringsAsFactors = FALSE)
do.call(fun, l_new)
}
# No export, no Rd
addin_insert_in <- function() {
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
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 <- unique(pm_bind_rows(AMR_env$ab_previously_coerced,
AMR_env$ab_previously_coerced <- unique(rbind2(AMR_env$ab_previously_coerced,
data.frame(
x = x,
ab = x_new,
x_bak = x_bak[match(x, x_bak_clean)],
stringsAsFactors = FALSE
),
stringsAsFactors = FALSE
))
)))
}
# take failed ATC codes apart from rest

4
R/antibiogram.R
View File

@ -404,8 +404,8 @@ antibiogram <- function(x,
if (i == 1) {
new_df <- long_to_wide(out[which(out$syndromic_group == grp), , drop = FALSE], digs = digits)
} else {
new_df <- pm_bind_rows(new_df,
long_to_wide(out[which(out$syndromic_group == grp), , drop = FALSE], digs = digits))
new_df <- rbind2(new_df,
long_to_wide(out[which(out$syndromic_group == grp), , drop = FALSE], digs = digits))
}
}
# 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
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 <- unique(pm_bind_rows(AMR_env$av_previously_coerced,
AMR_env$av_previously_coerced <- unique(rbind2(AMR_env$av_previously_coerced,
data.frame(
x = x,
av = x_new,
x_bak = x_bak[match(x, x_bak_clean)],
stringsAsFactors = FALSE
),
stringsAsFactors = FALSE
))
)))
}
# 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))
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(
mo = rep(unique_mo[i], NROW(merged)),
ab = rownames(merged),
@ -144,14 +144,14 @@ bug_drug_combinations <- function(x,
}
out_group <- cbind(group_values, out_group)
}
out <- pm_bind_rows(out, out_group)
out <- rbind2(out, out_group)
}
out
}
# based on pm_apply_grouped_function
apply_group <- function(.data, fn, groups, drop = FALSE, ...) {
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))) {
class(res) <- c("grouped_data", class(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
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]
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
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")
if (nrow(x) <= 3) {
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_name <- ab_name("AMX", language = NULL)
# 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]
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))
# 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)
# count adds and changes
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
out$ab <- ab
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_
} else {
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(
original_input = x_search,
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),
keep_synonyms = keep_synonyms,
stringsAsFactors = FALSE
),
stringsAsFactors = FALSE
)
))
# 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(
x = paste(x_search, minimum_matching_score),
mo = result_mo,
stringsAsFactors = FALSE
),
stringsAsFactors = FALSE
))
)))
}
# the actual result:
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)
if (!"S" %in% data$x) {
data <- pm_bind_rows(data, data.frame(x = "S", n = 0, s = 0, stringsAsFactors = FALSE),
stringsAsFactors = FALSE
)
data <- rbind2(data, data.frame(x = "S", n = 0, s = 0, stringsAsFactors = FALSE))
}
if (!"I" %in% data$x) {
data <- pm_bind_rows(data, data.frame(x = "I", n = 0, s = 0, stringsAsFactors = FALSE),
stringsAsFactors = FALSE
)
data <- rbind2(data, data.frame(x = "I", n = 0, s = 0, stringsAsFactors = FALSE))
}
if (!"R" %in% data$x) {
data <- pm_bind_rows(data, data.frame(x = "R", n = 0, s = 0, stringsAsFactors = FALSE),
stringsAsFactors = FALSE
)
data <- rbind2(data, data.frame(x = "R", n = 0, s = 0, stringsAsFactors = FALSE))
}
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
AMR_env$sir_interpretation_history <- pm_bind_rows(
AMR_env$sir_interpretation_history <- rbind2(
AMR_env$sir_interpretation_history,
# recycling 1 to 2 rows does not seem to work, which is why rep() was added
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 <- pm_bind_rows(out, out_new)
out <- rbind2(out, out_new)
}
}
out
@ -331,7 +331,7 @@ sir_calc_df <- function(type, # "proportion", "count" or "both"
# based on pm_apply_grouped_function
apply_group <- function(.data, fn, groups, drop = FALSE, ...) {
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))) {
class(res) <- c("grouped_data", class(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.
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