compare_ard() updates

.github/workflows/rev-dep-check.yaml

@@ -37,31 +37,54 @@ jobs:
       - name: Check Reverse Dependencies
         shell: Rscript {0}
         run: |
-          df <-
-            checked::rev_dep_check_tasks_df(
-              path = ".",
-              repos = "https://packagemanager.posit.co/cran/latest",
-              versions = c("dev", "release")
-            )
-          df <- df[startsWith(df$alias, "gtsummary"), ]
+          g <- checked::plan_rev_dep_checks(
+            path = ".",
+            repos = c('https://ddsjoberg.r-universe.dev', 'https://cloud.r-project.org')
+          )
+          vs <- igraph::V(g)
+          mt <- vs[checked:::is_meta(vs$task)]
+          nodes_to_skip <- mt[!xor(
+            endsWith(mt$name, "meta-revdep-gtsummary-of-cards"),
+            endsWith(mt$name, "meta-revdeps-of-cards")
+          )]
+          g <- igraph::delete_vertices(
+            g,
+            unlist(igraph::neighborhood(g, order = 1, nodes_to_skip, mode = "out"))
+          )
+          g <- checked:::task_graph_class(g)
 
-          design <-
-            checked::check_design$new(
-              df = df,
-              repos = "https://packagemanager.posit.co/cran/latest",
-              output = tempdir(),
-              restore = FALSE
-            )
-          checked::run(design)
-          checked::results(design)
+          design <- checked::checker$new(
+            g,
+            n = 20,
+            output = tempdir(),
+            lib.loc = .libPaths(),
+            repos = c(
+            'https://ddsjoberg.r-universe.dev', 
+            'https://cloud.r-project.org'
+            ),
+            restore = FALSE
+          )
+
+          checked::run(design, reporter = NULL)
+          (r <- checked::results(design))
 
           # Logic to check for errors and abort if found
-          issues <- checked::results(design)$revdep_check_task_spec$gtsummary$errors$issues
+          potential_issues <- r[[1]][[1]]$errors$potential_issues
+          issues <- r[[1]][[1]]$errors$issues
+
+          if (!rlang::is_empty(potential_issues)) {
+            cli::cli_warn(
+              c("A potential issue was flagged in {.pkg gtsummary}.",
+                "i" = "This might mean the CRAN baseline is currently unstable, but a manual review is required just in case.")
+            )
+          }
+
           if (!rlang::is_empty(issues)) {
             cli::cli_abort(
               c("This PR newly breaks {.pkg gtsummary}",
                 "!" = "The PR must be updated as to not break {.pkg gtsummary}.",
                 "i" = "In rare cases where the break is acceptable, the change {.emph MUST} first be approved by Daniel Sjoberg (danieldsjoberg@gmail.com) {.emph before} this PR could potentially be merged."
               )
             )
-          }
+          } 
+

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: cards
 Title: Analysis Results Data
