P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2025-07-08 13:21:50 +02:00
Code Releases Activity

(v1.3.0.9030) matching score update

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2020-09-26 16:26:01 +02:00
parent 9667c2994f
commit 050a9a04fb
33 changed files with 249 additions and 175 deletions
Download Patch File Download Diff File Expand all files Collapse all files

88
R/join_microorganisms.R
View File

@ -27,12 +27,12 @@
#' @name join
#' @aliases join inner_join
#' @param x existing table to join, or character vector
#' @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` (like `by = "bacteria_id"`), or another column in [microorganisms] (but then it should be named, like `by = c("my_genus_species" = "fullname")`)
#' @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` (like `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
#' @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.
#'
#' These functions rely on [merge()], a base R function to do joins.
#' If the `dplyr` package is installed, their join functions will be used. Otherwise, the much slower [merge()] function from base R will be used.
#' @inheritSection AMR Read more on our website!
#' @export
#' @examples
@ -60,9 +60,17 @@ inner_join_microorganisms <- function(x, by = NULL, suffix = c("2", ""), ...) {
x_class <- get_prejoined_class(x)
x <- checked$x
by <- checked$by
join <- suppressWarnings(
pm_inner_join(x = x, y = microorganisms, by = by, suffix = suffix, ...)
)
# use dplyr if available - it's much faster
dplyr_inner <- import_fn("inner_join", "dplyr", error_on_fail = FALSE)
if (!is.null(dplyr_inner)) {
join <- suppressWarnings(
dplyr_inner(x = x, y = microorganisms, by = by, suffix = suffix, ...)
)
} else {
join <- suppressWarnings(
pm_inner_join(x = x, y = microorganisms, by = by, suffix = suffix, ...)
)
}
if (NROW(join) > NROW(x)) {
warning("The newly joined tbl contains ", nrow(join) - nrow(x), " rows more that its original.")
}
@ -79,9 +87,17 @@ left_join_microorganisms <- function(x, by = NULL, suffix = c("2", ""), ...) {
x_class <- get_prejoined_class(x)
x <- checked$x
by <- checked$by
join <- suppressWarnings(
pm_left_join(x = x, y = microorganisms, by = by, suffix = suffix, ...)
)
# use dplyr if available - it's much faster
dplyr_left <- import_fn("left_join", "dplyr", error_on_fail = FALSE)
if (!is.null(dplyr_left)) {
join <- suppressWarnings(
dplyr_left(x = x, y = microorganisms, by = by, suffix = suffix, ...)
)
} else {
join <- suppressWarnings(
pm_left_join(x = x, y = microorganisms, by = by, suffix = suffix, ...)
)
}
if (NROW(join) > NROW(x)) {
warning("The newly joined tbl contains ", nrow(join) - nrow(x), " rows more that its original.")
}
@ -98,9 +114,17 @@ right_join_microorganisms <- function(x, by = NULL, suffix = c("2", ""), ...) {
x_class <- get_prejoined_class(x)
x <- checked$x
by <- checked$by
join <- suppressWarnings(
pm_right_join(x = x, y = microorganisms, by = by, suffix = suffix, ...)
)
# use dplyr if available - it's much faster
dplyr_right <- import_fn("right_join", "dplyr", error_on_fail = FALSE)
if (!is.null(dplyr_right)) {
join <- suppressWarnings(
dplyr_right(x = x, y = microorganisms, by = by, suffix = suffix, ...)
)
} else {
join <- suppressWarnings(
pm_right_join(x = x, y = microorganisms, by = by, suffix = suffix, ...)
)
}
if (NROW(join) > NROW(x)) {
warning("The newly joined tbl contains ", nrow(join) - nrow(x), " rows more that its original.")
}
@ -117,9 +141,17 @@ full_join_microorganisms <- function(x, by = NULL, suffix = c("2", ""), ...) {
x_class <- get_prejoined_class(x)
x <- checked$x
by <- checked$by
join <- suppressWarnings(
pm_full_join(x = x, y = microorganisms, by = by, suffix = suffix, ...)
)
# use dplyr if available - it's much faster
dplyr_full <- import_fn("full_join", "dplyr", error_on_fail = FALSE)
if (!is.null(dplyr_full)) {
join <- suppressWarnings(
dplyr_full(x = x, y = microorganisms, by = by, suffix = suffix, ...)
)
} else {
join <- suppressWarnings(
pm_full_join(x = x, y = microorganisms, by = by, suffix = suffix, ...)
)
}
if (NROW(join) > NROW(x)) {
warning("The newly joined tbl contains ", nrow(join) - nrow(x), " rows more that its original.")
}
@ -136,9 +168,17 @@ semi_join_microorganisms <- function(x, by = NULL, ...) {
checked <- joins_check_df(x, by)
x <- checked$x
by <- checked$by
join <- suppressWarnings(
pm_semi_join(x = x, y = microorganisms, by = by, ...)
)
# use dplyr if available - it's much faster
dplyr_semi <- import_fn("semi_join", "dplyr", error_on_fail = FALSE)
if (!is.null(dplyr_semi)) {
join <- suppressWarnings(
dplyr_semi(x = x, y = microorganisms, by = by,...)
)
} else {
join <- suppressWarnings(
pm_semi_join(x = x, y = microorganisms, by = by,...)
)
}
class(join) <- x_class
join
}
@ -152,9 +192,17 @@ anti_join_microorganisms <- function(x, by = NULL, ...) {
x_class <- get_prejoined_class(x)
x <- checked$x
by <- checked$by
join <- suppressWarnings(
pm_anti_join(x = x, y = microorganisms, by = by, ...)
)
# use dplyr if available - it's much faster
dplyr_anti <- import_fn("anti_join", "dplyr", error_on_fail = FALSE)
if (!is.null(dplyr_anti)) {
join <- suppressWarnings(
dplyr_anti(x = x, y = microorganisms, by = by,...)
)
} else {
join <- suppressWarnings(
pm_anti_join(x = x, y = microorganisms, by = by,...)
)
}
class(join) <- x_class
join
}