Merge branch 'DEV' into rm_copy

# Conflicts:
#	DESCRIPTION

NAMESPACE

@@ -16,6 +16,7 @@ export(possible_ids)
 export(rename_to_valid)
 export(right_join)
 export(set_joyn_options)
+export(unmask_joyn)
 import(collapse, except = fdroplevels)
 import(data.table, except = fdroplevels)
 importFrom(lifecycle,deprecated)

NEWS.md

@@ -1,8 +1,15 @@
 # joyn (development version)
 
+* Add `anti_join()` function.
+
+* Add `unmask_joyn()` function to unmask `joyn` functions that mask `dplyr` equivalents.
+
+
 # joyn 0.2.0
 
-`joyn` has gained two new authors: Zander Prinsloo and Rossana Tatulli. 
+* `joyn` has gained two new authors: Zander Prinsloo and Rossana Tatulli.
+
+* Official [blog](https://blogs.worldbank.org/en/opendata/from-frustration-to-joyn--introducing-joyn-for-r--a-tool-for-sma) release
 
 ## Breaking changes
 

R/checks.R

@@ -222,7 +222,9 @@ check_by_vars <- function(by, x, y) {
 #' # Inconsistent match type
 #' joyn:::check_match_type(x = x1, y=y1, by="id", match_type = "1:1")
 #' }
-check_match_type <- function(x, y, by, match_type, verbose) {
+check_match_type <- function(x, y, by,
+                             match_type,
+                             verbose = getOption("joyn.verbose")) {
 
   #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   # computations   ---------
@@ -233,37 +235,72 @@ check_match_type <- function(x, y, by, match_type, verbose) {
 
   # Check which messages to return
   match_type_error <- FALSE
-  x_m              <- TRUE
-  y_m              <- TRUE
+  x_m    <-  y_m   <- TRUE
+  mte_x  <- mte_y  <- FALSE
 
   if (tx == "1") {
-    match_type_error <-
-      is_match_type_error(x, "x", by, verbose, match_type_error)
+      mte_x <- is_match_type_error(x, "x", by, verbose, match_type_error)
   } else {
     x_m <- is_valid_m_key(x, by)
   }
 
   if (ty == "1") {
-    match_type_error <-
-      is_match_type_error(y, "y", by, verbose, match_type_error)
+      mte_y <- is_match_type_error(y, "y", by, verbose, match_type_error)
   } else {
       y_m <- is_valid_m_key(y, by)
     }
 
+  if (TRUE %in% c(mte_x, mte_y)) {
+    match_type_error <-TRUE
+    }
+
   # Error if user chooses "1" but actually "m" ----
   if (match_type_error) {
+
     msg     <- "match type inconsistency"
     hint    <-
-      "you could use `return_report = TRUE` in `joyn::is_id()`
-    to see where the problem is"
+      "set verbose to TRUE to see where the issue is"
     joyn_msg("err")
+
+    if (verbose == TRUE) {
+
+      msg     <- "match type inconsistency"
+      hint    <-
+        "refer to the duplicate counts in the table(s) above
+       to identify where the issue occurred"
+
+      if (mte_x == TRUE) {
+        display_id_x <- is_id(x, by, return_report = TRUE, verbose = FALSE) |>
+          fsubset(copies > 1)
+
+        cli::cli_inform("Duplicate counts in {.field x}:")
+        print(display_id_x)
+        # I would like to show the table with the duplicated values.
+        # Something like this:
+        #      dt <- collapse::join(x, display_id_x,
+        #      on = by,
+        #      how = "inner",
+        #      verbose = FALSE)
+        #      dt[]
+      }
+
+      if (mte_y == TRUE) {
+        display_id_y <- is_id(y, by, return_report = TRUE, verbose = FALSE) |>
+          fsubset(copies > 1)
+
+        cli::cli_inform("Duplicate counts in {.field y}:")
+        print(display_id_y)
+      }
+
+    }
+
     cli::cli_abort(c(msg,
                      i = hint),
-                   class = "joyn_error")
+                     class = "joyn_error")
 
   }
 
-  # Warning if user choses "m" but actually "1" ----
+  # Warning if user chooses "m" but actually "1" ----
   m_m <- data.table::fcase(
     isTRUE(x_m)  & isTRUE(y_m),  "none",
     isTRUE(x_m)  & isFALSE(y_m), "warn_y",

R/utils.R

@@ -128,3 +128,195 @@ is_balanced <- function(df,
 
 }
 
+
+#' Unmask joyn function (namespace version)
+#'
+#' @param fun_name character of function to unmask
+#' @param pkg_name character specifying package from which joyn masks the function
+#'
+#' @return invisibly unmask function that joyn masks
+#' @keywords internal
+unmask_joyn_fun_ns <- function(fun_name,
+                               pkg_name) {
+
+  # Checks ####
+
+  # if package {pkg_name} is not loaded, stop and inform user
+  if (!pkg_name %in% tolower(.packages())) {
+
+    store_msg(type = "err",
+              err  = paste(cli::symbol$cross, "Error:"),
+              pale = "   package {pkg_name} must be loaded."
+    )
+
+    joyn_msg("err")
+    cli::cli_abort("{pkg_name} is not loaded")
+  }
+
+  # if function {fun_name} is not an exported object of {pkg_name}, stop and inform user
+
+  if (!any(fun_name %in% getNamespaceExports(pkg_name))) {
+
+    store_msg(type = "err",
+              err  = paste(cli::symbol$cross, "Error:"),
+              pale = "   {fun_name} must be exported object(s) of {pkg_name}."
+    )
+
+    joyn_msg("err")
+    cli::cli_abort("{fun_name} not exported from {pkg_name}")
+  }
+
+  # get joyn namespace
+  joyn_ns <- getNamespace("joyn")
+
+  # unlock binding
+  unlockBinding(fun_name, env = joyn_ns)
+
+  # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  # Unmask functions ----
+  # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+  # get namespace exports
+  joyn_ns_exports_names <- getNamespaceExports(joyn_ns)
+
+  # get functions to unmask -filter those that are in joyn_ns exports
+  fun_name <- fun_name[fun_name %in% joyn_ns_exports_names]
+
+  # get joyn's namespace exports' environment
+  joyn_ns_exports <- .getNamespaceInfo(joyn_ns,
+                                       "exports")
+
+  # remove binding from joyn's namespace exports' environment
+  remove(list = fun_name,
+         envir = joyn_ns_exports)
+
+  joyn_ns <- getNamespace("joyn")
+
+  # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  # Apply the new mask ----
+  #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+  new_mask <- getExportedValue(ns = getNamespace(pkg_name), name = fun_name)
+
+  rlang::env_poke(env    = joyn_ns,
+                  nm     = fun_name,
+                  value  = new_mask,
+                  create = TRUE)
+
+
+  # Lock the binding again
+  lockEnvironment(joyn_ns,
+                  bindings = TRUE)
+
+  # Detach and reattach "joyn" if currently loaded
+
+  # if(anyv(search(), "package:joyn")) {   #anyv is the collapse version of any()
+  #   detach_package("joyn")
+  #   suppressPackageStartupMessages(attachNamespace(joyn_ns))
+  # }
+
+  # return
+  invisible(TRUE)
+
+}
+
+#' Unmask joyn functions
+#'
+#' @param fun_name character vector of one or more functions to unmask
+#' @param pkg_name character specifying package from which joyn masks the function(s)
+#'
+#' @return invisible list
+#' @export
+#' @examples
+#' \dontrun{
+#' library(dplyr)
+#' library(joyn)
+#'
+#' left_join(
+#'   data.frame(x = 1:3, y = 1:3),
+#'   data.frame(x = 1:2, z = 1:2),
+#'   by = "x"
+#' )
+#' unmask_joyn("left_join")
+#'
+#' left_join(
+#'   data.frame(x = 1:3, y = 1:3),
+#'   data.frame(x = 1:2, z = 1:2),
+#'   by = "x"
+#' )
+#' }
+unmask_joyn <- \(fun_name,
+                 pkg_name = "dplyr") {
+
+  fun_name <- match.arg(arg        = fun_name,
+                       choices     = c("right_join", "left_join", "inner_join", "full_join"),
+                       several.ok  = TRUE)
+
+  l <- lapply(fun_name, \(.) {
+
+    tryCatch(
+      expr = {
+        # unmask joyn function
+        unmask_joyn_fun_ns(., pkg_name)
+        "unmasked"
+      },
+
+      error = function(e) {
+        paste("Error:", e$message)
+      }, # end of error section
+
+      warning = function(w) {
+        paste("Warning:",w$message)
+      }
+    ) # End of tryCatch
+  }
+  )
+
+  joyn_ns <- getNamespace("joyn")
+
+  if(anyv(search(), "package:joyn")) {   #anyv is the collapse version of any()
+    detach_package("joyn")
+    suppressPackageStartupMessages(attachNamespace(joyn_ns))
+  }
+
+  names(l) <- fun_name
+
+  clear_joynenv()
+
+  # Inform the user
+  store_msg(type        = "info",
+            ok          = paste(cli::symbol$info, " Note:  "),
+            pale        = "function",
+            bolded_pale = "  {fun_name}",
+            pale        = "  unmasked.",
+            bolded_pale = " {pkg_name}::{fun_name}",
+            pale        = " preferred")
+
+  joyn_msg()
+
+  return(invisible(l))
+
+}
+
+
+#' Detach a package from search list
+#'
+#' This is an auxiliary function to avoid errors when detaching a package
+#' -e.g., when multiple versions are loaded at the same time
+#'
+#' @param pkg_name name of the package to detach
+#' @return invisibly detach package from search list
+#' @keywords internal
+#'
+detach_package <- function(pkg_name) {
+
+  search_item <- paste("package", pkg_name, sep = ":")
+
+  if(search_item %in% search()) {
+
+    detach(search_item,
+           unload = TRUE,
+           character.only = TRUE)
+
+  }
+}

_pkgdown.yml

@@ -85,3 +85,4 @@ reference:
   - is_balanced
   - rename_to_valid
   - joyn_msg
+  - unmask_joyn