This is part two of a DeclareDesign tutorial series. You can find part 1 here.
DesignLibrary is a online repository of ready-made designs for experimental simulating using DeclareDesign. It is basically DeclareDesign with training wheels, which makes it a great jumping off point if you already know what type of experimental design you want to use. It also has really great documentation! I’ve found it especially useful if you want to plan or replicate a simple design. You can find a full list of the designs here. Here are a few designs I selected arbitrarily:
binary_iv_designerblock_cluster_two_arm_designercluster_sampling_designermediation_analysis_designerpretest_posttest_designerrandomized_response_designertwo_by_two_designerHere they we are interested in replicating the results from the famous Brescoll & Uhlmann, 2008 on gender, emotion, and status conferrel (the amount of status you think someone deserves to have).
The high level summary of this study is that men who get angry in the workplace are conferred more status than men who get sad in the workplace. This is kind of intuitive, right? People who get angry in the workplace are like bosses of course they’re high status! However, this study found that when women get angry in the workplace they are conferred less status compared to sad women.
This sets us up for a 2 (gender: male, female) x 2 (emotion: anger sadness) study design where:
| 0 | 1 | ||
|---|---|---|---|
| B | 0 | male anger | male sadness |
| 1 | female anger | female sadness |
To fill the above tables with numbers, we can take the results directly from Brescoll & Uhlmann, 2008 where they report their findings in Table 1 on page 270. We can plug their findings for status conferral directly into our table.
| 0 | 1 | ||
|---|---|---|---|
| B | 0 | 6.47 | 4.05 |
| 1 | 3.75 | 5.02 |
Now we can begin to start thinking about simulation! Here we plug-in the above table into the two_by_two_designer function from DesignLibrary, and uhh that’s basically it! A lot easier than DeclareDesign right? We can learn more about the arguments for two_by_two_designer by using ?two_by_two_designer
library(tidyverse)
library(DesignLibrary)
library(DeclareDesign)
brescoll_uhlmann <-
two_by_two_designer(mean_A0B0 = 6.47, # equivalent to 'outcome_means = c(6.47, 3.75, 4.05, 5.02)'
mean_A0B1 = 3.75,
mean_A1B0 = 4.05,
mean_A1B1 = 5.02,
outcome_sds = c(2.25, 1.77, 1.61, 1.8))
The next goal is explore the right N for our design. We can use the above brescoll_uhlmann together with redesign function to evaluate the design with different N’s. I could’ve done more granular increments of 50, but I use 100 to help lower compiling time.
brescoll_uhlmann_sims <-
brescoll_uhlmann %>%
redesign(N = seq(100, 2000, by = 100)) %>% # from 100 to 2000 in increments of 100
diagnose_design() %>%
get_diagnosands()
Alternatively we can use the more elegant and generalized approach with expand_design and the two_by_two_designer base function. This is recommended by the folks at DeclareDesign because it is considered safer code to run.
brescoll_uhlmann_sims <-
two_by_two_designer %>%
expand_design(mean_A0B0 = 6.47,
mean_A0B1 = 3.75,
mean_A1B0 = 4.05,
mean_A1B1 = 5.02,
outcome_sds = list(c(2.25, 1.77, 1.61, 1.8)),
N = seq(100, 2000, by = 100)) %>%
diagnose_design() %>%
get_diagnosands()
Here we can take an ugly peek at our data. Each different N we evaluated takes up 3 different rows. A row evaluating the “A”, “B”, “A:B” aka “emotion”, “gender” and the “interaction”. Because we are replicating a previous study, they did not change the means in the assumption.
glimpse(brescoll_uhlmann_sims)
Observations: 60
Variables: 24
$ design_label <chr> "design_1", "design_1", "design_1", "design_…
$ N <dbl> 100, 100, 100, 200, 200, 200, 300, 300, 300,…
$ estimand_label <chr> "ate_A", "ate_B", "interaction", "ate_A", "a…
$ estimator_label <chr> "No_Interaction", "No_Interaction", "Interac…
$ term <chr> "A", "B", "A:B", "A", "B", "A:B", "A", "B", …
$ bias <dbl> -0.0190363867, -0.0056538398, 0.0451473134, …
$ `se(bias)` <dbl> 0.014596484, 0.017010385, 0.032738626, 0.010…
$ rmse <dbl> 0.3779281, 0.3805540, 0.7541199, 0.2603786, …
$ `se(rmse)` <dbl> 0.012729110, 0.012772565, 0.022977813, 0.008…
$ power <dbl> 0.228, 0.492, 0.990, 0.430, 0.756, 1.000, 0.…
$ `se(power)` <dbl> 0.018172284, 0.022759835, 0.004664762, 0.021…
$ coverage <dbl> 0.990, 0.986, 0.974, 0.986, 0.982, 0.964, 0.…
$ `se(coverage)` <dbl> 0.004939390, 0.005572624, 0.006692646, 0.005…
$ mean_estimate <dbl> -0.6058400, -0.8858187, 3.7354927, -0.604670…
$ `se(mean_estimate)` <dbl> 0.016631210, 0.020047839, 0.038163507, 0.012…
$ sd_estimate <dbl> 0.4312540, 0.4298720, 0.8602923, 0.2856536, …
$ `se(sd_estimate)` <dbl> 0.014984936, 0.014688257, 0.024194064, 0.009…
$ mean_se <dbl> 0.4631760, 0.4631760, 0.8454376, 0.3273779, …
$ `se(mean_se)` <dbl> 0.0014485996, 0.0014485996, 0.0026268929, 0.…
$ type_s_rate <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,…
$ `se(type_s_rate)` <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,…
$ mean_estimand <dbl> -0.5868036, -0.8801648, 3.6903453, -0.581334…
$ `se(mean_estimand)` <dbl> 0.008287417, 0.008452199, 0.016137426, 0.005…
$ n_sims <dbl> 500, 500, 500, 500, 500, 500, 500, 500, 500,…
And next we visualize to see when it will be well powered!
brescoll_uhlmann_sims %>%
mutate(estimand_label = case_when(estimand_label == "ate_A" ~ "Emotion",
estimand_label == "ate_B" ~ "Gender",
estimand_label == "interaction" ~ "Emotion x Gender")) %>%
ggplot(aes(N, power,
col = estimand_label,
group = estimand_label,
ymin = power - 1.96*`se(power)`,
ymax = power + 1.96*`se(power)`)) +
geom_smooth(position = "dodge", stat = "identity") +
geom_hline(yintercept = 0.8) +
scale_y_continuous(labels = scales::percent) +
theme_bw()
We see that this design will need about 500 participants to be well-powered or about 125 in each of the four cells. Surprisingly, we see that the interaction is actually the largest effect. Next we’re interested in what N exactly do emotion and gender reach the power the 80% power mark.
brescoll_uhlmann_sims %>%
mutate(estimand_label = case_when(estimand_label == "ate_A" ~ "Emotion",
estimand_label == "ate_B" ~ "Gender",
estimand_label == "interaction" ~ "Emotion x Gender")) %>%
group_by(estimand_label) %>%
filter(power > .8) %>%
filter(N == min(N)) %>%
select(estimand_label, term, N, power, `se(power)`) %>%
kable() %>%
kable_styling(position = "center")
| estimand_label | term | N | power | se(power) |
|---|---|---|---|---|
| Emotion x Gender | A:B | 100 | 0.990 | 0.0046648 |
| Gender | B | 300 | 0.926 | 0.0116498 |
| Emotion | A | 500 | 0.830 | 0.0168127 |
Lastly I wanted to note how you could customize DesignLibrary code for your own designs, let’s say you found a code in DesignLibrary that is almost right for your needs, but not quite. To see the internals in a DesignLibrary function use get_design_code.
In order to take the code for a copy pasting you, can cat(paste(code, collapse = "\n")). This is equivalent to print_table in the blpl package. Note that the ##’s won’t show up in your R console.
twoxtwo_code <-
get_design_code(two_by_two_designer()) # generalized 2x2, note the parenthesis on the inside function
bu_code <- get_design_code(brescoll_uhlmann) # the example we just made
cat(paste(bu_code, collapse = "\n"))
N <- 100
prob_A <- 0.5
prob_B <- 0.5
weight_A <- 0.5
weight_B <- 0.5
mean_A0B0 <- 6.47
mean_A0B1 <- 3.75
mean_A1B0 <- 4.05
mean_A1B1 <- 5.02
sd_i <- 1
outcome_sds <- c(2.25, 1.77, 1.61, 1.8)
population <- declare_population(N, u = rnorm(N, sd = sd_i))
potential_outcomes <- declare_potential_outcomes(Y_A_0_B_0 = mean_A0B0 +
u + rnorm(N, sd = outcome_sds[1]), Y_A_0_B_1 = mean_A0B1 +
u + rnorm(N, sd = outcome_sds[2]), Y_A_1_B_0 = mean_A1B0 +
u + rnorm(N, sd = outcome_sds[3]), Y_A_1_B_1 = mean_A1B1 +
u + rnorm(N, sd = outcome_sds[4]))
estimand_1 <- declare_estimand(ate_A = weight_B * mean(Y_A_1_B_1 -
Y_A_0_B_1) + (1 - weight_B) * mean(Y_A_1_B_0 - Y_A_0_B_0))
estimand_2 <- declare_estimand(ate_B = weight_A * mean(Y_A_1_B_1 -
Y_A_1_B_0) + (1 - weight_A) * mean(Y_A_0_B_1 - Y_A_0_B_0))
estimand_3 <- declare_estimand(interaction = mean((Y_A_1_B_1 -
Y_A_1_B_0) - (Y_A_0_B_1 - Y_A_0_B_0)))
assign_A <- declare_assignment(prob = prob_A, assignment_variable = A)
assign_B <- declare_assignment(prob = prob_B, assignment_variable = B,
blocks = A)
reveal_Y <- declare_reveal(Y_variables = Y, assignment_variables = c(A,
B))
estimator_1 <- declare_estimator(Y ~ A + B, model = lm_robust,
term = c("A", "B"), estimand = c("ate_A", "ate_B"), label = "No_Interaction")
estimator_2 <- declare_estimator(Y ~ A + B + A:B, model = lm_robust,
term = "A:B", estimand = "interaction", label = "Interaction")
two_by_two_design <- population + potential_outcomes + estimand_1 +
estimand_2 + estimand_3 + assign_A + assign_B + reveal_Y +
estimator_1 + estimator_2