Merge pull request #50 from RossanaTat/new_update_fun

New update fun

DESCRIPTION

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

R/checks.R

@@ -475,18 +475,18 @@ check_new_y_vars <- \(x, by, y_vars_to_keep) {
     y.upvars <- paste0(upvars, ".y")
     y_vars_to_keep[y_vars_to_keep %in% upvars] <- y.upvars
 
-    if (isFALSE(update_NAs) && isFALSE(update_values)) {
-      store_msg(
-        "note",
-        ok          = paste(cli::symbol$info, "  ", cli::symbol$pointer, "  "),
-        pale        = "variable{?s} ",
-        bolded_pale = "{upvars}",
-        pale        = "  in table",
-        bolded_pale = "  {y}",
-        pale        = "  {?is/are} ignored because arguments",
-        bolded_pale = "  update_NAs and update_values",
-        pale        = "  are FALSE.")
-    }
+ #   if (isFALSE(update_NAs) && isFALSE(update_values)) {
+#      store_msg(
+#        "note",
+#        ok          = paste(cli::symbol$info, "  ", cli::symbol$pointer, "  "),
+#        pale        = "variable{?s} ",
+#        bolded_pale = "{upvars}",
+#        pale        = "  in table",
+#        bolded_pale = "  {y}",
+#        pale        = "  {?is/are} ignored because arguments",
+#        bolded_pale = "  update_NAs and update_values",
+#        pale        = "  are FALSE.")
+#    }
 
   } # end of update vars
 

R/joyn-merge.R

@@ -254,10 +254,10 @@ joyn <- function(x,
   #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
   common_vars <- intersect(names(x), names(y))
-  if (!is.null(fixby$yby)) {
-    common_vars <- common_vars[!common_vars %in% fixby$yby]
+  if (!(is.null(fixby$yby))) {
+    common_vars <- common_vars[!(common_vars %in% c(fixby$yby, fixby$tempkey))]
   } else {
-    common_vars <- common_vars[!common_vars %in% fixby$by]
+    common_vars <- common_vars[!(common_vars %in% fixby$by)]
   }
   ## treatment of y_vars_to_keep ------
   y_vars_to_keep <- check_y_vars_to_keep(y_vars_to_keep, y, by)
@@ -381,42 +381,26 @@ joyn <- function(x,
       fsubset(get(reportvar)  >= 3)
   }
 
-
-
-
   #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   #                   Update x   ---------
   #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   var_use <- NULL
-  if (isTRUE(update_values) || isTRUE(update_NAs)) {
+  if (isTRUE(update_NAs) || isTRUE(update_values)) {
     var_use <- common_vars
   }
 
-  #return(list(reportvar))
-  if (isTRUE(update_values) & length(var_use) > 0) {
+  if (isTRUE(update_NAs || update_values) & length(var_use) > 0 ) {
 
-    x <- update_values(
-      dt        = x,
-      var       = var_use,
-      reportvar = reportvar,
-      suffix    = suffixes
+    x <- update_na_values(dt           = x,
+                          var          = var_use,
+                          reportvar    = reportvar,
+                          suffixes     = suffixes,
+                          rep_NAs      = update_NAs,
+                          rep_values   = update_values
     )
-
   }
 
 
-  # update NAs
-  if (isTRUE(update_NAs) & length(var_use) > 0) {
-
-    x <- update_NAs(
-      dt        = x,
-      var       = var_use,
-      reportvar = reportvar,
-      suffix    = suffixes
-    )
-
-  }
-
   ### common vars ----------
 
   if (isFALSE(keep_common_vars)) {
@@ -463,8 +447,6 @@ joyn <- function(x,
   }
 
 
-
-
   ## convert to characters if chosen -------
   if (reporttype == "character") {
 

R/joyn-package.R

@@ -23,7 +23,9 @@ if (getRversion() >= "2.15.1") {
       ":=",
       "..output",
       ".xreport",
-      ".yreport"
+      ".yreport",
+      'use_util_reportvar',
+      'varx_na'
     ),
     package = utils::packageName()
   )

R/update_na_vals.R

@@ -0,0 +1,81 @@
+#' Update NA and/or values
+#'
+#' The function updates NAs and/or values in the following way:
+#' * If only update_NAs is TRUE: update NAs of var in x with values of var y of the same name
+#' * If only update_values = TRUE: update all values, but NOT NAs, of var in x with values of var y of the same name.
+#' NAs from y are not used to update values in x . (e.g., if x.var = 10 and y.var = NA, x.var remains 10)
+#' * If both update_NAs and update_values are TRUE, both NAs and values in x are updated as described above
+#' * If both update_NAs and update_values are FALSE, no update
+#'
+#' @param dt  joined data.table
+#' @param var variable(s) to be updated
+#' @inheritParams joyn
+#' @param rep_NAs inherited from joyn update_NAs
+#' @param rep_values inherited from joyn update_values
+#'
+#' @return data.table
+#' @keywords internal
+update_na_values <- function(dt,
+                             var,
+                             reportvar  = getOption("joyn.reportvar"),
+                             suffixes   = getOption("joyn.suffixes"),
+                             rep_NAs    = FALSE,
+                             rep_values = FALSE) {
+
+  if (is.null(suffixes)) {
+    suffixes <- getOption("joyn.suffixes")
+  }
+  x.var <- paste0(var, suffixes[1])
+  y.var <- paste0(var, suffixes[2])
+
+  is_data_table <- inherits(dt, "data.table")
+
+  # Add util vars ####
+  dt_1 <- copy(dt)
+  dt_1 <- dt_1 |>
+    ftransform(#use_util_reportvar = get(reportvar),
+               # create variable for var.x and var.y is NA
+               # TRUE if NOT NA
+               varx_na            = !missing_cases(mget(x.var)),
+               vary_na            = !missing_cases(mget(y.var)))
+
+  # let reportvar reflect updates ####
+
+  # reportvar = 4 >> update NA in x
+  if (rep_NAs) {
+    dt_1[[reportvar]][
+      !dt_1$varx_na & dt_1$vary_na] <- 4L
+  }
+
+  # reportvar = 5 >> update value in x with value from y
+  if (rep_values) {
+    dt_1[[reportvar]][
+      dt_1$varx_na & dt_1$vary_na] <- 5L
+    # reportvar = 6 >> y is NA => do not update
+    dt_1[[reportvar]][
+      !dt_1$vary_na] <- 6L
+  }
+
+  # Replace values ####
+
+    if (is_data_table) {
+
+      dt_1[get(reportvar) == 4,
+         (x.var) := mget(y.var)]
+
+      dt_1[get(reportvar) == 5,
+         eval(x.var) := mget(y.var)]
+
+    } else {
+
+      to_replace <- which(dt_1[[reportvar]] %in% c(4, 5))
+      dt_1[to_replace, x.var] <- dt_1[to_replace, y.var]
+    }
+
+  # Remove util vars ####
+  get_vars(dt_1, c("varx_na", "vary_na")) <- NULL
+
+  # Return
+  dt_1
+
+}