Version0.0.5

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: syntheval
 Title: A set of tools for evaluating synthetic data utility and disclosure risk
-Version: 0.0.4
+Version: 0.0.5
 Authors@R: c(
     person(given = "Aaron R.", 
            family = "Williams", 
@@ -22,9 +22,10 @@ License: AGPL (>= 3)
 BugReports: https://github.com/UI-Research/syntheval/issues
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.2
+RoxygenNote: 8.0.0
 Suggests: 
     forcats,
+    glmnet,
     stringr,
     testthat (>= 3.0.0)
 Config/testthat/edition: 3

NAMESPACE

@@ -30,9 +30,7 @@ export(util_ks_distance)
 export(util_moments)
 export(util_percentiles)
 export(util_proportions)
-export(util_tails)
 export(util_totals)
-export(weighted_skewness)
 importFrom(magrittr,"%>%")
 importFrom(rlang,":=")
 importFrom(rlang,.data)

NEWS.md

@@ -1,3 +1,9 @@
+# syntheval 0.0.5
+
+* Remove `util_tails()`
+* Update deprecated dplyr code. 
+* Move all functions to use `eval_data` (#106).
+
 # syntheval 0.0.4
 
 * Add empirical disclosure risk metrics.

R/co_occurence.R → R/co_occurrence.R

@@ -11,9 +11,9 @@ co_occurrence <- function(data, na.rm = FALSE) {
   data_names <- names(data)
 
   # create a p by p matrix
-  co_occurence_matrix <- matrix(nrow = ncol(data), ncol = ncol(data))
-  rownames(co_occurence_matrix) <- data_names
-  colnames(co_occurence_matrix) <- data_names
+  co_occurrence_matrix <- matrix(nrow = ncol(data), ncol = ncol(data))
+  rownames(co_occurrence_matrix) <- data_names
+  colnames(co_occurrence_matrix) <- data_names
 
   # iterate through the variables and assign the co-occurrences
   for (row_name in data_names) {
@@ -32,13 +32,13 @@ co_occurrence <- function(data, na.rm = FALSE) {
 
       } 
 
-      co_occurence_matrix[row_name, col_name] <- 
+      co_occurrence_matrix[row_name, col_name] <- 
         mean(row_var != 0 & col_var != 0)
 
     }
 
   }
 
-  return(co_occurence_matrix)
+  return(co_occurrence_matrix)
 
 }

R/discrimination.R

@@ -1,25 +1,29 @@
 #' Combine synthetic data and data for a discriminant based metric
 #'
-#' @param postsynth A postsynth object from tidysynthesis or a tibble
-#' @param data an original (observed) data set.
+#' @param eval_data An `eval_data` object.
 #'
 #' @return A list of class discrimination
 #' 
 #' @family Utility metrics
 #' 
 #' @export
 #'
-discrimination <- function(postsynth, data) {
+discrimination <- function(eval_data) {
 
-  if (is_postsynth(postsynth)) {
+  stopifnot(is_eval_data(eval_data)) 
+
+  if (eval_data$n_rep > 1 ) {
 
-    synthetic_data <- postsynth$synthetic_data
+    synthetic_data <- eval_data[["synth_data"]][[1]]
+    message("Creating discriminator object using 1 synthetic data replicate.")
 
   } else {
 
-    synthetic_data <- postsynth
+    synthetic_data <- eval_data[["synth_data"]]
 
   }
+  data <- eval_data[["conf_data"]]
+
 
   mismatched_variables <- c(
     setdiff(names(synthetic_data), names(data)),

R/eval_data.R

@@ -4,12 +4,19 @@
 #' @param synth_data A single (or list of) dataframe(s) or `postsynth` object(s).
 #' @param holdout_data An optional holdout dataframe containing the same columns
 #' as the confidential dataframe
+#' @param synth_vars An optional list of variables synthesized (if not using 
+#' full synthesis). If `synth_data` uses `postsynth` object(s), then these
+#' are inherited from `jth_synthesis_time`.
 #'
 #' @return An `eval_data` object.
 #' 
 #' @export
 #'
-eval_data <- function(conf_data, synth_data, holdout_data = NULL) {
+eval_data <- function(
+    conf_data, 
+    synth_data, 
+    holdout_data = NULL,
+    synth_vars = NULL) {
 
   stopifnot(inherits(conf_data, "data.frame"))
 
@@ -23,7 +30,12 @@ eval_data <- function(conf_data, synth_data, holdout_data = NULL) {
   # single replicate logic
   if (is_postsynth(synth_data)) {
 
+    synth_vars <- synth_data[["jth_synthesis_time"]] %>% 
+      dplyr::pull("variable") %>%
+      levels()
+
     synth_data <- synth_data[["synthetic_data"]]
+
     n_rep <- 1
 
   } else if (inherits(synth_data, "data.frame")) {
@@ -48,6 +60,10 @@ eval_data <- function(conf_data, synth_data, holdout_data = NULL) {
           )
         )
 
+      synth_vars <- synth_data[[1]][["jth_synthesis_time"]] %>% 
+        dplyr::pull("variable") %>%
+        levels()
+
       synth_data <- purrr::map(
         .x = synth_data,
         .f = ~ .x[["synthetic_data"]]
@@ -72,7 +88,8 @@ eval_data <- function(conf_data, synth_data, holdout_data = NULL) {
     conf_data = conf_data, 
     synth_data = synth_data,
     holdout_data = holdout_data,
-    n_rep = n_rep
+    n_rep = n_rep,
+    synth_vars = synth_vars
   )
 
   eval_data <- structure(eval_data, class = "eval_data")
@@ -93,6 +110,7 @@ is_eval_data <- function(x) {
   inherits(x, "eval_data")
 }
 
+
 #' @export
 print.eval_data <- function(x, ...) {
 

R/util_ci_overlap.R

@@ -1,7 +1,7 @@
-#' Regression confidence interval overlap
+#' Regression confidence interval overlap for one synthetic data replicate
 #'
-#' @param postsynth A postsynth object or tibble with synthetic data
-#' @param data A data frame with the original data
+#' @param synth_data A data.frame with synthetic data
+#' @param conf_data A data.frame with the confidential data
 #' @param formula A formula for a linear regression model
 #'
 #' @return A list of two dataframes:
@@ -21,37 +21,14 @@
 #'     synthetic) listing parameter estimates, standard errors, test statistics,
 #'     p-values for null hypothesis tests, and 95% confidence interval bounds.
 #' 
-#' @examples
-#' conf_data <- mtcars
-#' synth_data <- mtcars %>% 
-#'    dplyr::slice_sample(n = nrow(mtcars) / 2)
-#' 
-#' util_ci_overlap(
-#'   conf_data,
-#'   synth_data,
-#'   mpg ~ disp + vs + am
-#' )
-#' 
-#' @family Utility metrics
-#' 
-#' @export
-util_ci_overlap <- function(postsynth, data, formula) {
+.util_ci_overlap <- function(synth_data, conf_data, formula) {
 
-  if (is_postsynth(postsynth)) {
-
-    synthetic_data <- postsynth$synthetic_data
-
-  } else {
-
-    synthetic_data <- postsynth
-
-  }
 
   # original model ------------------------------------------------------
-  lm_original <- stats::lm(formula = formula, data = data)
+  lm_original <- stats::lm(formula = formula, data = conf_data)
 
   # synthetic model ---------------------------------------------------------
-  lm_synth <- stats::lm(formula = formula, data = synthetic_data)
+  lm_synth <- stats::lm(formula = formula, data = synth_data)
 
   coefficients <- dplyr::bind_rows(
     `original` = broom::tidy(lm_original, conf.int = TRUE),
@@ -100,3 +77,76 @@ util_ci_overlap <- function(postsynth, data, formula) {
   )
 
 }
+
+#' Regression confidence interval overlap
+#'
+#' @param eval_data An `eval_data` object
+#' @param formula A formula for a linear regression model
+#'
+#' @return A list of two dataframes (one per each synthetic data replicate):
+#'   * `ci_overlap`: one row per model parameter with utility metrics.
+#'     * `overlap `: symmetric overlap metric, calculated as the average of the 
+#'       interval overlap contained in the synthetic confidence interval and the 
+#'       interval overlap contained in the confidential confidence interval.
+#'     * `coef_diff`: synthetic parameter estimate - confidential parameter estimate
+#'     * `std_coef_diff`: `coef_diff` divided by the standard error for the confidential data.
+#'     * `sign_match`: boolean if the synthetic and confidential parameter estimates have the same sign.
+#'     * `significance_match`: boolean if the null hypothesis test where the 
+#'       parameter is 0 has p-value less than .05 agrees in both confidential and
+#'       synthetic data.
+#'     * `ss`: boolean if both `sign_match` and `significance_match` are true.
+#'     * `sso`: boolean if `sign_match` is true and `overlap` is positive. 
+#'   * `coef_diff`: one row per model parameter and data source (confidential or 
+#'     synthetic) listing parameter estimates, standard errors, test statistics,
+#'     p-values for null hypothesis tests, and 95% confidence interval bounds.
+#' 
+#' @family Utility metrics
+#' 
+#' @examples
+#' conf_data <- mtcars
+#' synth_data <- mtcars %>% 
+#'    dplyr::slice_sample(n = nrow(mtcars) / 2)
+#'  
+#' eval_data <- eval_data(conf_data, synth_data)
+#' 
+#' util_ci_overlap(
+#'   eval_data,
+#'   mpg ~ disp + vs + am
+#' )
+#' 
+#' @export
+#' 
+util_ci_overlap <- function(eval_data, formula) {
+
+  stopifnot(is_eval_data(eval_data))
+
+  if (eval_data$n_rep == 1) {
+
+    return(
+      .util_ci_overlap(
+        conf_data = eval_data$conf_data, 
+        synth_data = eval_data$synth_data, 
+        formula = formula
+      )
+    )
+
+  } else {
+
+    result <- purrr::map(
+      .x = eval_data$synth_data,
+      .f = \(sd) {
+
+        .util_ci_overlap(
+          conf_data = eval_data$conf_data, 
+          synth_data = sd, 
+          formula = formula
+        )
+
+      }
+    )
+
+    return(result)
+
+  }
+
+}