##~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
##~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
##                                                                            ~~
##          RETROACTIVE MEMORY ENHANCEMENT - Meta-Analysis SCRIPT           ----
##                                                                            ~~
##~~~~~~~~~~~~~~~~~~~~~~~~~~~ By Damian Koevoet (2023) ~~~~~~~~~~~~~~~~~~~~~~~~~
##~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

## Is There Selective Retroactive Memory Enhancement in Humans?: A Meta-Analysis
## By D. Koevoet and A. Postma

##~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
##                                Load Libraries                            ----
##~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

library(ARTofR)       # Used for titles and headers
library(readr)        # Used to read data
#library(meta)         # To run meta-analyses
library(RoBMA)        # To run Bayesian meta-analyses

setwd(dirname(rstudioapi::getActiveDocumentContext()$path))

##~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
##                                Load Functions                            ----
##~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

# This function is from the 'effsize' package - 
# Taken from the cohen.d() function - https://cran.r-project.org/web/packages/effsize/effsize.pdf.
# This is used to compute the confidence intervals and standard errors.

compute_ncp <- function(t, df, conf.level){
  st = max(0.1,abs(t))
  end1 = t
  while( pt(q=t,df=df,ncp=end1) > (1-conf.level)/2 ){
    end1 <- end1 + st
  }
  ncp1 = uniroot(function(x) (1-conf.level)/2-pt(q=t,df=df,ncp=x),
                 c(2*t-end1,end1))$root
  
  end2 = t
  while( pt(q=t,df=df,ncp=end2) < (1+conf.level)/2 ){
    end2 <- end2 - st
  }
  
  ncp2 = uniroot(function(x) (1+conf.level)/2-pt(q=t,df=df,ncp=x),
                 c(end2,2*t-end2))$root
  return( c(ncp1=ncp1,ncp2=ncp2) )
}

##~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
##                    Load Data and Compute SEs and 95% CIs                 ----
##~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

data <- read.csv('final_selective_rme_data.csv', sep = ';', dec = ',')

conf.level <- .95
se_es <- 1:nrow(data)
conf.int_l <- 1:nrow(data)
conf.int_h <- 1:nrow(data)

for (i in 1:nrow(data)){
  t <- data$t[i]
  n <- data$n[i]
  df <- n-1
  
  ncp <- compute_ncp(t, df, conf.level)
  conf.int <- as.numeric(sort(c(ncp[1]/sqrt(df), (ncp[2]/sqrt(df)))))
  
  conf.int_l[i] <- conf.int[1]
  conf.int_h[i] <- conf.int[2]
  se_es[i] <- ((conf.int[2]) - (conf.int[1]))/(2*1.96)
}

newdata <- cbind(data, se_es, conf.int_l, conf.int_h)

##~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
##                              Run Meta-Analyses                           ----
##~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

### fit RoBMA-PSMA ----
fit.plus <- RoBMA(d = newdata$ES, se = newdata$se_es, study_names = newdata$Study,
                  parallel = TRUE, autofit = TRUE,
                  burnin = 5000, sample = 10000, seed = 701, chains = 2,
                  priors_bias = list(
                    prior_weightfunction("two.sided", list(alpha = c(1, 1),          steps = c(0.05)),                  prior_weights = 1/12),
                    prior_weightfunction("two.sided", list(alpha = c(1, 1, 1),       steps = c(0.05, 0.10)),            prior_weights = 1/12),
                    prior_weightfunction("one.sided", list(alpha = c(1, 1),          steps = c(0.05)),                  prior_weights = 1/12),
                    prior_weightfunction("one.sided", list(alpha = c(1, 1, 1),       steps = c(0.025, 0.05)),           prior_weights = 1/12),
                    prior_weightfunction("one.sided", list(alpha = c(1, 1, 1),       steps = c(0.05, 0.5)),             prior_weights = 1/12),
                    prior_weightfunction("one.sided", list(alpha = c(1, 1, 1, 1),    steps = c(0.025, 0.05, 0.5)),      prior_weights = 1/12),
                    
                    prior_PET("Cauchy", parameters = list(0,1), truncation = list(0, Inf),  prior_weights = 1/4),
                    prior_PEESE("Cauchy", parameters = list(0,5), truncation = list(0, Inf),  prior_weights = 1/4)
                  ))
