inst/doc/sim_design.R

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

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

## ----plot-sim-design, fig.width = 8, fig.height = 4---------------------------
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
)
df <- sim_design(within, between, 
                 n = 100, mu = mu, sd = 5, r = .5,
                 empirical = TRUE, plot = TRUE)

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

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

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

## -----------------------------------------------------------------------------
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)

## -----------------------------------------------------------------------------
design <- check_design(within, between, n = 10, 
                       mu = 1:4, sd = 1:4, r = 0.5, plot = FALSE)

json_design(design, pretty = TRUE)

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

## -----------------------------------------------------------------------------
n <- list(
  B1_C1 = 10, 
  B1_C2 = 20, 
  B2_C1 = 30, 
  B2_C2 = 40
)
design <- check_design(2, c(2,2), n = n, plot = FALSE)
str(design$n)

## -----------------------------------------------------------------------------
n <- data.frame(
  B2_C2 = 40,
  B1_C1 = 10, 
  B1_C2 = 20, 
  B2_C1 = 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("B1_C1", "B1_C2", "B2_C1", "B2_C2"))
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(
  B1 = c(.10, .20, .30, 
              .40, .50, 
                   .60),
  B2 = 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

## -----------------------------------------------------------------------------
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"), long = TRUE)

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

## ---- fig.width = 5, fig.height = 5-------------------------------------------
plot_design(df)

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

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

Try the faux package in your browser

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

faux documentation built on Aug. 19, 2020, 5:07 p.m.