datadiff 0.6.0 : traitement des 24 issues ouvertes de l'audit

.Rbuildignore

@@ -13,3 +13,4 @@
 ^README\.Rmd$
 ^doc$
 ^Meta$
+^dev$

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: datadiff
 Title: Data Validation Based on 'YAML' Rules
-Version: 0.4.9.9000
+Version: 0.6.0
 Authors@R: c(
     person("Vincent", "Guyader", , "vincent@thinkr.fr", role = c("cre", "aut"),
            comment = c(ORCID = "0000-0003-0671-9270")),
@@ -18,7 +18,6 @@ Imports:
     dplyr (>= 1.0.0),
     pointblank (>= 0.12.3),
     rlang (>= 0.4.0),
-    stats,
     tidyselect (>= 1.0.0),
     utils,
     yaml (>= 2.2.0)

NAMESPACE

@@ -1,8 +1,10 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method("$",datadiff_result)
+S3method("[[",datadiff_result)
 S3method(print,datadiff_coverage)
 S3method(print,datadiff_report)
-export("%||%")
+S3method(print,datadiff_result)
 export(add_tolerance_columns)
 export(analyze_columns)
 export(compare_datasets_from_yaml)
@@ -16,8 +18,6 @@ export(setup_pointblank_agent)
 export(validate_row_counts)
 export(write_rules_template)
 importFrom(dplyr,"%>%")
-importFrom(dplyr,across)
-importFrom(dplyr,arrange)
 importFrom(dplyr,collect)
 importFrom(dplyr,left_join)
 importFrom(pointblank,action_levels)
@@ -26,7 +26,7 @@ importFrom(pointblank,col_vals_equal)
 importFrom(pointblank,create_agent)
 importFrom(pointblank,interrogate)
 importFrom(rlang,":=")
-importFrom(stats,setNames)
+importFrom(rlang,.data)
 importFrom(tidyselect,all_of)
 importFrom(utils,modifyList)
 importFrom(yaml,read_yaml)

R/constants.R

@@ -0,0 +1,39 @@
+# Internal naming conventions shared by the boolean producers (tolerance.R,
+# compare_datasets_from_yaml.R), the verdict consumers (fast_path.R,
+# coverage.R) and the report step mapping (report.R, pointblank_setup.R).
+# They live in one place because a drift on one side breaks the mapping
+# SILENTLY: the report step is simply not found and its extract is lost.
+
+# Suffix of the per-column boolean produced for a tolerance column.
+datadiff_suffix_ok <- "__ok"
+
+# Suffix of the per-column boolean produced for an equality column.
+datadiff_suffix_eq <- "__eq"
+
+# Prefix of the dummy column carrying a missing-column failure step.
+datadiff_prefix_missing_col <- "__missing_col_"
+
+# Prefix of the dummy column carrying a type-mismatch failure step.
+datadiff_prefix_type_mismatch <- "__type_mismatch_"
+
+# Column name helpers: the only supported way to build these names.
+# Length-guarded: paste0(character(0), suffix) yields the bare suffix
+# (recycle0 is FALSE by default), a phantom column name.
+datadiff_ok_col <- function(col) {
+  if (length(col) == 0) {
+    return(character(0))
+  }
+  paste0(col, datadiff_suffix_ok)
+}
+datadiff_eq_col <- function(col) {
+  if (length(col) == 0) {
+    return(character(0))
+  }
+  paste0(col, datadiff_suffix_eq)
+}
+
+# Default pointblank action levels (fractions of failing rows). Used as the
+# internal fallback everywhere a threshold is reconstructed from attributes;
+# the public compare_datasets_from_yaml() signature documents the same value.
+datadiff_default_warn_at <- 1e-14
+datadiff_default_stop_at <- 1e-14

R/coverage.R

@@ -9,7 +9,9 @@
 # matching col_vals_equal(..., na_pass = FALSE).
 tol_col_counts <- function(tbl, col) {
   ok <- tol_col_bool(tbl, col = col)
-  list(n = length(ok), n_failed = sum(is.na(ok) | !ok))
+  # length - sum(TRUE) counts FALSE and NA in one pass without allocating
+  # the two intermediate logical vectors of is.na(ok) | !ok
+  list(n = length(ok), n_failed = length(ok) - sum(ok, na.rm = TRUE))
 }
 
 # n / n_failed for an equality column (resolved boolean, no NA).
@@ -18,54 +20,109 @@ eq_col_counts <- function(tbl, col, ref_suffix, na_equal) {
   list(n = length(b), n_failed = sum(!b))
 }
 
+# (n, n_failed) for every boolean validation column of a LAZY table, computed
+# in ONE SQL aggregate scan: SUM(CASE WHEN col THEN 0 ELSE 1 END) counts the
+# not-TRUE values (FALSE and NULL alike), matching the local reducers
+# (tolerance: is.na | !ok; equality: !b, NA-free by construction). This is
+# what lets the lazy verdict avoid collecting N x columns booleans into R.
+# Returns a named list keyed by the UNDERLYING column name:
+# list(<col> = list(n, n_failed), ...).
+lazy_boolean_counts <- function(tbl_lazy, tol_cols, eq_cols) {
+  con <- dbplyr::remote_con(tbl_lazy)
+  sub <- dbplyr::sql_render(tbl_lazy)
+  q   <- function(x) as.character(DBI::dbQuoteIdentifier(con, x = x))
+
+  bool_cols <- c(datadiff_ok_col(tol_cols), datadiff_eq_col(eq_cols))
+  underlying <- c(tol_cols, eq_cols)
+  nf_exprs <- vapply(X = seq_along(bool_cols), FUN = function(i) {
+    sprintf("SUM(CASE WHEN %s THEN 0 ELSE 1 END) AS %s",
+            q(bool_cols[i]), q(sprintf("..datadiff_nf_%d", i)))
+  }, FUN.VALUE = character(1))
+
+  sql <- sprintf(
+    "SELECT COUNT(*) AS %s%s FROM (%s) AS %s",
+    q("..datadiff_total"),
+    if (length(nf_exprs) > 0) {
+      paste0(", ", paste(nf_exprs, collapse = ", "))
+    } else {
+      ""
+    },
+    sub, q("datadiff_counts")
+  )
+  row <- DBI::dbGetQuery(con, statement = sql)
+
+  total <- as.numeric(row[["..datadiff_total"]])
+  counts <- vector("list", length(underlying))
+  names(counts) <- underlying
+  for (i in seq_along(underlying)) {
+    nf <- as.numeric(row[[sprintf("..datadiff_nf_%d", i)]])
+    # SUM over an empty table is NULL: zero rows means zero failures
+    counts[[i]] <- list(n = total, n_failed = if (is.na(nf)) {
+      0
+    } else {
+      nf
+    })
+  }
+  counts
+}
+
 #' Build a faithful coverage summary of the checks performed
 #'
 #' @param tbl Local data.frame holding the boolean validation columns (and, on
 #'   the local path, the raw + reference columns for equality recomputation).
+#'   Ignored when `counts` is supplied.
 #' @param tol_cols,eq_cols Character vectors of tolerance / equality columns.
 #' @param missing_in_candidate,type_mismatch_cols Structural failures.
 #' @param row_validation_info List with `check_count`.
 #' @param row_count_ok Logical row-count outcome.
 #' @param ref_suffix Suffix identifying reference columns.
 #' @param na_equal Logical; NA equality semantics for equality columns.
+#' @param counts Optional precomputed per-column counts (named list
+#'   `col -> list(n, n_failed)` covering every tolerance and equality column),
+#'   as produced by `lazy_boolean_counts()`: the lazy path aggregates in SQL
+#'   instead of collecting the booleans.
 #' @return A `datadiff_coverage` data.frame with columns `column`, `check`,
 #'   `n`, `n_failed`, `status` (one row per check performed).
 #' @noRd
 build_coverage <- function(tbl, tol_cols, eq_cols,
                            missing_in_candidate, type_mismatch_cols,
                            row_validation_info, row_count_ok,
-                           ref_suffix, na_equal) {
+                           ref_suffix, na_equal, counts = NULL) {
   columns  <- character(0)
   checks   <- character(0)
-  ns       <- integer(0)
-  n_failed <- integer(0)
+  ns       <- numeric(0)
+  n_failed <- numeric(0)
 
   add <- function(column, check, n, nf) {
     columns  <<- c(columns, column)
     checks   <<- c(checks, check)
-    ns       <<- c(ns, as.integer(n))
-    n_failed <<- c(n_failed, as.integer(nf))
+    # numeric, not integer: the lazy counts come from SQL aggregates and can
+    # exceed 2^31 - 1, where as.integer() would overflow to NA and silently
+    # corrupt the coverage and the verdict
+    ns       <<- c(ns, as.numeric(n))
+    n_failed <<- c(n_failed, as.numeric(nf))
   }
 
   # Existence checks: every common (non-type-mismatch) column gets a col_exists
   # check, distinct from its value check. These pass (the column is present in
   # both datasets by construction), mirroring a full per-column pointblank run.
-  for (c in c(tol_cols, eq_cols)) {
-    add(c, "col_exists", 1L, 0L)
+  for (col_nm in c(tol_cols, eq_cols)) {
+    add(col_nm, "col_exists", 1L, 0L)
   }
-  for (c in tol_cols) {
-    cnt <- tol_col_counts(tbl, col = c)
-    add(c, "tolerance", cnt$n, cnt$n_failed)
+  for (col_nm in tol_cols) {
+    cnt <- counts[[col_nm]] %||% tol_col_counts(tbl, col = col_nm)
+    add(col_nm, "tolerance", cnt$n, cnt$n_failed)
   }
-  for (c in eq_cols) {
-    cnt <- eq_col_counts(tbl, col = c, ref_suffix = ref_suffix, na_equal = na_equal)
-    add(c, "equality", cnt$n, cnt$n_failed)
+  for (col_nm in eq_cols) {
+    cnt <- counts[[col_nm]] %||%
+      eq_col_counts(tbl, col = col_nm, ref_suffix = ref_suffix, na_equal = na_equal)
+    add(col_nm, "equality", cnt$n, cnt$n_failed)
   }
-  for (c in missing_in_candidate) {
-    add(c, "missing_column", 1L, 1L)
+  for (col_nm in missing_in_candidate) {
+    add(col_nm, "missing_column", 1L, 1L)
   }
-  for (c in type_mismatch_cols) {
-    add(c, "type_mismatch", 1L, 1L)
+  for (col_nm in type_mismatch_cols) {
+    add(col_nm, "type_mismatch", 1L, 1L)
   }
   if (isTRUE(row_validation_info$check_count)) {
     add("<row_count>", "row_count", 1L, if (isTRUE(row_count_ok)) 0L else 1L)

R/data_types.R

@@ -3,6 +3,12 @@
 #' Analyzes each column of a dataframe to determine its data type
 #' (integer, numeric, date, datetime, logical, or character)
 #'
+#' Any column matching none of the first five types falls in the "character"
+#' bucket and receives the character rules. That is intentional for factors
+#' (compared as the character values they display, see
+#' [preprocess_dataframe()]) and works for types whose `==` behaves like
+#' character (e.g. `bit64::integer64`). List-columns are not supported.
+#'
 #' @param data A dataframe or tibble
 #' @return A named character vector with column names as names and types as values
 #' @examples

R/datadiff-result.R

@@ -0,0 +1,51 @@
+# Accessors for the result of compare_datasets_from_yaml().
+#
+# The result is a plain named list of class `datadiff_result`. The class only
+# exists to keep the historical `reponse` field name readable while user code
+# migrates to `response`: `$` and `[[` redirect the old name to the new one
+# with a deprecation warning, and behave like plain list access otherwise.
+
+new_datadiff_result <- function(fields) {
+  structure(fields, class = "datadiff_result")
+}
+
+warn_reponse_deprecated <- function() {
+  rlang::warn(
+    message = paste(
+      "The `reponse` field is deprecated as of {datadiff} 0.6.0:",
+      "use `response` instead.",
+      "`reponse` will be removed in a future release."
+    ),
+    .frequency = "once",
+    .frequency_id = "datadiff_reponse_deprecated",
+    class = "datadiff_deprecated_reponse_warning"
+  )
+}
+
+#' @export
+#' @noRd
+`$.datadiff_result` <- function(x, name) {
+  if (identical(name, "reponse")) {
+    warn_reponse_deprecated()
+    name <- "response"
+  }
+  # exact = FALSE replicates the silent partial matching of `$` on plain lists
+  unclass(x)[[name, exact = FALSE]]
+}
+
+#' @export
+#' @noRd
+`[[.datadiff_result` <- function(x, i, ...) {
+  if (identical(i, "reponse")) {
+    warn_reponse_deprecated()
+    i <- "response"
+  }
+  unclass(x)[[i, ...]]
+}
+
+#' @export
+#' @noRd
+print.datadiff_result <- function(x, ...) {
+  print(unclass(x), ...)
+  invisible(x)
+}

R/duplicate_keys.R

@@ -10,29 +10,57 @@
 # tables keep the SQL-native count()/group_by (cheap inside the database).
 
 format_key_examples <- function(uniq_keys, key) {
-  rows <- unname(apply(uniq_keys, 1, function(r) {
+  n_groups <- nrow(uniq_keys)
+  shown <- utils::head(uniq_keys, 3L)
+  rows <- unname(apply(shown, 1, function(r) {
     paste(key, "=", r, collapse = ", ")
   }))
-  if (length(rows) <= 3) {
-    rows
-  } else {
-    c(rows[1:3], "...")
+  if (n_groups > 3L) {
+    rows <- c(rows, "...")
   }
+  rows
 }
 
+#' @importFrom rlang .data
+#' @noRd
 find_duplicate_keys <- function(data, key) {
   if (is_non_local(data)) {
-    dups <- data %>%
-      dplyr::count(dplyr::across(dplyr::all_of(key))) %>%
-      dplyr::filter(n > 1L) %>%
+    # Reserved count name: count()'s default "n" collides with a user column
+    # named "n" (count() then stores its result in "nn", and a key named "n"
+    # would be filtered on its own values instead of the count). The reserved
+    # name is extended until it differs from every key column, because
+    # count(name = <grouping column>) silently REPLACES that grouping column
+    # with the count.
+    count_col <- "..datadiff_n"
+    while (count_col %in% key) {
+      count_col <- paste0(count_col, "_")
+    }
+    duplicated_groups <- data %>%
+      dplyr::count(dplyr::across(dplyr::all_of(key)), name = count_col) %>%
+      dplyr::filter(.data[[count_col]] > 1L)
+    # Aggregate in SQL: only 2 scalars plus at most 3 example groups cross the
+    # wire, instead of every duplicated group (potentially millions).
+    agg <- duplicated_groups %>%
+      dplyr::summarise(
+        ..datadiff_dup_keys = dplyr::n(),
+        ..datadiff_dup_rows = sum(.data[[count_col]], na.rm = TRUE)
+      ) %>%
       dplyr::collect()
-    if (nrow(dups) == 0L) {
+    n_dup_keys <- as.numeric(agg$..datadiff_dup_keys)
+    if (n_dup_keys == 0) {
       return(NULL)
     }
+    example_groups <- duplicated_groups %>%
+      utils::head(3L) %>%
+      dplyr::collect()
+    examples <- format_key_examples(example_groups[, key, drop = FALSE], key)
+    if (n_dup_keys > 3) {
+      examples <- c(examples, "...")
+    }
     return(list(
-      n_dup_keys = nrow(dups),
-      n_dup_rows = sum(dups$n),
-      examples   = format_key_examples(dups[, key, drop = FALSE], key)
+      n_dup_keys = n_dup_keys,
+      n_dup_rows = as.numeric(agg$..datadiff_dup_rows),
+      examples   = examples
     ))
   }