P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2025-07-09 04:02:19 +02: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
Download Patch File Download Diff File Expand all files Collapse all files

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)])