summary(fit.plus)
interpret(fit.plus)
forest(fit.plus)


int_data = newdata[newdata$Interval_SAE == 'With Interval', ]
fit.plus.int <- RoBMA(d = int_data$ES, se = int_data$se_es, study_names = int_data$Study,
                  parallel = TRUE, autofit = TRUE,
                  burnin = 5000, sample = 10000, seed = 701, chains = 2,
                  priors_bias = list(
                    prior_weightfunction("two.sided", list(alpha = c(1, 1),          steps = c(0.05)),                  prior_weights = 1/12),
                    prior_weightfunction("two.sided", list(alpha = c(1, 1, 1),       steps = c(0.05, 0.10)),            prior_weights = 1/12),
                    prior_weightfunction("one.sided", list(alpha = c(1, 1),          steps = c(0.05)),                  prior_weights = 1/12),
                    prior_weightfunction("one.sided", list(alpha = c(1, 1, 1),       steps = c(0.025, 0.05)),           prior_weights = 1/12),
                    prior_weightfunction("one.sided", list(alpha = c(1, 1, 1),       steps = c(0.05, 0.5)),             prior_weights = 1/12),
                    prior_weightfunction("one.sided", list(alpha = c(1, 1, 1, 1),    steps = c(0.025, 0.05, 0.5)),      prior_weights = 1/12),
                    
                    prior_PET("Cauchy", parameters = list(0,1), truncation = list(0, Inf),  prior_weights = 1/4),
                    prior_PEESE("Cauchy", parameters = list(0,5), truncation = list(0, Inf),  prior_weights = 1/4)
                  ))
summary(fit.plus.int)
interpret(fit.plus.int)
forest(fit.plus.int)

# plot(fit.plus.int, parameter = "PET-PEESE", col.fill = "grey80", plot_type = "base", main = "", xlim = c(0, .305), ylim = c(-0.1, .85))

int_shock_data <- int_data[int_data$Category_SAE == "shock", ] # only select shock studies
fit.shock.int <- RoBMA(d = int_shock_data$ES, se = int_shock_data$se_es, study_names = int_shock_data$Study, model_type = 'PP',
                     parallel = TRUE, autofit = TRUE,
                     burnin = 5000, sample = 10000, seed = 4, chains = 2,
                     priors_effect    = prior("normal", list(0, .14)),
                     priors_bias = list(
                       prior_weightfunction("two.sided", list(alpha = c(1, 1),          steps = c(0.05)),                  prior_weights = 1/12),
                       prior_weightfunction("two.sided", list(alpha = c(1, 1, 1),       steps = c(0.05, 0.10)),            prior_weights = 1/12),
                       prior_weightfunction("one.sided", list(alpha = c(1, 1),          steps = c(0.05)),                  prior_weights = 1/12),
                       prior_weightfunction("one.sided", list(alpha = c(1, 1, 1),       steps = c(0.025, 0.05)),           prior_weights = 1/12),
                       prior_weightfunction("one.sided", list(alpha = c(1, 1, 1),       steps = c(0.05, 0.5)),             prior_weights = 1/12),
                       prior_weightfunction("one.sided", list(alpha = c(1, 1, 1, 1),    steps = c(0.025, 0.05, 0.5)),      prior_weights = 1/12),

                       prior_PET("Cauchy", parameters = list(0,1), truncation = list(0, Inf),  prior_weights = 1/4),
                       prior_PEESE("Cauchy", parameters = list(0,5), truncation = list(0, Inf),  prior_weights = 1/4)
                     ))

summary(fit.shock.int)
interpret(fit.shock.int)
forest(fit.shock.int, conditional = FALSE, plot_type = "base")