P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2025-07-09 01:22:25 +02:00
Code Releases Activity

styled, unit test fix

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2022-08-28 10:31:50 +02:00
parent 4cb1db4554
commit 4d050aef7c
147 changed files with 10897 additions and 8169 deletions
Download Patch File Download Diff File Expand all files Collapse all files

54
R/join_microorganisms.R
View File

@ -9,7 +9,7 @@
# (c) 2018-2022 Berends MS, Luz CF et al. #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
# Diagnostics & Advice, and University Medical Center Groningen. #
# #
# This R package is free software; you can freely use and distribute #
# it for both personal and commercial purposes under the terms of the #
@ -33,8 +33,8 @@
#' @param by a variable to join by - if left empty will search for a column with class [`mo`] (created with [as.mo()]) or will be `"mo"` if that column name exists in `x`, could otherwise be a column name of `x` with values that exist in `microorganisms$mo` (such as `by = "bacteria_id"`), or another column in [microorganisms] (but then it should be named, like `by = c("bacteria_id" = "fullname")`)
#' @param suffix if there are non-joined duplicate variables in `x` and `y`, these suffixes will be added to the output to disambiguate them. Should be a [character] vector of length 2.
#' @param ... ignored, only in place to allow future extensions
#' @details **Note:** As opposed to the `join()` functions of `dplyr`, [character] vectors are supported and at default existing columns will get a suffix `"2"` and the newly joined columns will not get a suffix.
#'
#' @details **Note:** As opposed to the `join()` functions of `dplyr`, [character] vectors are supported and at default existing columns will get a suffix `"2"` and the newly joined columns will not get a suffix.
#'
#' If the `dplyr` package is installed, their join functions will be used. Otherwise, the much slower [merge()] and [interaction()] functions from base \R will be used.
#' @return a [data.frame]
#' @export
@ -42,21 +42,27 @@
#' left_join_microorganisms(as.mo("K. pneumoniae"))
#' left_join_microorganisms("B_KLBSL_PNMN")
#'
#' df <- data.frame(date = seq(from = as.Date("2018-01-01"),
#' to = as.Date("2018-01-07"),
#' by = 1),
#' bacteria = as.mo(c("S. aureus", "MRSA", "MSSA", "STAAUR",
#' "E. coli", "E. coli", "E. coli")),
#' stringsAsFactors = FALSE)
#' df <- data.frame(
#' date = seq(
#' from = as.Date("2018-01-01"),
#' to = as.Date("2018-01-07"),
#' by = 1
#' ),
#' bacteria = as.mo(c(
#' "S. aureus", "MRSA", "MSSA", "STAAUR",
#' "E. coli", "E. coli", "E. coli"
#' )),
#' stringsAsFactors = FALSE
#' )
#' colnames(df)
#'
#'
#' df_joined <- left_join_microorganisms(df, "bacteria")
#' colnames(df_joined)
#'
#'
#' \donttest{
#' if (require("dplyr")) {
#' example_isolates %>%
#' left_join_microorganisms() %>%
#' left_join_microorganisms() %>%
#' colnames()
#' }
#' }
@ -64,7 +70,7 @@ inner_join_microorganisms <- function(x, by = NULL, suffix = c("2", ""), ...) {
meet_criteria(x, allow_class = c("data.frame", "character"))
meet_criteria(by, allow_class = "character", allow_NULL = TRUE)
meet_criteria(suffix, allow_class = "character", has_length = 2)
join_microorganisms(type = "inner_join", x = x, by = by, suffix = suffix, ...)
}
@ -74,7 +80,7 @@ left_join_microorganisms <- function(x, by = NULL, suffix = c("2", ""), ...) {
meet_criteria(x, allow_class = c("data.frame", "character"))
meet_criteria(by, allow_class = "character", allow_NULL = TRUE)
meet_criteria(suffix, allow_class = "character", has_length = 2)
join_microorganisms(type = "left_join", x = x, by = by, suffix = suffix, ...)
}
@ -84,7 +90,7 @@ right_join_microorganisms <- function(x, by = NULL, suffix = c("2", ""), ...) {
meet_criteria(x, allow_class = c("data.frame", "character"))
meet_criteria(by, allow_class = "character", allow_NULL = TRUE)
meet_criteria(suffix, allow_class = "character", has_length = 2)
join_microorganisms(type = "right_join", x = x, by = by, suffix = suffix, ...)
}
@ -94,7 +100,7 @@ full_join_microorganisms <- function(x, by = NULL, suffix = c("2", ""), ...) {
meet_criteria(x, allow_class = c("data.frame", "character"))
meet_criteria(by, allow_class = "character", allow_NULL = TRUE)
meet_criteria(suffix, allow_class = "character", has_length = 2)
join_microorganisms(type = "full_join", x = x, by = by, suffix = suffix, ...)
}
@ -103,7 +109,7 @@ full_join_microorganisms <- function(x, by = NULL, suffix = c("2", ""), ...) {
semi_join_microorganisms <- function(x, by = NULL, ...) {
meet_criteria(x, allow_class = c("data.frame", "character"))
meet_criteria(by, allow_class = "character", allow_NULL = TRUE)
join_microorganisms(type = "semi_join", x = x, by = by, ...)
}
@ -112,13 +118,13 @@ semi_join_microorganisms <- function(x, by = NULL, ...) {
anti_join_microorganisms <- function(x, by = NULL, ...) {
meet_criteria(x, allow_class = c("data.frame", "character"))
meet_criteria(by, allow_class = "character", allow_NULL = TRUE)
join_microorganisms(type = "anti_join", x = x, by = by, ...)
}
join_microorganisms <- function(type, x, by, suffix, ...) {
check_dataset_integrity()
if (!is.data.frame(x)) {
if (pkg_is_available("tibble", also_load = FALSE)) {
x <- import_fn("tibble", "tibble")(mo = x)
@ -143,12 +149,12 @@ join_microorganisms <- function(type, x, by, suffix, ...) {
} else {
x[, by] <- as.mo(x[, by, drop = TRUE])
}
if (is.null(names(by))) {
# will always be joined to microorganisms$mo, so add name to that
by <- stats::setNames("mo", by)
}
# use dplyr if available - it's much faster than poorman alternatives
dplyr_join <- import_fn(name = type, pkg = "dplyr", error_on_fail = FALSE)
if (!is.null(dplyr_join)) {
@ -162,7 +168,7 @@ join_microorganisms <- function(type, x, by, suffix, ...) {
} else {
joined <- join_fn(x = x, y = AMR::microorganisms, by = by, ...)
}
if ("join.mo" %in% colnames(joined)) {
if ("mo" %in% colnames(joined)) {
ind_mo <- which(colnames(joined) %in% c("mo", "join.mo"))
@ -172,10 +178,10 @@ join_microorganisms <- function(type, x, by, suffix, ...) {
colnames(joined)[colnames(joined) == "join.mo"] <- "mo"
}
}
if (type %like% "full|left|right|inner" && NROW(joined) > NROW(x)) {
warning_("in `", type, "_join()`: the newly joined data set contains ", nrow(joined) - nrow(x), " rows more than the number of rows of `x`.")
}
as_original_data_class(joined, class(x.bak))
}