joins with updated doc and tests

DESCRIPTION

@@ -13,7 +13,7 @@ Description: Provides `dplyr` verbs (`mutate`, `select`, `filter`, etc...)
 biocViews: DataRepresentation, Infrastructure, Software
 License: GPL-3
 Encoding: UTF-8
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.2
 URL: https://github.com/jonocarroll/DFplyr
 BugReports: https://github.com/jonocarroll/DFplyr/issues
 Depends: 

NAMESPACE

@@ -5,12 +5,16 @@ S3method(count,DataFrame)
 S3method(distinct,DataFrame)
 S3method(filter,DataFrame)
 S3method(format,DataFrame)
+S3method(full_join,DataFrame)
 S3method(group_by,DataFrame)
 S3method(group_by_drop_default,DataFrame)
 S3method(group_data,DataFrame)
 S3method(group_vars,DataFrame)
+S3method(inner_join,DataFrame)
+S3method(left_join,DataFrame)
 S3method(mutate,DataFrame)
 S3method(pull,DataFrame)
+S3method(right_join,DataFrame)
 S3method(select,DataFrame)
 S3method(slice,DataFrame)
 S3method(summarise,DataFrame)

R/DF-join.R

@@ -0,0 +1,56 @@
+check_common_columns <- function(names_x, names_y) {
+  by <- intersect(names_x, names_y)
+
+  # from dplyr:::join_by_common
+  if (length(by) == 0)
+    rlang::abort("`by` must be supplied when `x` and `y` have no common variables.")
+
+  message("Joining with `by = ", deparse(by), "`")
+
+  return(by)
+}
+
+join_internal <- function(x, y, by = NULL, ...) {
+  if (is.null(by))
+    by <- check_common_columns(names(x), names(y))
+
+  grps <- get_group_data(x)
+  x <- S4Vectors::merge(x, y, by = by, sort = FALSE, ...)
+  set_group_data(x, grps)
+}
+
+
+
+#' @title Mutating joins
+#'
+#' @param x a `DataFrame`
+#' @param y a `DataFrame` or `data.frame`
+#' @param by columns to use for joining the objects. If `NULL`, the function will look for common columns.
+#'
+#' @return a `DataFrame`
+#' @examples
+#' library(dplyr)
+#' library(S4Vectors)
+#' da <- starwars[, c("name", "mass", "species")][1:10, ]
+#' db <- starwars[, c("name", "homeworld")]
+#'
+#' Da <- as(da, "DataFrame")
+#' Db <- as(db, "DataFrame")
+#'
+#' Res_inner <- inner_join(Da, Db[1:3, ])
+#'
+#' @export
+inner_join.DataFrame <- function(x, y, by = NULL)
+  join_internal(x = x, y = y, by = by, all = FALSE)
+
+#' @export
+left_join.DataFrame <- function(x, y, by = NULL)
+  join_internal(x = x, y = y, by = by, all.x = TRUE)
+
+#' @export
+right_join.DataFrame <- function(x, y, by = NULL)
+  join_internal(x = x, y = y, by = by, all.y = TRUE)
+
+#' @export
+full_join.DataFrame <- function(x, y, by = NULL)
+  join_internal(x = x, y = y, by = by, all = TRUE)

tests/testthat/test-join.R

@@ -0,0 +1,27 @@
+test_that("join works with regular columns", {
+  da <- starwars[, c("name", "mass", "species")][1:10, ]
+  db <- starwars[, c("name", "homeworld")]
+
+  res_left <- left_join(da, db)
+  res_right <- right_join(da, db)
+  res_inner <- inner_join(da, db[1:3, ])
+  res_full <- full_join(da, db[8:12,])
+
+  Da <- as(da, "DataFrame")
+  Db <- as(db, "DataFrame")
+
+  Res_inner <- inner_join(Da, Db[1:3, ])
+  Res_left <- left_join(Da, Db)
+  Res_right <- right_join(Da, Db)
+  Res_full <- full_join(Da, Db[8:12,])
+
+  expect_s4_class(Res_left, "DataFrame")
+  expect_s4_class(Res_right, "DataFrame")
+  expect_s4_class(Res_inner, "DataFrame")
+  expect_s4_class(Res_full, "DataFrame")
+
+  expect_identical(arrange(Res_left, name), arrange(as(res_left, "DataFrame"), name))
+  expect_identical(arrange(Res_right, name), arrange(as(res_right, "DataFrame"), name))
+  expect_identical(arrange(Res_inner, name), arrange(as(res_inner, "DataFrame"), name))
+  expect_identical(arrange(Res_full, name), arrange(as(res_full, "DataFrame"), name))
+})