From c740967cf2d80d7886bd7fc46b593779cc5384f8 Mon Sep 17 00:00:00 2001 From: "Matthijs S. Berends" Date: Sun, 12 Feb 2023 11:20:14 +0100 Subject: [PATCH] fix for binding rows --- DESCRIPTION | 4 ++-- NEWS.md | 2 +- R/aa_helper_functions.R | 27 ++++++++++++--------------- R/ab.R | 6 ++---- R/antibiogram.R | 4 ++-- R/av.R | 6 ++---- R/bug_drug_combinations.R | 6 +++--- R/custom_antimicrobials.R | 2 +- R/custom_microorganisms.R | 2 +- R/eucast_rules.R | 6 +++--- R/mo.R | 12 ++++-------- R/plot.R | 12 +++--------- R/sir.R | 2 +- R/sir_calc.R | 4 ++-- index.md | 2 +- 15 files changed, 40 insertions(+), 57 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index e0dc2a7e..370998a4 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -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 diff --git a/NEWS.md b/NEWS.md index e3ed63cf..46a067b6 100755 --- a/NEWS.md +++ b/NEWS.md @@ -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!)* diff --git a/R/aa_helper_functions.R b/R/aa_helper_functions.R index 6f377aa0..de25b120 100755 --- a/R/aa_helper_functions.R +++ b/R/aa_helper_functions.R @@ -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% ") diff --git a/R/ab.R b/R/ab.R index 7b006911..49f32f1f 100755 --- a/R/ab.R +++ b/R/ab.R @@ -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 diff --git a/R/antibiogram.R b/R/antibiogram.R index ed12bba0..12ace335 100755 --- a/R/antibiogram.R +++ b/R/antibiogram.R @@ -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 diff --git a/R/av.R b/R/av.R index f8b0c98a..616f5936 100755 --- a/R/av.R +++ b/R/av.R @@ -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 diff --git a/R/bug_drug_combinations.R b/R/bug_drug_combinations.R index 680096bd..536e9dac 100755 --- a/R/bug_drug_combinations.R +++ b/R/bug_drug_combinations.R @@ -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)]) diff --git a/R/custom_antimicrobials.R b/R/custom_antimicrobials.R index b3765161..2285ee0b 100755 --- a/R/custom_antimicrobials.R +++ b/R/custom_antimicrobials.R @@ -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") diff --git a/R/custom_microorganisms.R b/R/custom_microorganisms.R index 0a620fdf..3b8b2d34 100755 --- a/R/custom_microorganisms.R +++ b/R/custom_microorganisms.R @@ -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.") diff --git a/R/eucast_rules.R b/R/eucast_rules.R index f8ba1c72..da92f779 100755 --- a/R/eucast_rules.R +++ b/R/eucast_rules.R @@ -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) diff --git a/R/mo.R b/R/mo.R index 7d23a887..d1f86c1f 100755 --- a/R/mo.R +++ b/R/mo.R @@ -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) diff --git a/R/plot.R b/R/plot.R index ac5f5506..fa832350 100755 --- a/R/plot.R +++ b/R/plot.R @@ -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) diff --git a/R/sir.R b/R/sir.R index 5fef9830..c4e85a1e 100755 --- a/R/sir.R +++ b/R/sir.R @@ -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( diff --git a/R/sir_calc.R b/R/sir_calc.R index 5533aee4..8e03c15b 100755 --- a/R/sir_calc.R +++ b/R/sir_calc.R @@ -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)]) diff --git a/index.md b/index.md index 3fbc41c2..1dffa9ce 100644 --- a/index.md +++ b/index.md @@ -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 English, Czech, Chinese, Danish, Dutch, Finnish, French, German, Greek, Italian, Japanese, Polish, Portuguese, Russian, Spanish, Swedish, Turkish, and 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 English, Czech, Chinese, Danish, Dutch, Finnish, French, German, Greek, Italian, Japanese, Norwegian, Polish, Portuguese, Romanian, Russian, Spanish, Swedish, Turkish, and Ukrainian. Antimicrobial drug (group) names and colloquial microorganism names are provided in these languages. ### Practical examples