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 e0dc2a7e8..370998a41 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 e3ed63cfd..46a067b68 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 6f377aa0e..de25b120b 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 7b0069111..49f32f1f1 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 ed12bba0e..12ace335f 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 f8b0c98a2..616f5936c 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 680096bd9..536e9dac7 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 b3765161a..2285ee0b4 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 0a620fdf7..3b8b2d345 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 f8ba1c729..da92f7790 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 7d23a8871..d1f86c1f3 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 ac5f55063..fa8323509 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 5fef9830a..c4e85a1ec 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 5533aee45..8e03c15b5 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 3fbc41c2d..1dffa9ce4 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