Merge branch 'DEV' into improving-dplyr-joins

.github/workflows/R-CMD-check.yaml

@@ -2,9 +2,9 @@
 # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
 on:
   push:
-    branches: [main, master, website]
+    branches: [main, DEV]
   pull_request:
-    branches: [main, master, website]
+    branches: [main, DEV]
 
 name: R-CMD-check
 

.github/workflows/test-coverage.yaml

@@ -2,9 +2,9 @@
 # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
 on:
   push:
-    branches: [main, master, website]
+    branches: [main, DEV]
   pull_request:
-    branches: [main, master, website]
+    branches: [main, DEV]
 
 name: test-coverage
 

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: joyn
 Type: Package
 Title: Tool for Diagnosis of Tables Joins and Complementary Join Features
-Version: 0.1.6
+Version: 0.1.6.9002
 Authors@R: c(person(given = "R.Andres", 
                     family = "Castaneda", 
                     email = "[email protected]",

NEWS.md

@@ -1,3 +1,5 @@
+# joyn (development version)
+
 # joyn 0.1.6
 
 # joyn 0.1.5

R/info_display.R

@@ -1,7 +1,9 @@
 #' display type of joyn message
 #'
-#' @param type character: one or more of the following:
-#' `r cli::format_inline("{.or {.val {type_choices()}}}")` or `all`
+#' @param type character: one or more of the following: `r joyn:::type_choices()`
+#'   cli::format_inline("{.or {.val {type_choices()}}}")` or `all`
+#' @param msg character vector to be parsed to [cli::cli_abort()]. Default is
+#'   NULL. It only works if `"err" %in% type`
 #'
 #' @return returns data frame with message invisibly. print message in console
 #' @export
@@ -19,7 +21,8 @@
 #'
 #' joyn_msg("all")
 
-joyn_msg <- function(type = c("all", type_choices())) {
+joyn_msg <- function(type = c("all", type_choices()),
+                     msg  = NULL) {
 
   # Check ---------
   type_to_use <- match.arg(type, several.ok = TRUE)
@@ -39,6 +42,9 @@ joyn_msg <- function(type = c("all", type_choices())) {
     cli::cli_text(.)
   })
 
+  if ("err" %in% type_to_use & is.character(msg)) {
+    cli::cli_abort(msg)
+  }
 
   #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   # Return   ---------

R/joyn-merge.R

@@ -214,6 +214,7 @@ joyn <- function(x,
     x <- copy(x)
     y <- copy(y)
 
+
   ## X and Y -----------
   check_xy(x,y)
 
@@ -233,7 +234,6 @@ joyn <- function(x,
     y <- as.data.table(y)
   }
 
-
   ## Modify BY when is expression ---------
   fixby  <- check_by_vars(by, x, y)
   by     <- fixby$by
@@ -387,19 +387,6 @@ joyn <- function(x,
   #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   #                   Update x   ---------
   #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-  # if (isTRUE(update_values) || isTRUE(update_NAs)) {
-  #   var_use <- sub(
-  #     pattern = "\\.y$",
-  #     replacement = "",
-  #     x = newyvars[
-  #       grepl(
-  #         pattern = "\\.y$",
-  #         x       = newyvars
-  #       )
-  #     ]
-  #   )
-  # }
   var_use <- NULL
   if (isTRUE(update_values) || isTRUE(update_NAs)) {
     var_use <- common_vars
@@ -461,6 +448,11 @@ joyn <- function(x,
                          .yreport = NULL)
 
 
+  if (sort) {
+    setorderv(x, by, na.last = na.last)
+    setattr(x, 'sorted', by)
+  }
+
   ## Rename by variables -----
 
   if (!is.null(fixby$xby)) {
@@ -518,10 +510,6 @@ joyn <- function(x,
     x |> fselect(get(reportvar)) <- NULL
   }
 
-  if (sort) {
-    setorderv(x, by, na.last = na.last)
-    setattr(x, 'sorted', by)
-  }
 
   if (verbose == TRUE) {
     end_joyn <- Sys.time()

R/joyn_workhorse.R

@@ -69,33 +69,92 @@ joyn_workhorse <- function(
   # Do a full join -------------------------------------------------------------
 
   # if not 1:1 => use merge.data.table
-  if (match_type == "m:m") {
-
-    dt_result <- data.table::merge.data.table(
-      x               = x,
-      y               = y,
-      by              = by,
-      all             = TRUE,
-      sort            = FALSE,
-      suffixes        = suffixes,
-      allow.cartesian = TRUE
-    )
 
-  } else {
-
-    # not m:m => use collapse::join()
-    dt_result <- collapse::join( x              = x,
-                                 y              = y,
-                                 how            = "full",
-                                 on             = by,
-                                 multiple       = TRUE,     # matches row in x with m in y
-                                 validate       = "m:m",    # no checks performed
-                                 suffix         = suffixes,   # data.table suffixes
-                                 keep.col.order = TRUE,
-                                 verbose        = 0,
-                                 column         = NULL
-    )
-  }
+  # not m:m => use collapse::join()
+    dt_result <- tryCatch(
+      expr = {
+        source_pkg <- if (match_type == "m:m") "data.table::merge" else "collapse::join"
+        if (match_type == "m:m") {
+          data.table::merge.data.table(
+            x               = x,
+            y               = y,
+            by              = by,
+            all             = TRUE,
+            sort            = FALSE,
+            suffixes        = suffixes,
+            allow.cartesian = TRUE
+          )
+
+        } else {
+          collapse::join( x              = x,
+                          y              = y,
+                          how            = "full",
+                          on             = by,
+                          multiple       = TRUE,     # matches row in x with m in y
+                          validate       = "m:m",    # no checks performed
+                          suffix         = suffixes,   # data.table suffixes
+                          keep.col.order = TRUE,
+                          verbose        = 0,
+                          column         = NULL)
+      }
+      }, # end of expr section
+
+      error = function(e) {
+
+
+        joyn_msg("err", c("{.pkg {source_pkg}} returned the following:",
+                          x = e$message))
+      }, # end of error section
+
+      warning = function(w) {
+        if (grepl("[Oo]veridentified", w$message)) {
+          store_msg(
+            type  = "warn",
+            ok    = paste(cli::symbol$warning, "\nWarning: "),
+            pale  = "Your data is overidentified. Below the original message from {.pkg {source_pkg}}:",
+            bolded_pale  = "\n{w$message}"
+          )
+        } else {
+          store_msg(
+            type  = "warn",
+            ok    = paste(cli::symbol$warning, "\nWarning: "),
+            pale  = "{.pkg {source_pkg}} returned the following warning:",
+            bolded_pale  = "\n{w$message}"
+          )
+        }
+
+        # This is inefficient but it is the only way to return the table when
+        # there is a warning
+
+        if (match_type == "m:m") {
+          data.table::merge.data.table(
+            x               = x,
+            y               = y,
+            by              = by,
+            all             = TRUE,
+            sort            = FALSE,
+            suffixes        = suffixes,
+            allow.cartesian = TRUE
+          ) |>
+            suppressWarnings()
+
+        } else {
+          collapse::join( x              = x,
+                          y              = y,
+                          how            = "full",
+                          on             = by,
+                          multiple       = TRUE,     # matches row in x with m in y
+                          validate       = "m:m",    # no checks performed
+                          suffix         = suffixes,   # data.table suffixes
+                          keep.col.order = TRUE,
+                          verbose        = 0,
+                          column         = NULL)  |>
+            suppressWarnings()
+        }
+
+      }
+
+    ) # End of trycatch
 
   # Calculate the time taken
   end_time <- Sys.time()

_pkgdown.yml

@@ -27,11 +27,16 @@ navbar:
     - reference
     - articles
     - news
-    right: github
+    right:
+    - Dev version
+    - github
   components:
     reference:
       text: Reference
       href: reference/index.html
+    dev version:
+      text: dev version
+      href: dev/
     github:
       icon: fab fa-github fa-lg
       href: https://github.com/randrescastaneda/joyn/