Add check for degrees of freedom to sdc_model() (#87)

NAMESPACE

@@ -1,6 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
 S3method(print,sdc_descriptives)
+S3method(print,sdc_dfs)
 S3method(print,sdc_distinct_ids)
 S3method(print,sdc_dominance)
 S3method(print,sdc_min_max)
@@ -13,6 +14,7 @@ export(sdc_min_max)
 export(sdc_model)
 import(mathjaxr)
 importFrom(broom,augment)
+importFrom(broom,glance)
 importFrom(broom,tidy)
 importFrom(checkmate,assert_character)
 importFrom(checkmate,assert_data_frame)

R/print_methods.R

@@ -66,6 +66,19 @@ print.sdc_dominance <- function(x, ...) {
 
 }
 
+#' @importFrom cli cli_alert_danger cli_alert_success
+#' @export
+print.sdc_dfs <- function(x, ...) {
+    # with problems
+    if (x <= getOption("sdc.n_df", 10L)) {
+        cli::cli_alert_danger("Not enough degrees of freedom: {x}")
+
+        # withOUT problems
+    } else if (getOption("sdc.info_level", 1L) > 1L) {
+        cli::cli_alert_success("No problem with degrees of freedom ({x}).")
+    }
+}
+
 
 #' @importFrom cli cli_text style_bold
 #' @export
@@ -127,6 +140,7 @@ print.sdc_model <- function(x, ...) {
     print(x[["settings"]])
 
     print(x[["distinct_ids"]])
+    print(x[["dfs"]])
     if (getOption("sdc.info_level", 1L) <= 1L) {
         print_fun <- conditional_print
     } else {

R/sdc_model.R

@@ -10,7 +10,7 @@
 #'
 #' @importFrom data.table is.data.table as.data.table fsetequal rbindlist :=
 #'   %flike% set
-#' @importFrom broom augment tidy
+#' @importFrom broom augment tidy glance
 #' @importFrom stats model.frame na.omit
 #' @importFrom checkmate assert_data_frame assert_string
 #'
@@ -93,6 +93,19 @@ sdc_model <- function(data, model, id_var = getOption("sdc.id_var"), fill_id_var
       )
   }
 
+  # check degrees of freedom ----
+  dfs <- structure(
+      broom::glance(model)[["df.residual"]],
+      class = c("sdc_dfs", "integer")
+  )
+  if (dfs <= getOption("sdc.n_df", 10L)) {
+      cli::cli_warn(paste(
+          cli::style_bold("DISCLOSURE PROBLEM:"),
+          "Not enough degrees of freedom."
+      ))
+  }
+
+
   model_dt <- stats::na.omit(data[, c(id_var, model_vars), with = FALSE])
 
 
@@ -201,6 +214,7 @@ sdc_model <- function(data, model, id_var = getOption("sdc.id_var"), fill_id_var
       options = list_options(),
       settings = list_arguments(id_var = id_var, fill_id_var = fill_id_var),
       distinct_ids = distinct_ids,
+      dfs = dfs,
       terms = term_list
     ),
     class = c("sdc_model", "list")