-Version: 0.7.1.9012
+Version: 0.7.1.9011
 Authors@R: c(
     person("Daniel D.", "Sjoberg", , "danield.sjoberg@gmail.com", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0003-0862-2018")),

NAMESPACE

@@ -16,6 +16,7 @@ S3method(ard_tabulate_value,data.frame)
 S3method(ard_total_n,data.frame)
 S3method(fill_formula_selectors,data.frame)
 S3method(print,card)
+S3method(print,compare_ard)
 S3method(process_formula_selectors,data.frame)
 S3method(process_selectors,data.frame)
 export("%>%")
@@ -58,6 +59,7 @@ export(bind_ard)
 export(captured_condition_as_error)
 export(captured_condition_as_message)
 export(cards_select)
+export(check_ard_equal)
 export(check_ard_structure)
 export(check_list_elements)
 export(compare_ard)
@@ -72,6 +74,7 @@ export(fill_formula_selectors)
 export(filter_ard_hierarchical)
 export(get_ard_statistics)
 export(get_cards_fn_stat_names)
+export(is_ard_equal)
 export(is_cards_fn)
 export(label_round)
 export(last_col)

NEWS.md

@@ -1,9 +1,14 @@
-# cards 0.7.1.9012
+# cards 0.7.1.9011
+
+* Fixed bug in `rename_ard_columns()` whereby factor variables were getting converted to integers and added parameter `fct_as_chr` as is used in `unlist_ard_columns()` (#542)
 
 * Adding `ard_tabulate_rows()` function to tabulate the number of rows in a data frame. (#531)
 
 * Users are now messaged if the `by` or `strata` arguments pass columns with different classes in the `ard_tabulate(data,denominator)` arguments as this _may_ cause issues downstream. (#515)
 
+* `as_card` now has the argument `check = TRUE` which when `TRUE` will confirm if the data frame being converted matches the cards spec using `check_ard_structure`. To support this, `check_ard_structure` has a new argument `error_on_fail` which is FALSE by default. When TRUE any failures will generate an error. (#514)
+
+
 # cards 0.7.1
 
 * Updated `ard_stack_hierarchical()` so that the `denominator` dataset only contains the `id` and `by` variables. (#482)

R/ard_attributes.R

@@ -54,7 +54,7 @@ ard_attributes.data.frame <- function(data,
 
   # return empty ARD if no variables selected ----------------------------------
   if (is_empty(variables)) {
-    return(dplyr::tibble() |> as_card())
+    return(dplyr::tibble() |> as_card(check = FALSE))
   }
 
 

R/ard_formals.R

@@ -46,5 +46,5 @@ ard_formals <- function(fun, arg_names, passed_args = list(),
   # put formals list in ARD structure ------------------------------------------
   enframe(lst_args[arg_names], "stat_name", "stat") |>
     dplyr::mutate(stat_label = .data$stat_name, .after = "stat_name") |>
-    as_card()
+    as_card(check = FALSE)
 }

R/ard_hierarchical.R

@@ -114,7 +114,7 @@ ard_hierarchical.data.frame <- function(data,
 
   # return empty ARD if no variables selected ----------------------------------
   if (is_empty(variables)) {
-    return(dplyr::tibble() |> as_card())
+    return(dplyr::tibble() |> as_card(check = FALSE))
   }
 
   # if denominator doesn't have all by, they need to be added ------------------
@@ -192,7 +192,7 @@ ard_hierarchical_count.data.frame <- function(data,
 
   # return empty ARD if no variables selected ----------------------------------
   if (is_empty(variables)) {
-    return(dplyr::tibble() |> as_card())
+    return(dplyr::tibble() |> as_card(check = FALSE))
   }
 
   # add dummy variable for counting --------------------------------------------
@@ -210,7 +210,7 @@ ard_hierarchical_count.data.frame <- function(data,
   ) |>
     .rename_last_group_as_variable(by = by, variables = variables) |>
     dplyr::mutate(context = "hierarchical_count") |>
-    as_card()
+    as_card(check = FALSE)
 }
 
 #' Rename Last Group to Variable

R/ard_missing.R

@@ -58,7 +58,7 @@ ard_missing.data.frame <- function(data,
 
   # return empty ARD if no variables selected ----------------------------------
   if (is_empty(variables)) {
-    return(dplyr::tibble() |> as_card())
+    return(dplyr::tibble() |> as_card(check = FALSE))
   }
 
   # convert all variables to T/F whether it's missing --------------------------

R/ard_mvsummary.R

@@ -91,7 +91,7 @@ ard_mvsummary.data.frame <- function(data,
 
   # return empty ARD if no variables selected ----------------------------------
   if (is_empty(variables)) {
-    return(dplyr::tibble() |> as_card())
+    return(dplyr::tibble() |> as_card(check = FALSE))
   }
 
   missing_statistics_vars <- setdiff(variables, names(statistic))

R/ard_stack_hierarchical.R

@@ -517,7 +517,7 @@ internal_stack_hierarchical <- function(
   }
 
   # return final result --------------------------------------------------------
-  result |> as_card()
+  result |> as_card(check = FALSE)
 }
 
 # this function calculates either the counts or the rates of the events

R/ard_strata.R

@@ -111,6 +111,6 @@ ard_strata <- function(.data, .by = NULL, .strata = NULL, .f, ...) {
   # unnest ard data frame and return final table -------------------------------
   df_nested_data |>
     tidyr::unnest(cols = all_of("ard")) |>
-    as_card() |>
+    as_card(check = FALSE) |>
     tidy_ard_column_order(group_order = "descending")
 }

R/ard_summary.R

@@ -127,7 +127,7 @@ ard_summary.data.frame <- function(data,
 
   # return empty ARD if no variables selected ----------------------------------
   if (is_empty(variables)) {
-    return(dplyr::tibble() |> as_card())
+    return(dplyr::tibble() |> as_card(check = FALSE))
   }
 
 
@@ -187,7 +187,7 @@ ard_summary.data.frame <- function(data,
     dplyr::mutate(context = "summary") |>
     tidy_ard_column_order() |>
     tidy_ard_row_order() |>
-    as_card()
+    as_card(check = FALSE)
 }
 
 

R/ard_tabulate.R

@@ -145,7 +145,7 @@ ard_tabulate.data.frame <- function(data,
 
   # return empty ARD if no variables selected ----------------------------------
   if (is_empty(variables)) {
-    return(dplyr::tibble() |> as_card())
+    return(dplyr::tibble() |> as_card(check = FALSE))
   }
 
   # return note about column names that result in errors -----------------------
@@ -218,7 +218,7 @@ ard_tabulate.data.frame <- function(data,
     dplyr::mutate(context = "tabulate") |>
     tidy_ard_column_order() |>
     tidy_ard_row_order() |>
-    as_card()
+    as_card(check = FALSE)
 }
 
 

R/ard_tabulate_value.R

@@ -70,7 +70,7 @@ ard_tabulate_value.data.frame <- function(data,
 
   # return empty ARD if no variables selected ----------------------------------
   if (is_empty(variables)) {
-    return(dplyr::tibble() |> as_card())
+    return(dplyr::tibble() |> as_card(check = FALSE))
   }
 
   # calculate summary statistics -----------------------------------------------

R/as_card.R

@@ -2,9 +2,11 @@
 #'
 #' Convert data frames to ARDs of class 'card'.
 #'
+#'
 #' @param x (`data.frame`)\cr
 #'   a data frame
-#'
+#' @param check (scalar `logical`)\cr
+#'   Whether the input data frame should be checked for standard ARD features
 #' @return an ARD data frame of class 'card'
 #' @export
 #'
@@ -14,17 +16,36 @@
 #'   stat_label = c("N", "Mean"),
 #'   stat = c(10, 0.5)
 #' ) |>
+#'   as_card(check = FALSE)
+#' dplyr::tibble(
+#'   variable = "AGE",
+#'   stat_name = c("N", "mean"),
+#'   stat_label = c("N", "Mean"),
+#'   stat = list(10, 0.5),
+#'   fmt_fun = replicate(2, list()),
+#'   warning = replicate(2, list()),
+#'   error = replicate(2, list())
+#' ) |>
 #'   as_card()
-as_card <- function(x) {
+as_card <- function(x, check = TRUE) {
   set_cli_abort_call()
 
   # check in inputs ------------------------------------------------------------
   check_class(x, cls = "data.frame")
+  check_scalar_logical(check)
 
   # convert to class "card" ----------------------------------------------------
   if (inherits(x, "card")) {
-    x
+    out <- x
   } else {
-    structure(x, class = c("card", class(x)))
+    out <- structure(x, class = c("card", class(x)))
+  }
+  if (check) {
+    check_ard_structure(out,
+      column_order = FALSE, method = FALSE,
+      error_on_fail = TRUE
+    )
   }
+
+  out
 }

R/bind_ard.R

@@ -99,5 +99,5 @@ bind_ard <- function(..., .distinct = TRUE, .update = FALSE, .order = FALSE, .qu
   }
 
   # return stacked ARDs --------------------------------------------------------
-  tidy_ard_column_order(data) |> as_card()
+  tidy_ard_column_order(data) |> as_card(check = FALSE)
 }