Simulation results 1

Fixed design with single look at data

Published

April 16, 2024

Modified

April 11, 2024

Simulation 1 is a fixed sized trial with decision criteria for superiority, and non-inferiority and also for futility with respect to both superiority and non-inferiority.

We provide summaries of each simulation scenario and the results that were obtained.

Load simulation results

# files of interest
flist <- list.files("data", pattern = "sim01-sc01")
toks <- list()
l <- list()
for(i in 1:length(flist)){
  l[[i]] <- qs::qread(file.path("data", flist[i]))
  toks[[i]] <-  unlist(tstrsplit(flist[i], "[-.]"))
}

Configuration used for each simulated scenario

# cfg used in each scenario
d_cfg <- rbindlist(lapply(seq_along(l), function(i){
  tok <- toks[[i]]
  m <- data.table(do.call(cbind, l[[i]]$cfg))
  data.table(cbind(sc = tok[2], v = tok[3], analys = 1:nrow(m), m))
}))

# conversion to numeric
d_cfg[, `:=`(
  nsim = as.numeric(nsim),
  N_pt = as.numeric(N_pt),
  b_r1 = as.numeric(b_r1),
  b_r2 = as.numeric(b_r2),
  w_srp2 = as.numeric(w_srp2),
  b_r1d = as.numeric(b_r1d),
  b_r2d = as.numeric(b_r2d),
  b_f = as.numeric(b_f),
  d_sup = as.numeric(thresh_sup),
  d_ni = as.numeric(thresh_non_inf),
  d_fut_sup = as.numeric(thresh_fut_sup),
  d_fut_ni = as.numeric(thresh_fut_ni)
  )]

d_cfg[, `:=`(w_srp2 = NULL)]

Process simulation results for variables of interest

# Decisions
i <- 1


d_sup <- rbindlist(lapply(seq_along(l), function(i){
  cbind(sc = d_cfg[i, sc], v = d_cfg[i, v], l[[i]]$d_sup[, lapply(.SD, mean)])
}))
d_sup <- melt(d_sup, id.vars = c("sc", "v"), value.name = "p")
d_sup[, type := "sup"]

d_trt_ni_ref <- rbindlist(lapply(seq_along(l), function(i){
  cbind(sc = d_cfg[i, sc], v = d_cfg[i, v], l[[i]]$d_pr_trt_ni_ref[, lapply(.SD, mean)])
}))
d_trt_ni_ref <- melt(d_trt_ni_ref, id.vars = c("sc", "v"), value.name = "p")
d_trt_ni_ref[, type := "trt_ni_ref"]

d_fut_sup <- rbindlist(lapply(seq_along(l), function(i){
  cbind(sc = d_cfg[i, sc], v = d_cfg[i, v], l[[i]]$d_fut_sup[, lapply(.SD, mean)])
}))
d_fut_sup <- melt(d_fut_sup, id.vars = c("sc", "v"), value.name = "p")
d_fut_sup[, type := "fut_sup"]

d_fut_ni <- rbindlist(lapply(seq_along(l), function(i){
  cbind(sc = d_cfg[i, sc], v = d_cfg[i, v], l[[i]]$d_fut_trt_ni_ref[, lapply(.SD, mean)])
}))
d_fut_ni <- melt(d_fut_ni, id.vars = c("sc", "v"), value.name = "p")
d_fut_ni[, type := "fut_ni"]

d_dec <- rbind(
  d_sup, d_trt_ni_ref, d_fut_sup, d_fut_ni
)

n_sims <- d_cfg$nsim[1]
N_pt <- d_cfg$N_pt[1]


# Posterior summaries on effects of interest
d_post_smry_2 <- rbindlist(lapply(seq_along(l), function(i){
  tok <- toks[[i]]
  m <- l[[i]]$d_post_smry_2
  cbind(sc = tok[2], v = tok[3], m)
}))

# Participant data from trial (grouped)
d_all <- rbindlist(lapply(seq_along(l), function(i){
  tok <- toks[[i]]
  m <- l[[i]]$d_grp
  cbind(sc = tok[2], v = tok[3], m)
}))

Table 1 summarises the configurations used in each simulated scenario. Each treatment effect parameter is set to have the same magnitude of effect. The effects range from \(\log(1/2)\) in scenario 1 to \(\log(2)\) in scenario 7. Decision rules and thresholds remain constant over the entire enrolment period.

Revision effects are computed as a weighted combination of the log-odds ratios for the one-stage and two-stage revision effects. The weights are the sample proportion receiving one-stage and two-stage surgery in those patients receiving randomised surgical treatment and randomised to revision.

Code

d_tbl <- d_cfg[, .(v, N_pt, b_r1, b_r2, b_r1d, b_r2d, b_f, 
                   delta_sup = delta_sup,
                   delta_sup_fut = delta_sup_fut,
                   delta_ni = 1/delta_ni,
                   thresh_sup, thresh_non_inf, thresh_fut_sup, thresh_fut_ni)]

