mirror of https://github.com/msberends/AMR.git
fix for binding rows
This commit is contained in:
parent
c51fb24363
commit
c740967cf2
|
|
@ -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
2
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!)*
|
||||
|
||||
|
|
|
|||
|
|
@ -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
6
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
|
||||
|
|
|
|||
|
|
@ -404,7 +404,7 @@ 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,
|
||||
new_df <- rbind2(new_df,
|
||||
long_to_wide(out[which(out$syndromic_group == grp), , drop = FALSE], digs = digits))
|
||||
}
|
||||
}
|
||||
|
|
|
|||
6
R/av.R
6
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
|
||||
|
|
|
|||
|
|
@ -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)])
|
||||
|
|
|
|||
|
|
@ -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")
|
||||
|
|
|
|||
|
|
@ -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.")
|
||||
|
|
|
|||
|
|
@ -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
12
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)
|
||||
|
|
|
|||
12
R/plot.R
12
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)
|
||||
|
|
|
|||
2
R/sir.R
2
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(
|
||||
|
|
|
|||
|
|
@ -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
2
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 <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
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue