Slide 30
Slide 30 text
Code
30
set.seed(71)
size <- 30
a <- qnorm(runif(size, pnorm(-1.5, mean=0.2, sd=0.7), pnorm(2, mean=0.2, sd=0.7)), mean=0.2, sd=0.7)
sigma <- sqrt(1/rgamma(size, shape=3, scale=1))
b <- qnorm(0.95, mean=0, sd=1)
effect <- list()
for(i in seq_len(10^3)){
x <- purrr::map_dbl(seq_len(size), ~ rnorm(1, mean=a[.x], sd=sigma[.x]))
binary_win <- as.numeric(x/sigma > b)
effect[[length(effect) + 1]] <- data.frame(
# S_{A}
sa=sum(x*binary_win),
# T_{A}
ta=sum(x*binary_win) - sum(sigma * dnorm((sigma * b - x)/sigma)),
# T_{A, cond}
tc=sum(x*binary_win) - sum(sigma * dnorm((sigma * b - x)/sigma)/(1 - pnorm((sigma * b - x)/sigma))*binary_win),
# True effect
te=sum(a*binary_win)
)
}
df <- dplyr::bind_rows(effect)
# The total estimated effect v.s. The total true effect
ggplot(df, aes(x=te, y=sa)) + geom_point() + geom_abline(slope=1, intercept=0)
# The expected total true effect (conditional) v.s. The total true effect
ggplot(df, aes(x=te, y=tc)) + geom_point() + geom_abline(slope=1, intercept=0)
# The expected total true effect v.s. The total true effect
ggplot(df, aes(x=te, y=ta)) + geom_point() + geom_abline(slope=1, intercept=0)