inst/doc/sim_design.R In faux: Simulation for Factorial Designs

```## ----setup, include = FALSE---------------------------------------------------
knitr::opts_chunk\$set(
collapse = TRUE,
comment = "#>",
out.width = "100%"
)
ggplot2::theme_set(ggplot2::theme_bw())
set.seed(8675309)

## ---- warning=FALSE, message=FALSE--------------------------------------------
library(faux)

## ----plot-sim-design----------------------------------------------------------
between <- list(pet = c(cat = "Cat Owners",
dog = "Dog Owners"))
within <- list(time = c("morning", "noon", "evening", "night"))
mu <- data.frame(
cat    = c(10, 12, 14, 16),
dog    = c(10, 15, 20, 25),
row.names = within\$time
)
# add factor labels for plotting
vardesc <- c(pet = "Type of Pet",
time = "Time of Day")

df <- sim_design(within, between,
n = 100, mu = mu, sd = 5, r = .5,
empirical = TRUE, vardesc = vardesc, plot = TRUE)

## ----anon---------------------------------------------------------------------
df <- sim_design(within = c(2,3), between = c(2),
n = 10, mu = 1:12, sd = 1, r = 0.5)

## ----vlist--------------------------------------------------------------------
between <- list(
pet = c("cat", "dog")
)
within <- list(
time = c("day", "night")
)

df <- sim_design(within, between, mu = 1:4)

## -----------------------------------------------------------------------------
faux_options(sep = ".")

sim_design(within, n = 5, plot = FALSE)

## -----------------------------------------------------------------------------
# put the separator back to _ for the rest of this vignette
faux_options(sep = "_")

## ----named-vectors------------------------------------------------------------
between <- list(
pet = c(cat = "Is a cat person", dog = "Is a dog person")
)
within <- list(
time = c(day = "Tested during the day", night = "Tested at night")
)
df <- sim_design(within, between, mu = 1:4)

## -----------------------------------------------------------------------------
vardesc <- c(pet = "Type of Pet",
time = "Time of Day")

df <- sim_design(within, between, mu = 1:4,
id = c(pet_id = "Pet ID"),
dv = c(score = "Score on the Test"),
vardesc = vardesc)

## -----------------------------------------------------------------------------

## -----------------------------------------------------------------------------
n <- 20 # n per cell, not total
design <- check_design(2, c(2,2), n = n, plot = FALSE)
str(design\$n)

## -----------------------------------------------------------------------------
n <- list(
B1a_B2a = 10,
B1a_B2b = 20,
B1b_B2a = 30,
B1b_B2b = 40
)
design <- check_design(2, c(2,2), n = n, plot = FALSE)
str(design\$n)

## -----------------------------------------------------------------------------
n <- data.frame(
B1b_B2b = 40,
B1a_B2a = 10,
B1a_B2b = 20,
B1b_B2a = 30
)
design <- check_design(2, c(2,2), n = n, plot = FALSE)
str(design\$n)

## -----------------------------------------------------------------------------
n <- data.frame(n = c(10, 20, 30, 40),
row.names = c("B1a_B2a", "B1a_B2b", "B1b_B2a", "B1b_B2b"))
design <- check_design(2, c(2,2), n = n, plot = FALSE)
str(design\$n)

## -----------------------------------------------------------------------------
between <- list(pet       = c("cat", "dog"),
condition = c("A",   "B"))
within  <- list(time      = c("day", "night"))
mu <- c(10, 20, 30, 40, 50, 60, 70, 80)
design <- check_design(within, between, mu = mu, plot = FALSE)
str(design\$mu)

## -----------------------------------------------------------------------------
mu <- list(
cat_B = c(night = 40, day = 30),
cat_A = c(day = 10, night = 20),
dog_A = c(day = 50, night = 60),
dog_B = c(day = 70, night = 80)
)
design <- check_design(within, between, mu = mu, sd = 1, plot = FALSE)
str(design\$mu)

## -----------------------------------------------------------------------------
mu <- data.frame(
cat_A = c(10, 20),
cat_B = c(30, 40),
dog_A = c(50, 60),
dog_B = c(70, 80),
row.names = c("day", "night")
)
design <- check_design(within, between, mu = mu, plot = FALSE)
str(design\$mu)

## -----------------------------------------------------------------------------
mu <- data.frame(
day = c(10, 30, 50, 70),
night = c(20, 40, 60, 80),
row.names = c("cat_A", "cat_B", "dog_A", "dog_B")
)
design <- check_design(within, between, mu = mu, plot = FALSE)
str(design\$mu)

## -----------------------------------------------------------------------------
r <- list(
cat_A = .5,
cat_B = .5,
dog_A = .6,
dog_B = .4
)
design <- check_design(within, between, r = r, plot = FALSE)
design\$r

## -----------------------------------------------------------------------------
r <- list(
B1a = c(.10, .20, .30,
.40, .50,
.60),
B1b = c(.15, .25, .35,
.45, .55,
.65)
)
design <- check_design(4, 2, r = r, plot = FALSE)
design\$r

## -----------------------------------------------------------------------------
within <- list(cars = c("speed", "dist"))
between <- list(half = c("first", "last"))
r <- list(
first = cor(cars[1:25,]),
last = cor(cars[26:50,])
)

design <- check_design(within, between, r = r, plot = FALSE)
design\$r

## ----empirical----------------------------------------------------------------
between <- list(pet  = c("cat", "dog"))
within  <- list(time = c("day", "night"))
mu <- list(
cat = c(day = 10, night = 20),
dog = c(day = 30, night = 40)
)

sd <- list(
cat = c(day = 5, night = 10),
dog = c(day = 15, night = 20)
)

r <- list(cat = .5, dog = .6)

df <- sim_design(within, between, n = 100,
mu = mu, sd = sd, r = r,
empirical = TRUE)

## -----------------------------------------------------------------------------
within <- list(
condition = c(con = "Mean of congruent trials",
inc = "Mean of incongruent trials"),
version = c(easy = "Easy",
med  = "Medium",
hard = "Difficult")
)

between <- list(
experience = c(novice = "Novice", expert = "Expert"),
time = c(day = "Before 5pm", night = "After 5pm")
)

mu <- data.frame(
row.names = c("con_easy", "con_med", "con_hard",
"inc_easy", "inc_med",  "inc_hard"),
novice_day = 10:15,
novice_night = 11:16,
expert_day = 9:14,
expert_night = 10:15
)

## -----------------------------------------------------------------------------
r <- list(
novice_day = 0.3,
novice_night = 0.2,
expert_day = 0.5,
expert_night = 0.4
)

## -----------------------------------------------------------------------------
# upper right triangle correlation specification
# inc and con have r = 0.5 within each difficultly level, 0.2 otherwise
#          ce,  ie,  cm,  im,  ch,  ih
triangle <-  c(0.5, 0.2, 0.2, 0.2, 0.2, #con_easy
0.2, 0.2, 0.2, 0.2, #inc_easy
0.5, 0.2, 0.2, #con_med
0.2, 0.2, #inc_med
0.5) #con_hard
#inc_hard

r <- list(
novice_day = triangle,
novice_night = triangle,
expert_day = triangle,
expert_night = triangle
)

## -----------------------------------------------------------------------------
df <- sim_design(within, between, n = 100,
mu = mu, sd = 2, r = r,
dv = c(rt = "Reaction Time"),
plot = FALSE, long = TRUE)

## -----------------------------------------------------------------------------
df <- sim_design(within = 2, between = 2,
n = 50, mu = c(1, 1, 1, 1.5),
sd = 1, r = 0.5, plot = FALSE,
long = TRUE, rep = 5)

df

## -----------------------------------------------------------------------------
# using tidyverse functions
analyse <- function(data) {
stats::aov(y ~ B1 * W1 + Error(id/W1), data = data) %>%
broom::tidy()
}

df %>%
dplyr::mutate(analysis = lapply(data, analyse)) %>%
dplyr::select(-data) %>%
tidyr::unnest(analysis)

## -----------------------------------------------------------------------------
df <- sim_design(within = 2, between = 2,
n = 2, mu = c(1, 1, 1, 1.5),
sd = 1, r = 0.5, plot = FALSE,
long = TRUE, rep = 2, nested = FALSE)

df

## ---- results='asis'----------------------------------------------------------
between <- list(pet = c("cat", "dog"))
within <- list(time = c("day", "night"))
vardesc <- c(pet = "Type of Pet",
time = "Time of Day")
design <- check_design(within, between, n = 10,
mu = 1:4, sd = 1:4, r = 0.5,
vardesc = vardesc, plot = FALSE)

design

## -----------------------------------------------------------------------------
data <- sim_design(design = design)
```

Try the faux package in your browser

Any scripts or data that you put into this service are public.

faux documentation built on Sept. 14, 2021, 1:08 a.m.