###R version 4.1.1, rstan version 2.21.3### ###how to install package rstan, please see https://github.com/stan-dev/rstan/wiki/RStan-Getting-Started### library(rstan) ####Stan_models### ###RCT only### rct.stan.code <- "data { int J;//Number of RCTs int n_t[J];//Number of subjects in RCTs, treatment int r_t[J];//Number of events, treatment int n_c[J];//Number of subjects in RCTs, Control int r_c[J];//Number of events, Control } parameters { real mu[J];//baseline risks (log odds) real theta;// relative treatment effect (log OR) real tau;// heterogeneity stdev. vector[J] zeta;//// individual treatment effects } transformed parameters { real pctrl[J]; real ptrt[J]; for (i in 1:J) {pctrl[i] =inv_logit(mu[i]); ptrt[i] =inv_logit(mu[i] +theta+zeta[i]*tau);} } model { theta ~ normal(0,2.82); zeta ~normal(0,1); tau ~ normal(0,0.5); mu ~ normal(0,10); r_c ~ binomial(n_c,pctrl);// control event count r_t ~ binomial(n_t,ptrt);// treatment event count } " ####NRSI only### nrsi.stan.code <- "data { int J;//Number of NRSIs real y[J];//Effect in NRSIs real y_se[J]; //stdev in NRSIs } parameters { real theta; // relative treatment effect (log OR) real tau; // the heterogeneity parameter } model { //prior distributions tau ~ normal (0, 0.5); theta ~ normal (0,2.82); //likelihood for (i in 1:J) { target +=normal_lpdf(y[i] | theta,y_se[i]+tau);} } " ###pooled RCTs and NRSIs### power.prior.stan.code <- "data { int k;//Number of NRSIs real y[k];//Effect in NRSIs real y_se[k]; //stdev in NRSIs int J;//Number of RCTs int n_t[J];//Number of subjects in RCTs, treatment int r_t[J];//Number of events, treatment int n_c[J];//Number of subjects in RCTs, Control int r_c[J];//Number of events, Control } parameters { real theta; // relative treatment effect (log OR) real tau; // the heterogeneity parameter in NRSIs real w1;//down-weight factor for Berge et al. (2020) real w2;//down-weight factor for Polesie et a. (2020) real w3;//down-weight factor for Chaparro et al. (2017) real w4;//down-weight factor for Polesie et al. (2017) real w5;//down-weight factor for Polesie et al. (2017) real w6;//down-weight factor for Yan et al. (2021) real mu[J];//baseline risks in RCTs (log odds) real tau1;the heterogeneity parameter in RCTs vector[J] zeta;// individual treatment effects in RCTs } transformed parameters { real pctrl[J]; real ptrt[J]; for (i in 1:J) {pctrl[i] =inv_logit(mu[i]); ptrt[i] =inv_logit(mu[i] +theta+zeta[i]*tau1);} } model { //prior distributions tau ~ normal (0, 0.5); w1~beta(1.5,1);//Berge et al. (2020)-Serious risk of bias w2~beta(4,1);//Polesie et a. (2020)-Moderate risk of bias w3~beta(1.5,1);//Chaparro et al. (2017)-Serious risk of bias w4~beta(1.5,1);//Polesie et al. (2017)-Serious risk of bias w5~beta(1.5,1);//Polesie et al. (2017)-Critical risk of bias w6~beta(4,1);//Yan et al. (2021)-Critical risk of bias tau1 ~ normal(0,0.5); mu ~ normal(0,10); zeta ~normal(0,1); theta~normal(0,2.82); r_c ~ binomial(n_c,pctrl); r_t ~ binomial(n_t,ptrt); target +=normal_lpdf(y[1] | theta,y_se[1]+tau)*w1; target +=normal_lpdf(y[2] | theta,y_se[2]+tau)*w2; target +=normal_lpdf(y[3] | theta,y_se[3]+tau)*w3; target +=normal_lpdf(y[4] | theta,y_se[4]+tau)*w4; target +=normal_lpdf(y[5] | theta,y_se[5]+tau)*w5; target +=normal_lpdf(y[6] | theta,y_se[6]+tau)*w6; } " set.seed(2023) ###RCT data### meta.data.rct <- as.data.frame(matrix(NA, 6,4)) colnames(meta.data.rct) <- c("rtrt","ntrt","rctrl","nctrl") meta.data.rct$rtrt <- c(1,0,0,6,0,1)###treatment events in RCTs meta.data.rct$ntrt <- c(257,117,52,1281,314,416)###treatment subjects in RCTs meta.data.rct$rctrl <- c(0,1,1,3,1,0)###control events in RCTs meta.data.rct$nctrl <- c(274,223,63,2395,631,210)###control subjects in RCTs k.rct <- 6 ##NRSI data### k.nrsi <- 6 J <- k.nrsi+k.rct###total number of studies R <- k.nrsi###the number of NRSIs M <- k.rct###the number of RCTs y_nrsi <- log(c(1.18,1.02,2.44,1.18,1.01,2.21))###log-or for NRSIs y_se_nrsi <- c((log(1.38)-log(1.01))/(2*1.96),(log(1.30)-log(0.80))/(2*1.96),(log(11.51)-log(0.52))/(2*1.96),(log(1.29)-log(1.08))/(2*1.96), (log(1.26)-log(0.81))/(2*1.96),(log(4.51)-log(1.08))/(2*1.96))###SE for NRSIs ##NRSI## nrsi.data <- list(J =R, y=y_nrsi, y_se=y_se_nrsi)###prepare data### fit.nrsi <- stan(model_code = nrsi.stan.code, data = nrsi.data,chains = 4,iter = 5000, cores=4,control=list(adapt_delta = 0.99))###run stan model### parameter.nrsi <- extract(fit.nrsi, permuted = TRUE)###etract all parameters### nrsi_theta <- parameter.nrsi$theta###Extract the posterior distribution values of theta### nrsi_theta.median <- quantile(nrsi_theta,0.5);nrsi_theta.lower <- quantile(nrsi_theta,0.025);nrsi_theta.upper <- quantile(nrsi_theta,0.975);###The median of theta, the lower and upper limits of its 95% CrI### p.nrsi_exp_theta.Greater.than.1 <- length(which(exp(nrsi_theta)>1))/length(nrsi_theta)###The probability that the posterior distribution value is greater than 1### p.nrsi_exp_theta.Greater.than.1.5 <- length(which(exp(nrsi_theta)>1.5))/length(nrsi_theta)###The probability that the posterior distribution value is greater than 1.5### ###RCT### rct.data <- list(J =M, n_t=meta.data.rct$ntrt, r_t=meta.data.rct$rtrt,n_c=meta.data.rct$nctrl,r_c=meta.data.rct$rctrl) fit.rct <- stan(model_code = rct.stan.code, data = rct.data,chains = 4,iter = 5000, cores=4,control=list(adapt_delta = 0.99)) parameter.rct <- extract(fit.rct, permuted = TRUE) rct_theta <- parameter.rct$theta rct_theta.median <- quantile(rct_theta,0.5);rct_theta.lower <- quantile(rct_theta,0.025);rct_theta.upper <- quantile(rct_theta,0.975); p.rct_exp_theta.Greater.than.1 <- length(which(exp(rct_theta)>1))/length(rct_theta) p.rct_exp_theta.Greater.than.1.5 <- length(which(exp(rct_theta)>1.5))/length(rct_theta) ##power prior## pp.data <- list(J =M, n_t=meta.data.rct$ntrt, r_t=meta.data.rct$rtrt,n_c=meta.data.rct$nctrl,r_c=meta.data.rct$rctrl,k=R,y=y_nrsi,y_se=y_se_nrsi) fit.pp <- stan(model_code = power.prior.stan.code, data = pp.data,chains = 4,iter = 5000, cores=4,control=list(adapt_delta = 0.99)) parameter.pp <- extract(fit.pp, permuted = TRUE) pp_theta <- parameter.pp$theta pp_theta.median <- quantile(pp_theta,0.5);pp_theta.lower <- quantile(pp_theta,0.025);pp_theta.upper <- quantile(pp_theta,0.975); p.pp_exp_theta.Greater.than.1 <- length(which(exp(pp_theta)>1))/length(pp_theta) p.pp_exp_theta.Greater.than.1.5 <- length(which(exp(pp_theta)>1.5))/length(pp_theta) post.res = data.frame(nrsi_theta, rct_theta, pp_theta) df.text <- data.frame(x = c(1.4,1.4, 1.7), y = c( 4.35, 1.8, 0.8)-0.05, study.type = c("NRSI:log(OR)=0.15(95%CrI:-0.06-0.39),P(log(OR)>0=0.94)", "PP:log(OR)=0.17(95%CrI:-0.13-0.64),P(log(OR)>0=0.91)", "RCT:log(OR)=0.57(95%CrI:-0.73-1.77),P(log(OR)>0=0.82)")) figure.4 <- ggplot(post.res, aes(x = rct_theta))+ scale_x_continuous(limits = c(-1.5, 3)) + scale_y_continuous(limits = c(0, 6))+ xlab("Effect:log(OR)")+ ylab("Posterior distribution")+ geom_text(data = df.text, aes(x=x, y=y, label = study.type), size = 6)+ annotate(geom = "segment", x = 1.6, y = 4.2, xend = 0.23, yend = 3.1, arrow = arrow(length = unit(2, "mm")),size = 0.8)+ annotate(geom = "segment", x=1.1, y=1.55, xend=0.35, yend=1.0, arrow = arrow(length = unit(2, "mm")),size = 0.8)+ annotate(geom = "segment", x = 1.5, y = 0.65, xend = 1.45, yend = 0.30, arrow = arrow(length = unit(2, "mm")),size = 0.8)+ geom_density(aes(x=pp_theta), color = "blue3", lwd = 1.2, lty = 1) + geom_density(aes(x=rct_theta), color ="#228b22", alpha=.15, lwd = 1.2, lty = 1) + geom_density(aes(x=nrsi_theta), color ="green1", alpha=.4, lwd = 1.2, lty = 1) + geom_vline(aes(xintercept=0), lty = 2,lwd = 0.5,)+ theme(axis.text.x = element_text(size=10,face="bold"),axis.text.y = element_text(size=10,face="bold"),axis.title=element_text(size=12,face="bold"),axis.line = element_line(colour = "black"), panel.grid.major=element_blank(),panel.grid.minor=element_blank(),panel.background = element_rect(fill = "white", color = "black")) ggsave(figure.4, filename = "~\\figure4.png", dpi = 300, height =22, width =35, units = "cm")