g_tbl <- d_tbl |> gt() |> 
  cols_align(
    columns = everything(),
    align = "center"
  )  |> 
  fmt_number(
    columns = c(b_r1, b_r2, b_r1d, b_r2d, b_f,
                delta_ni
                ),
    decimals = 3
  ) |>
  tab_spanner(
    label = html("Surgical (D<sub>a</sub>)"),
    columns = c(b_r1, b_r2)
  ) |>
  tab_spanner(
    label = html("Duration (D<sub>b</sub>)"),
    columns = c(b_r1d, b_r2d)
  ) |>
  tab_spanner(
    label = html("Type (D<sub>c</sub>)"),
    columns = c(b_f)
  ) |>
  tab_spanner(
    label = html("Decision setup"),
    columns = c(delta_sup, thresh_sup, 
                delta_sup_fut, thresh_fut_sup, 
                delta_ni, thresh_non_inf, thresh_fut_ni)
  ) |>
  cols_label(
    v = html("Configuration"),
    b_r1 = html("rev<br>(one-stage)"),
    b_r2 = html("rev<br>(two-stage)"),
    b_r1d = html("short<br>(one-stage)"),
    b_r2d = html("short<br>(two-stage)"),
    b_f = html("rif"),
    delta_sup = html("delta<sub>sup</sub>"),
    thresh_sup = html("p<sub>sup</sub>"),
    delta_sup_fut = html("delta<sub>fut-sup</sub>"),
    thresh_fut_sup = html("p<sub>fut-sup</sub>"),
    delta_ni = html("delta<sub>ni</sub>"),
    thresh_non_inf = html("p<sub>ni</sub>"),
    thresh_fut_ni = html("p<sub>fut-ni</sub>")
  ) |>
  tab_style(
    style = list(
      cell_borders(
        sides = c("bottom"), color = "black", weight = px(1), style = "solid"
      )),
    locations = list(
      cells_body(
        columns = everything(),
        rows = N_pt == 2500
      )
    )
  ) |>
  tab_options(
    table.font.size = "70%"
  ) |> 
  tab_footnote(
    footnote = "Surgical effects only applies to late silo, effect is relative to response under DAIR.",
    locations = cells_column_labels(columns = c(b_r1, b_r2))
  ) |> 
  tab_footnote(
    footnote = "Applies to all silos, effect is relative to response under long duration.",
    locations = cells_column_labels(columns = b_r1d)
  ) |> 
  tab_footnote(
    footnote = "Applies to all silos, effect is relative to response under short duration.",
    locations = cells_column_labels(columns = b_r2d)
  ) |> 
  tab_footnote(
    footnote = "Applies to all silos, effect is relative to response under no-rifampicin",
    locations = cells_column_labels(columns = b_f)
  ) |> 
  tab_footnote(
    footnote = "Reference OR for evaluating superiority",
    locations = cells_column_labels(columns = delta_sup)
  ) |>
  tab_footnote(
    footnote = "Probability threshold above which superiority is concluded",
    locations = cells_column_labels(columns = thresh_sup)
  ) |> 
  tab_footnote(
    footnote = "Reference OR for evaluating futility wrt the superiority decision",
    locations = cells_column_labels(columns = delta_sup_fut)
  ) |> 
  tab_footnote(
    footnote = "Probability threshold below which futility is concluded",
    locations = cells_column_labels(columns = thresh_fut_sup)
  ) |> 
  tab_footnote(
    footnote = "Reference OR for evaluating non-inferiority",
    locations = cells_column_labels(columns = delta_ni)
  ) |> 
  tab_footnote(
    footnote = "Probability threshold above which non-inferiority is concluded",
    locations = cells_column_labels(columns = thresh_non_inf)
  ) |> 
  tab_footnote(
    footnote = "Probability threshold below which non-inferiority decision is deemed futile",
    locations = cells_column_labels(columns = thresh_fut_ni)
  )   

g_tbl

Configuration	N_pt	Surgical (D_a)		Duration (D_b)		Type (D_c)	Decision setup
Configuration	N_pt	rev (one-stage)¹	rev (two-stage)¹	short (one-stage)²	short (two-stage)³	rif⁴	delta_sup⁵	p_sup⁶	delta_fut-sup⁷	p_fut-sup⁸	delta_ni⁹	p_ni¹⁰	p_fut-ni¹¹
v01	2500	−0.693	−0.693	−0.693	−0.693	−0.693	1	0.975	1.2	0.05	0.833	0.975	0.05
v02	2500	−0.405	−0.405	−0.405	−0.405	−0.405	1	0.975	1.2	0.05	0.833	0.975	0.05
v03	2500	−0.182	−0.182	−0.182	−0.182	−0.182	1	0.975	1.2	0.05	0.833	0.975	0.05
v04	2500	0.000	0.000	0.000	0.000	0.000	1	0.975	1.2	0.05	0.833	0.975	0.05
v05	2500	0.182	0.182	0.182	0.182	0.182	1	0.975	1.2	0.05	0.833	0.975	0.05
v06	2500	0.405	0.405	0.405	0.405	0.405	1	0.975	1.2	0.05	0.833	0.975	0.05
v07	2500	0.693	0.693	0.693	0.693	0.693	1	0.975	1.2	0.05	0.833	0.975	0.05
¹ Surgical effects only applies to late silo, effect is relative to response under DAIR.
² Applies to all silos, effect is relative to response under long duration.
³ Applies to all silos, effect is relative to response under short duration.
⁴ Applies to all silos, effect is relative to response under no-rifampicin
⁵ Reference OR for evaluating superiority
⁶ Probability threshold above which superiority is concluded
⁷ Reference OR for evaluating futility wrt the superiority decision
⁸ Probability threshold below which futility is concluded
⁹ Reference OR for evaluating non-inferiority
¹⁰ Probability threshold above which non-inferiority is concluded
¹¹ Probability threshold below which non-inferiority decision is deemed futile

