ABRF-Code-and-Talk/ABRF.R at main · vari-bbc/ABRF-Code-and-Talk · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
library(ggplot2)
library(data.table)
library(ggforce)
library(ggsci)
library(effectsize)
library(patchwork)

# =============================================================================
# Getting SD estimates from 100 sims per sample size
# =============================================================================

ss <- c(2,3,5,10,24,30,50,100) # sample sizes

pilot.sd = rbindlist(lapply(ss, function(n) data.frame(Samples = n, sapply(1:100,function(x) sd(rnorm(n,0,1))))))

colnames(pilot.sd) <- c("Samples","sd")
pilot.sd$Samples = factor(as.character(pilot.sd$Samples),levels=ss)

ggplot(pilot.sd, aes(x = Samples, y = sd,group = Samples)) +  geom_sina() +
  theme_classic(18) + theme(strip.background = element_blank()) +
  geom_hline( aes(yintercept=1,color ="True SD"),linetype = "dotted") +
  scale_color_manual(values="red3") +
  theme(legend.title = element_blank(),legend.position = c(0.85,0.75)) +
  xlab("Pilot sample size") +
  ylab("SD estimated for each pilot study") +
  labs(caption = "*Each dot is one possible pilot study")

# =============================================================================
# Getting Cohen's D from estimates for various sample sizes
# Cohen's D adjusted fro small samples
# =============================================================================

ss <- 2*c(2,3,5,10,24,30,50,100)
pilot.d = rbindlist(lapply(ss, function(n) data.frame(Samples = n/2, sapply(1:100,function(x) {t = rnorm(n,0,1);  group = factor(rep(c("A","B"),each=n/2)); cohens_d(t~group,adjust=F)$Cohens_d  }))))
colnames(pilot.d) <- c("Samples","d")
pilot.d$Samples = factor(as.character(pilot.d$Samples),levels=ss/2)

ggplot(pilot.d, aes(x = Samples, y = d,group = Samples)) +  geom_sina() +
  theme_classic(18) + theme(strip.background = element_blank()) +
  geom_hline( aes(yintercept=0,color ="True Cohen's d"),linetype = "dotted") +
  geom_hline( aes(yintercept=0.5,color ="Medium effect"),linetype = "dashed") +
  geom_hline( aes(yintercept=0.8,color ="Large effect"),linetype = "solid") +
  geom_hline( aes(yintercept=-0.5,color ="Medium effect"),linetype = "dashed") +
  geom_hline( aes(yintercept=-0.8,color ="Large effect"),linetype = "solid") +
  scale_color_nejm() +
  theme(legend.title = element_blank(),legend.position = c(0.85,0.8)) +
  xlab("Pilot sample size per group") +
  ylab("Cohen's d of each pilot study") +
  labs(caption = "*Each dot is one possible pilot study")


# =============================================================================
# Getting Hedge's D from estimates for various sample sizes
# Cohen's D adjusted fro small samples
# =============================================================================

ss <- 2*c(2,3,5,10,24,30,50,100)
pilot.d = rbindlist(lapply(ss, function(n) data.frame(Samples = n/2, sapply(1:100,function(x) {t = rnorm(n,0,1);  group = factor(rep(c("A","B"),each=n/2)); cohens_d(t~group,adjust=T)$Hedges_g  }))))
colnames(pilot.d) <- c("Samples","d")
pilot.d$Samples = factor(as.character(pilot.d$Samples),levels=ss/2)

ggplot(pilot.d, aes(x = Samples, y = d,group = Samples)) +  geom_sina() +
  theme_classic(18) + theme(strip.background = element_blank()) +
  geom_hline( aes(yintercept=0,color ="True Cohen's d"),linetype = "dotted") +
  geom_hline( aes(yintercept=0.5,color ="Medium effect"),linetype = "dashed") +
  geom_hline( aes(yintercept=0.8,color ="Large effect"),linetype = "solid") +
  geom_hline( aes(yintercept=-0.5,color ="Medium effect"),linetype = "dashed") +
  geom_hline( aes(yintercept=-0.8,color ="Large effect"),linetype = "solid") +
  scale_color_nejm() +
  theme(legend.title = element_blank(),legend.position = c(0.85,0.8)) +
  xlab("Pilot sample size per group") +
  ylab("Hedge's g of each pilot study") +
  labs(caption = "*Each dot is one possible pilot study")