## ----vignette-nowrap-options, include = FALSE, eval = [encoded data, 9944 characters]
options(width = 10000)

## ----setup, include = [encoded data, 9976 characters]
source("vignette-cache.R", local = knitr::knit_global())

cached_fits <- vignette_cache(
  name     = "v30-tutorial",
  objects  = c(
    fit_RoBMA  = "fit_RoBMA_Lui2015.RDS",
    fit_RoBMA2 = "fit_RoBMA_perinull_Lui2015.RDS"
  ),
  packages = c("metafor", "weightr")
)

knitr::opts_chunk$set(
  collapse    = TRUE,
  comment     = "#>",
  eval        = vignette_cache_eval(cached_fits),
  message     = FALSE,
  warning     = FALSE,
  fig.width   = 7,
  fig.height  = 3.5,
  dev         = "png",
  fig.retina  = 3
)
if (.Platform$OS.type == "windows") {
  knitr::opts_chunk$set(dev.args = list(type = "cairo"))
}

prepare_30_tutorial <- function(envir = parent.frame()) {

  library("metafor")
  library("weightr")
  library("RoBMA")

  data("Lui2015", package = "RoBMA")
  df <- Lui2015

  dfz <- metafor::escalc(
    ri = r, ni = n, measure = "ZCOR",
    data = df
  )

  prior_effect_361        <- prior("normal", list(mean = 0, sd = 0.5))
  prior_heterogeneity_361 <- prior("invgamma", list(shape = 1, scale = 0.075))
  prior_bias_361          <- list(
    prior_weightfunction("two-sided", c(0.05),              wf_cumulative(c(1, 1)),       prior_weights = 1/12),
    prior_weightfunction("two-sided", c(0.05, 0.10),        wf_cumulative(c(1, 1, 1)),    prior_weights = 1/12),
    prior_weightfunction("one-sided", c(0.05),              wf_cumulative(c(1, 1)),       prior_weights = 1/12),
    prior_weightfunction("one-sided", c(0.025, 0.05),       wf_cumulative(c(1, 1, 1)),    prior_weights = 1/12),
    prior_weightfunction("one-sided", c(0.05, 0.50),        wf_cumulative(c(1, 1, 1)),    prior_weights = 1/12),
    prior_weightfunction("one-sided", c(0.025, 0.05, 0.50), wf_cumulative(c(1, 1, 1, 1)), prior_weights = 1/12),
    prior_PET("Cauchy",   list(location = 0, scale = 1),  truncation = list(0, Inf), prior_weights = 1/4),
    prior_PEESE("Cauchy", list(location = 0, scale = 10), truncation = list(0, Inf), prior_weights = 1/4)
  )

  prior_effect_perinull_361      <- prior("normal", list(mean = 0.30, sd = 0.10), truncation = list(0, Inf))
  prior_effect_null_perinull_361 <- prior("normal", list(mean = 0, sd = 0.05))

  list2env(
    list(
      df                                = df,
      dfz                               = dfz,
      prior_effect_361                  = prior_effect_361,
      prior_heterogeneity_361           = prior_heterogeneity_361,
      prior_bias_361                    = prior_bias_361,
      prior_effect_perinull_361         = prior_effect_perinull_361,
      prior_effect_null_perinull_361    = prior_effect_null_perinull_361
    ),
    envir = envir
  )

  invisible(NULL)
}

## ----load-models, include = [encoded data, 9970 characters]
prepare_30_tutorial()
vignette_cache_load(cached_fits)

## ----precompute-models, include = FALSE, eval = [encoded data, 9950 characters]
# prepare_30_tutorial()
# fit_RoBMA <- RoBMA(
#   yi = yi, vi = vi, measure = "ZCOR",
#   prior_effect                 = prior_effect_361,
#   prior_heterogeneity          = prior_heterogeneity_361,
#   prior_bias                   = prior_bias_361,
#   data = dfz, seed = 1, parallel = TRUE
# )
# 
# fit_RoBMA2 <- RoBMA(
#   yi = yi, vi = vi, measure = "ZCOR",
#   prior_effect                 = prior_effect_perinull_361,
#   prior_effect_null            = prior_effect_null_perinull_361,
#   prior_heterogeneity          = prior_heterogeneity_361,
#   prior_bias                   = prior_bias_361,
#   data = dfz, seed = 2, parallel = TRUE
# )
# 
# vignette_cache_save(cached_fits)

## [encoded data, 9997 characters]
library("metafor")
library("weightr")
library("RoBMA")

## [encoded data, 9997 characters]
head(df)

## [encoded data, 9997 characters]
df$r

## [encoded data, 9997 characters]
dfz <- metafor::escalc(
  ri = r, ni = n, measure = "ZCOR",
  data = df
)
head(dfz)