Table 1: Parameters used to simulate treatment effects and decision thresholds

Figure 1 summarises the variation in the probability of declaring each decision type on each parameter with increasing effects size (odds ratios). The results based on 5000 simulations for a cohort sample size of 2500.

Code

d_fig <- copy(d_dec)

d_fig[, or := g_or_num[v]]

d_fig[, type := factor(
  type, levels = c("sup", "fut_sup", "trt_ni_ref", "fut_ni"),
  labels = c("sup", "fut_sup", "ni", "fut_ni"))]

ggplot(d_fig, aes(x = or, y = p, group = type, col = type)) +
  geom_point(size = 0.5) +
  geom_line(lwd = 0.4) +
  geom_hline(yintercept = 0.05, lwd = 0.4) +
  ggthemes::scale_colour_tableau(
    "", palette = "Tableau 10",
  type = "regular",
  direction = 1) +
  scale_x_continuous("Odds-ratio", breaks = seq(0, 2, by = 0.2)) +
  scale_y_continuous("Proportion sims with decision", breaks = seq(0, 1, by = 0.1)) +
  facet_wrap(~variable, ncol = 2, scales = "free")

Figure 1: Probability of declaring decision by parameter by effect size (all pars set with same OR).

Table 2 shows the same detail as the above figure, but makes it easier to see what the magnitudes of the probabilities are.

Code

# Widen data so that power is shown by col with each col corresponding to an
# analysis
d_tbl <- copy(d_fig)
d_tbl <- dcast(d_tbl, variable + or ~ type, value.var = "p")
names(d_tbl) <- gsub("superiority", "sup", names(d_tbl))
names(d_tbl) <- gsub("futility", "fut", names(d_tbl))
names(d_tbl) <- gsub("trt ni ref", "trt_ni_ref", names(d_tbl))
d_tbl <- d_tbl[order(variable, or)]


g_tbl <- d_tbl |> gt(groupname_col = "variable") |> 
  cols_label(
    or = html("Odds ratio<br>(true)"),
    sup = html("Superiority"),
    fut_sup = html("Futility (sup)"),
    ni = html("NI (trt ni ref)"),
    fut_ni = html("Futility (ni)"),
  )  |>
  fmt_number(
    columns = everything(),
    decimals = 3
  ) |>
  tab_style(
    style = list(
      cell_borders(
        sides = c("top", "bottom"), color = "red", weight = px(1), style = "solid"
      )),
    locations = list(
      cells_body(
        columns = everything(),
        rows = or == "1"
      )
    )
  ) |>
  tab_options(
    table.font.size = "80%"
  ) 

g_tbl

Odds ratio (true)	Superiority	Futility (sup)	NI (trt ni ref)	Futility (ni)
b_r
0.500	0.000	1.000	0.003	0.988
0.667	0.000	0.998	0.113	0.522
0.833	0.000	0.883	0.508	0.046
1.000	0.024	0.406	0.847	0.002
1.200	0.294	0.043	0.979	0.000
1.500	0.864	0.000	0.999	0.000
2.000	1.000	0.000	1.000	0.000
b_r1d
0.500	0.000	0.991	0.053	0.735
0.667	0.000	0.877	0.226	0.267
0.833	0.002	0.554	0.496	0.043
1.000	0.021	0.204	0.737	0.005
1.200	0.135	0.041	0.891	0.000
1.500	0.437	0.002	0.971	0.000
2.000	0.809	0.000	0.995	0.000
b_r2d
0.500	0.000	1.000	0.011	0.945
0.667	0.000	0.990	0.147	0.429
0.833	0.001	0.795	0.505	0.043
1.000	0.022	0.337	0.812	0.001
1.200	0.209	0.049	0.956	0.000
1.500	0.711	0.001	0.996	0.000
2.000	0.977	0.000	1.000	0.000
b_f
0.500	0.000	1.000	0.000	0.999
0.667	0.000	1.000	0.072	0.663
0.833	0.000	0.967	0.507	0.047
1.000	0.030	0.518	0.894	0.000
1.200	0.397	0.053	0.991	0.000
1.500	0.954	0.000	1.000	0.000
2.000	1.000	0.000	1.000	0.000

Table 2: Probability of decision

Figure 2 shows the distribution of estimated posterior means by simulated effect size, parameter and scenario.

Figure 2: Distribution of posterior means (true log OR shown in red).