From 3c72898e176796b9b7df1743682ea3e852a36de6 Mon Sep 17 00:00:00 2001 From: botsp Date: Wed, 9 Sep 2026 00:54:39 +0800 Subject: [PATCH 1/2] Add dataset-level attribute comparison support (#148) --- R/diffdf.R | 8 ++++++ R/identify.R | 51 ++++++++++++++++++++++++++++++++++++++ tests/testthat/test-core.R | 16 ++++++++++++ 3 files changed, 75 insertions(+) diff --git a/R/diffdf.R b/R/diffdf.R index 1039512a..1466c88c 100644 --- a/R/diffdf.R +++ b/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), diff --git a/R/identify.R b/R/identify.R index 5ebb7f0b..634dac65 100644 --- a/R/identify.R +++ b/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 #' diff --git a/tests/testthat/test-core.R b/tests/testthat/test-core.R index 821922a2..66279f06 100644 --- a/tests/testthat/test-core.R +++ b/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 + ) }) From 7e370ff51ba1c0c00e04d2a83677930e8895561b Mon Sep 17 00:00:00 2001 From: botsp Date: Wed, 9 Sep 2026 11:51:07 +0800 Subject: [PATCH 2/2] Add #148 print tests for dataframe-level attributes --- tests/testthat/_snaps/print_output.md | 108 ++++++++++++++++++++++++++ tests/testthat/test-print_output.R | 81 +++++++++++++++++++ 2 files changed, 189 insertions(+) diff --git a/tests/testthat/_snaps/print_output.md b/tests/testthat/_snaps/print_output.md index 9d2532e9..2c58aada 100644 --- a/tests/testthat/_snaps/print_output.md +++ b/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 臨床検査データ 血液学検査データ + ------------------------------------- + + + diff --git a/tests/testthat/test-print_output.R b/tests/testthat/test-print_output.R index 0d6f0fc7..d5ef3534 100644 --- a/tests/testthat/test-print_output.R +++ b/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))) +})