## [encoded data, 9997 characters]
fit_rma <- metafor::rma(yi = yi, vi = vi, data = dfz)
fit_rma

## [encoded data, 9997 characters]
metafor::transf.ztor(fit_rma$b)

## [encoded data, 9997 characters]
fit_PET <- lm(yi ~ I(sqrt(vi)), weights = 1/vi, data = dfz)
summary(fit_PET)

## [encoded data, 9997 characters]
metafor::transf.ztor(summary(fit_PET)$coefficients["(Intercept)", "Estimate"])

## [encoded data, 9997 characters]
fit_PEESE <- lm(yi ~ vi, weights = 1/vi, data = dfz)
summary(fit_PEESE)

## [encoded data, 9997 characters]
fit_4PSM <- weightr::weightfunct(
  effect = dfz$yi, v = dfz$vi,
  steps = c(0.025, 0.05), table = TRUE
)
fit_4PSM

## [encoded data, 9997 characters]
fit_3PSM <- weightr::weightfunct(
  effect = dfz$yi, v = dfz$vi,
  steps = c(0.025), table = TRUE
)
fit_3PSM

## [encoded data, 9997 characters]
metafor::transf.ztor(fit_3PSM$adj_est[2])

## [encoded data, 9997 characters]
fit_sel_z <- metafor::selmodel(fit_rma, type = "stepfun", steps = c(0.025))
fit_sel_z

## [encoded data, 9997 characters]
prior_effect_361        <- prior("normal", list(mean = 0, sd = 0.5))
prior_heterogeneity_361 <- prior("invgamma", list(shape = 1, scale = 0.075))
prior_bias_361          <- list(
  prior_weightfunction("two-sided", c(0.05),             wf_cumulative(c(1, 1)),       prior_weights = 1/12),
  prior_weightfunction("two-sided", c(0.05, 0.10),       wf_cumulative(c(1, 1, 1)),    prior_weights = 1/12),
  prior_weightfunction("one-sided", c(0.05),             wf_cumulative(c(1, 1)),       prior_weights = 1/12),
  prior_weightfunction("one-sided", c(0.025, 0.05),      wf_cumulative(c(1, 1, 1)),    prior_weights = 1/12),
  prior_weightfunction("one-sided", c(0.05, 0.50),       wf_cumulative(c(1, 1, 1)),    prior_weights = 1/12),
  prior_weightfunction("one-sided", c(0.025, 0.05, 0.50), wf_cumulative(c(1, 1, 1, 1)), prior_weights = 1/12),
  prior_PET("Cauchy",   list(location = 0, scale = 1),  truncation = list(0, Inf), prior_weights = 1/4),
  prior_PEESE("Cauchy", list(location = 0, scale = 10), truncation = list(0, Inf), prior_weights = 1/4)
)

## ----fit-RoBMA, eval = [encoded data, 9975 characters]
# fit_RoBMA <- RoBMA(
#   yi = yi, vi = vi, measure = "ZCOR",
#   prior_effect                 = prior_effect_361,
#   prior_heterogeneity          = prior_heterogeneity_361,
#   prior_bias                   = prior_bias_361,
#   data = dfz, seed = 1, parallel = TRUE
# )

## [encoded data, 9997 characters]
summary(fit_RoBMA)

## [encoded data, 9997 characters]
pooled_effect(fit_RoBMA, output_measure = "COR")

## [encoded data, 9997 characters]
summary(fit_RoBMA, conditional = TRUE)

## [encoded data, 9997 characters]
summary_models(fit_RoBMA, type = "individual")

## [encoded data, 9997 characters]
plot_diagnostic_trace(fit_RoBMA, parameter = "mu")

## ----fig.width = 6, fig.height = 4, out.width = "75%", fig.align = "center"[encoded data, 9923 characters]
par(mar = c(4, 4, 1, 4))
plot(fit_RoBMA, parameter = "mu", prior = TRUE, output_measure = "COR", xlim = c(-1, 1))

## [encoded data, 9997 characters]
prior_effect_perinull_361      <- prior("normal", list(mean = 0.30, sd = 0.10), truncation = list(0, Inf))
prior_effect_null_perinull_361 <- prior("normal", list(mean = 0, sd = 0.05))

## ----fit-RoBMA2, eval = [encoded data, 9974 characters]
# fit_RoBMA2 <- RoBMA(
#   yi = yi, vi = vi, measure = "ZCOR",
#   prior_effect                 = prior_effect_perinull_361,
#   prior_effect_null            = prior_effect_null_perinull_361,
#   prior_heterogeneity          = prior_heterogeneity_361,
#   prior_bias                   = prior_bias_361,
#   data = dfz, seed = 2, parallel = TRUE
# )

## [encoded data, 9997 characters]
summary_models(fit_RoBMA2, type = "individual")

