Added labels to data frames created with sim_design

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: faux
 Title: Simulation for Factorial Designs
-Version: 1.2.3.9000
-Date: 2025-09-25
+Version: 1.2.3.9001
+Date: 2025-10-20
 Authors@R: c(
     person(
         given = "Lisa", 

NEWS.md

@@ -1,5 +1,7 @@
 # faux (development version)
 
+* Data frames created with `sim_design()` now have column labels that can be used by ggplot2 4.0 for figure labels.
+
 # faux 1.2.3 (2025-09-25)
 
 * Fixed failing tests due to ggplot2 4.0 ggplot object structure changes

R/long2wide.R

@@ -58,6 +58,7 @@ long2wide <- function(data, within = c(), between = c(), dv = "y", id = "id", se
   }
   class(d1) <- c("faux", "data.frame")
   rownames(d1) <- NULL
+  d1 <- add_labels(d1)
 
   d1
 }

R/sim_design.R

@@ -213,14 +213,15 @@ sim_data <- function(design, empirical = FALSE,
   }
 
   class(df_return) <- c("faux", "data.frame")
+  rownames(df_return) <- c() # get rid of row names
 
   if (rep == 1) {
     df_return$.rep. <- NULL
   } else if (isTRUE(nested)) {
     # nest reps
     df_rep <- by(df_return, df_return$.rep., function(x) {
       x$.rep. <- NULL
-      x
+      add_labels(x, design)
     })
     df_return <- data.frame(rep = 1:rep)
     df_return$data <- df_rep # can't assign list in data.frame
@@ -230,6 +231,68 @@ sim_data <- function(design, empirical = FALSE,
     df_return <- df_return[order(df_return$rep),] 
   }
 
-  rownames(df_return) <- c() # get rid of row names
+  df_return <- add_labels(df_return, design) # add column labels
+
   return(df_return)
 }
+
+
+#' Add Labels to Data Tables
+#'
+#' @param data a data table
+#' @param design a design specification (if NULL, is read from data)
+#'
+#' @returns a data frame with labelled columns
+#' @keywords internal
+add_labels <- function(data, design = NULL) {
+  if ("design" %in% names(attributes(data))) {
+    # get parameters from design
+    design <- get_design(data)
+  } 
+
+  if (is.null(design)) return(data)
+
+  # nested
+  if ("rep" %in% names(data)) 
+    attr(data$rep, "label") <- "replicate index"
+
+  if ("data" %in% names(data)) {
+    data$data <- lapply(data$data, add_labels, design = design)
+    attr(data$data, "label") <- "data"
+
+    return(data)
+  }
+
+  # id column
+  id <- names(design$id)
+  attr(data[[id]], "label") <- design$id[[1]]
+
+  # dv / within
+  dv <- names(design$dv)
+  if (dv %in% names(data)) {
+    attr(data[[dv]], "label") <- design$dv[[1]]
+
+    # long within
+    for (w in names(design$within)) {
+      attr(data[[w]], "label") <- design$vardesc[[w]]
+    }
+  } else if (length(design$within)) {  # wide within
+    exp <- expand.grid(rev(design$within))
+    w_labels <- apply(exp, 1, function(x) { 
+      paste(rev(x), collapse = ":") 
+    })
+    within_cols <- cell_combos(design$within, sep = design$sep) 
+    names(w_labels) <- within_cols
+
+    for (nm in within_cols) {
+      attr(data[[nm]], "label") <- w_labels[[nm]]
+    }
+  }
+
+  # between
+  for (b in names(design$between)) {
+    attr(data[[b]], "label") <- design$vardesc[[b]]
+  }
+
+  return(data)
+}

R/wide2long.R

@@ -65,6 +65,7 @@ wide2long <- function(data, within_factors = c(), within_cols = c(),
   attributes(longdat)$design <- design
   class(longdat) <- c("faux", "data.frame")
   rownames(longdat) <- NULL
+  longdat <- add_labels(longdat)
 
   longdat
 }

tests/testthat/test-add_labels.R

@@ -0,0 +1,144 @@
+test_that("sim_design", {  
+  between <- list(
+    B = c(B1 = "Level 1B", B2 = "Level 2B")
+  )
+  within <- list(
+    W = c(W1 = "Level 1W", W2 = "Level 2W")
+  )
+
+  vardesc <- list(B = "Between-Subject Factor",
+                  W = "Within-Subject Factor")
+
+  # wide ----
+  dat <- sim_design(within, between, vardesc = vardesc, plot = FALSE)
+  design <- get_design(dat)
+  expect_mapequal(design$vardesc, vardesc)
+
+  obsID <- attr(dat$id, "label")
+  expect_equal(obsID, "id")
+
+  obsB <- attr(dat$B, "label")
+  expect_equal(obsB, vardesc$B)
+
+  obsW1 <- attr(dat$W1, "label")
+  expect_equal(obsW1, within$W[['W1']])
+
+  obsW2 <- attr(dat$W2, "label")
+  expect_equal(obsW2, within$W[['W2']])
+
+  # long ----
+  dat <- sim_design(within, between, 
+                    vardesc = vardesc, 
+                    long = TRUE, plot = FALSE)
+  design <- get_design(dat)
+  expect_mapequal(design$vardesc, vardesc)
+
+  obsID <- attr(dat$id, "label")
+  expect_equal(obsID, "id")
+
+  obsY <- attr(dat$y, "label")
+  expect_equal(obsY, "value")
+
+  obsB <- attr(dat$B, "label")
+  expect_equal(obsB, vardesc$B)
+
+  obsW <- attr(dat$W, "label")
+  expect_equal(obsW, vardesc$W)
+})
+
+test_that("sim_design wide 2-within", {  
+  within <- list(
+    A = c(A1 = "Level 1A", A2 = "Level 2A"),
+    B = c(B1 = "Level 1B", B2 = "Level 2B")
+  )
+
+  vardesc <- list(A = "First Factor",
+                  B = "Second Factor")
+
+  dat <- sim_design(within, vardesc = vardesc, plot = FALSE)
+
+  obsID <- attr(dat$id, "label")
+  expect_equal(obsID, "id")
+
+  obs <- attr(dat$A1_B1, "label")
+  expect_equal(obs, "Level 1A:Level 1B")
+
+  obs <- attr(dat$A1_B2, "label")
+  expect_equal(obs, "Level 1A:Level 2B")
+
+  obs <- attr(dat$A2_B1, "label")
+  expect_equal(obs, "Level 2A:Level 1B")
+
+  obs <- attr(dat$A2_B2, "label")
+  expect_equal(obs, "Level 2A:Level 2B")
+})
+
+test_that("sim_design no within", {  
+  dat <- sim_design(id = c(stim_id = "Stimulus ID"),
+                    dv = c(age = "Age"), 
+                    plot = FALSE)
+
+  obsID <- attr(dat$stim_id, "label")
+  expect_equal(obsID, "Stimulus ID")
+
+  obsY <- attr(dat$age, "label")
+  expect_equal(obsY, "Age")
+})
+
+test_that("sim_design rep", {  
+  # nested ----
+  dat <- sim_design(n = 20, rep = 2, plot = FALSE)
+
+  obsID <- attr(dat$data[[1]]$id, "label")
+  expect_equal(obsID, "id")
+
+  obsY <- attr(dat$data[[1]]$y, "label")
+  expect_equal(obsY, "value")
+
+  expect_equal(attr(dat$data, "label"), "data")
+  expect_equal(attr(dat$rep, "label"), "replicate index")
+
+  # unnested ----
+  dat <- sim_design(n = 20, rep = 2, nested = FALSE, plot = FALSE)
+
+  expect_equal(attr(dat$id,  "label"), "id")
+  expect_equal(attr(dat$y,   "label"), "value")
+  expect_equal(attr(dat$rep, "label"), "replicate index")
+})
+
+test_that("long2wide/wide2long", {
+  between <- list(
+    B = c(B1 = "Level 1B", B2 = "Level 2B")
+  )
+  within <- list(
+    W = c(W1 = "Level 1W", W2 = "Level 2W")
+  )
+  vardesc <- list(B = "Between-Subject Factor",
+                  W = "Within-Subject Factor")
+
+  # wide2long
+  dat_w <- sim_design(within, between, vardesc = vardesc, 
+                      long = FALSE, plot = FALSE)
+  l <- wide2long(dat_w)
+
+  obsB <- attr(l$B, "label")
+  expect_equal(obsB, vardesc$B)
+
+  obsW <- attr(l$W, "label")
+  expect_equal(obsW, vardesc$W)
+
+  # long2wide
+  dat_l <- sim_design(within, between, vardesc = vardesc, 
+                      long = TRUE, plot = FALSE)
+  w <- long2wide(dat_l)
+
+  obsB <- attr(w$B, "label")
+  expect_equal(obsB, vardesc$B)
+
+  obsW1 <- attr(w$W1, "label")
+  expect_equal(obsW1, within$W[['W1']])
+
+  obsW2 <- attr(w$W2, "label")
+  expect_equal(obsW2, within$W[['W2']])
+
+})

tests/testthat/test-long2wide.R

@@ -132,4 +132,5 @@ test_that("from design", {
   expect_equal(names(dwide2), c("rater_id", "rater_sex", "black", "east_asian", "west_asian", "white"))
 })
 
+
 faux_options(plot = TRUE)

tests/testthat/test-norta.R

@@ -52,7 +52,7 @@ test_that("fh_bounds", {
 })
 
 test_that("fh_bounds variation check", {
-  skip("long checking function")
+  skip("long simulation")
 
   x <- lapply(1:50, function(x) {
     fh_bounds("pois", "binom",  

tests/testthat/test-sim_design.R

@@ -596,7 +596,7 @@ test_that("unnested reps", {
   n <- 10
   df <- sim_design(2, n = n, rep = rep, nested = FALSE, plot = FALSE)
   expect_equal(nrow(df), rep*n)
-  expect_equal(df$rep, rep(1:rep, each = n))
+  expect_equivalent(df$rep, rep(1:rep, each = n), )
 })
 
 # empirical ----
@@ -706,7 +706,7 @@ test_that("vardesc", {
   )
 
   vardesc <- list(B = "Between-Subject Factor",
-                       W = "Within-Subject Factor")
+                  W = "Within-Subject Factor")
 
   expect_silent(dat <- sim_design(within, between, vardesc = vardesc))
   design <- get_design(dat)