Add dataset-level attribute comparison support (#148)

R/diffdf.R

@@ -127,6 +127,8 @@ diffdf <- function(
         message = "Summary of BASE and COMPARE"
     )
 
+    df_attrib_diffs <- identify_df_att_differences(BASE, COMP)
+
 
     is_derived <- FALSE
 
@@ -277,6 +279,12 @@ diffdf <- function(
     }
 
 
+    COMPARE[["DataframeAttribDiffs"]] <- construct_issue(
+        value = df_attrib_diffs,
+        message = "BASE and COMPARE dataframes have differing attributes !!"
+    )
+
+
     ##### Check Attributes
     COMPARE[["AttribDiffs"]] <- construct_issue(
         value = identify_att_differences(BASE, COMP, exclude_cols),

R/identify.R

@@ -208,6 +208,57 @@ identify_att_differences <- function(BASE, COMP, exclude_cols = "") {
 
 
 
+#' Identify differences in dataframe attributes
+#'
+#' Identifies any attribute differences between two data frames at the dataset
+#' level (for example dataset labels). Structural attributes are excluded.
+#' @param BASE Base dataset for comparison (data.frame)
+#' @param COMP Comparator dataset to compare base against (data.frame)
+#' @param exclude_attrs Data frame attributes to exclude from comparison
+#' @importFrom tibble tibble
+#' @keywords internal
+identify_df_att_differences <- function(
+    BASE,
+    COMP,
+    exclude_attrs = c("names", "row.names", "class")
+) {
+    base_atts <- attributes(BASE)
+    comp_atts <- attributes(COMP)
+
+    attrib_names <- setdiff(
+        unique(c(names(base_atts), names(comp_atts))),
+        exclude_attrs
+    )
+
+    RETURN <- tibble(
+        ATTR_NAME = character(),
+        VALUES.BASE = list(),
+        VALUES.COMP = list()
+    )
+
+    if (length(attrib_names) == 0) {
+        return(RETURN)
+    }
+
+    for (i in attrib_names) {
+        attrib_base <- base_atts[i]
+        attrib_comp <- comp_atts[i]
+
+        if (!identical(attrib_base, attrib_comp)) {
+            att_diffs <- tibble(
+                ATTR_NAME = i,
+                VALUES.BASE = ifelse(is.null(attrib_base), list(), attrib_base),
+                VALUES.COMP = ifelse(is.null(attrib_comp), list(), attrib_comp)
+            )
+
+            RETURN <- rbind(RETURN, att_diffs)
+        }
+    }
+
+    return(RETURN)
+}
+
+
 
 #' identify_differences
 #'

tests/testthat/_snaps/print_output.md

@@ -938,3 +938,111 @@
 
 
 
+# #148 - print handles dataframe-level attributes
+
+    Code
+      print(x)
+    Output
+      Differences found between the objects!
+
+      Summary of BASE and COMPARE
+        ==================================================================
+          PROPERTY             BASE                       COMP            
+        ------------------------------------------------------------------
+            Name                d1                         d2             
+           Class     "tbl_df, tbl, data.frame"  "tbl_df, tbl, data.frame" 
+          Rows(#)                3                          3             
+         Columns(#)              2                          2             
+        ------------------------------------------------------------------
+
+
+      BASE and COMPARE dataframes have differing attributes !!
+        ===================================================================================
+          ATTR_NAME              VALUES.BASE                        VALUES.COMP            
+        -----------------------------------------------------------------------------------
+         complex_att  list(list(code = "A", payload ...  list(list(code = "B", payload ... 
+        -----------------------------------------------------------------------------------
+
+
+
+# #148 - print handles dataframe-level attribute NULL vs non-NULL
+
+    Code
+      print(x)
+    Output
+      Differences found between the objects!
+
+      Summary of BASE and COMPARE
+        ==================================================================
+          PROPERTY             BASE                       COMP            
+        ------------------------------------------------------------------
+            Name                d1                         d2             
+           Class     "tbl_df, tbl, data.frame"  "tbl_df, tbl, data.frame" 
+          Rows(#)                3                          3             
+         Columns(#)              2                          2             
+        ------------------------------------------------------------------
+
+
+      BASE and COMPARE dataframes have differing attributes !!
+        =========================================
+         ATTR_NAME  VALUES.BASE    VALUES.COMP   
+        -----------------------------------------
+          df_note      NULL      "non-null note" 
+        -----------------------------------------
+
+
+
+# #148 - print handles dataframe-level attribute character vectors
+
+    Code
+      print(x)
+    Output
+      Differences found between the objects!
+
+      Summary of BASE and COMPARE
+        ==================================================================
+          PROPERTY             BASE                       COMP            
+        ------------------------------------------------------------------
+            Name                d1                         d2             
+           Class     "tbl_df, tbl, data.frame"  "tbl_df, tbl, data.frame" 
+          Rows(#)                3                          3             
+         Columns(#)              2                          2             
+        ------------------------------------------------------------------
+
+
+      BASE and COMPARE dataframes have differing attributes !!
+        ====================================================
+         ATTR_NAME     VALUES.BASE          VALUES.COMP     
+        ----------------------------------------------------
+          df_vec    c("alpha", "beta")  c("alpha", "gamma") 
+        ----------------------------------------------------
+
+
+
+# #148 - print handles dataframe label attributes with Japanese text
+
+    Code
+      print(x)
+    Output
+      Differences found between the objects!
+
+      Summary of BASE and COMPARE
+        ==================================================================
+          PROPERTY             BASE                       COMP            
+        ------------------------------------------------------------------
+            Name                d1                         d2             
+           Class     "tbl_df, tbl, data.frame"  "tbl_df, tbl, data.frame" 
+          Rows(#)                3                          3             
+         Columns(#)              2                          2             
+        ------------------------------------------------------------------
+
+
+      BASE and COMPARE dataframes have differing attributes !!
+        =====================================
+         ATTR_NAME  VALUES.BASE  VALUES.COMP 
+        -------------------------------------
+           label      臨床検査データ     血液学検査データ   
+        -------------------------------------
+
+
+

tests/testthat/test-core.R

@@ -66,6 +66,12 @@ attr(TDAT_LABEXT$ID, "label") <- "ID label"
 
 attr(TDAT_LABEXT2$ID, "label") <- "different label"
 
+## change dataset label
+TDAT_DFLAB <- TDAT
+TDAT_DFLAB2 <- TDAT
+attr(TDAT_DFLAB, "label") <- "Demographics"
+attr(TDAT_DFLAB2, "label") <- "Screening"
+
 ### add some extra attributes
 
 TDAT_ATTEXT <- TDAT
@@ -305,6 +311,11 @@ test_that("Objets with differing attributes produce the correct warning", {
     expect_warning(diffdf(TDAT, TDAT_LABEXT), warning_msg)
     expect_warning(diffdf(TDAT, TDAT_LABEXT2), warning_msg)
     expect_warning(diffdf(TDAT_LABEXT, TDAT_LABEXT2), warning_msg)
+
+    expect_warning(
+        diffdf(TDAT_DFLAB, TDAT_DFLAB2),
+        "BASE and COMPARE dataframes have differing attributes"
+    )
 })
 
 
@@ -343,6 +354,11 @@ test_that("Attribute differnce size is correct!", {
         diffdf(TDAT_LABEXT, TDAT_LABEXT2, suppress_warnings = TRUE)$AttribDiffs %>% nrow(),
         2
     )
+
+    expect_equal(
+        diffdf(TDAT_DFLAB, TDAT_DFLAB2, suppress_warnings = TRUE)$DataframeAttribDiffs %>% nrow(),
+        1
+    )
 })
 
 

tests/testthat/test-print_output.R

@@ -157,3 +157,84 @@ test_that("#135 - Writing to file works as expected with row limits", {
     )
 
 })
+
+test_that("#148 - print handles dataframe-level attributes", {
+    d1 <- tibble(
+        id = seq_len(3),
+        x = c("A", "B", "C")
+    )
+    d2 <- d1
+
+    attr(d1, "complex_att") <- list(
+        list(
+            code = "A",
+            payload = data.frame(u = 1:2, v = c("x", "y"))
+        )
+    )
+    attr(d2, "complex_att") <- list(
+        list(
+            code = "B",
+            payload = data.frame(u = 1:2, v = c("x", "z"))
+        )
+    )
+
+    x <- diffdf(d1, d2, keys = "id", suppress_warnings = TRUE)
+
+    expect_equal(nrow(x$DataframeAttribDiffs), 1)
+    expect_snapshot(print(x))
+    expect_no_error(out <- print(x, as_string = TRUE))
+    expect_true(any(grepl("BASE and COMPARE dataframes have differing attributes", out, fixed = TRUE)))
+})
+
+test_that("#148 - print handles dataframe-level attribute NULL vs non-NULL", {
+    d1 <- tibble(
+        id = seq_len(3),
+        x = c("A", "B", "C")
+    )
+    d2 <- d1
+
+    attr(d2, "df_note") <- "non-null note"
+
+    x <- diffdf(d1, d2, keys = "id", suppress_warnings = TRUE)
+
+    expect_equal(nrow(x$DataframeAttribDiffs), 1)
+    expect_snapshot(print(x))
+    expect_no_error(out <- print(x, as_string = TRUE))
+    expect_true(any(grepl("df_note", out, fixed = TRUE)))
+})
+
+test_that("#148 - print handles dataframe-level attribute character vectors", {
+    d1 <- tibble(
+        id = seq_len(3),
+        x = c("A", "B", "C")
+    )
+    d2 <- d1
+
+    attr(d1, "df_vec") <- c("alpha", "beta")
+    attr(d2, "df_vec") <- c("alpha", "gamma")
+
+    x <- diffdf(d1, d2, keys = "id", suppress_warnings = TRUE)
+
+    expect_equal(nrow(x$DataframeAttribDiffs), 1)
+    expect_snapshot(print(x))
+    expect_no_error(out <- print(x, as_string = TRUE))
+    expect_true(any(grepl("df_vec", out, fixed = TRUE)))
+})
+
+test_that("#148 - print handles dataframe label attributes with Japanese text", {
+    d1 <- tibble(
+        id = seq_len(3),
+        x = c("A", "B", "C")
+    )
+    d2 <- d1
+
+    attr(d1, "label") <- "臨床検査データ"
+    attr(d2, "label") <- "血液学検査データ"
+
+    x <- diffdf(d1, d2, keys = "id", suppress_warnings = TRUE)
+
+    expect_equal(nrow(x$DataframeAttribDiffs), 1)
+    expect_snapshot(print(x))
+    expect_no_error(out <- print(x, as_string = TRUE))
+    expect_true(any(grepl("label", out, fixed = TRUE)))
+})