# Generated by vignette example_parkinsons.Rmd: do not edit by hand
# Instead edit example_parkinsons.Rmd and then run precompile.R

skip_on_cran()



params <-
list(run_tests = FALSE)

## ----code=readLines("children/knitr_setup.R"), include=FALSE--------------------------------------

## ----include=FALSE--------------------------------------------------------------------------------
set.seed(1042020)


## ----eval = FALSE---------------------------------------------------------------------------------
## library(multinma)
## options(mc.cores = parallel::detectCores())

## ----setup, echo = FALSE--------------------------------------------------------------------------
library(multinma)
nc <- switch(tolower(Sys.getenv("_R_CHECK_LIMIT_CORES_")), 
             "true" =, "warn" = 2, 
             parallel::detectCores())
options(mc.cores = nc)


## -------------------------------------------------------------------------------------------------
head(parkinsons)


## -------------------------------------------------------------------------------------------------
arm_net <- set_agd_arm(parkinsons, 
                      study = studyn,
                      trt = trtn,
                      y = y, 
                      se = se,
                      sample_size = n)
arm_net


## ----parkinsons_arm_network_plot------------------------------------------------------------------
plot(arm_net, weight_edges = TRUE, weight_nodes = TRUE)


## -------------------------------------------------------------------------------------------------
summary(normal(scale = 100))


## ----eval=!params$run_tests-----------------------------------------------------------------------
## arm_fit_FE <- nma(arm_net,
##                   trt_effects = "fixed",
##                   prior_intercept = normal(scale = 100),
##                   prior_trt = normal(scale = 10))

## ----eval=params$run_tests, echo=FALSE------------------------------------------------------------
arm_fit_FE <- nma(arm_net, 
                  trt_effects = "fixed",
                  prior_intercept = normal(scale = 100),
                  prior_trt = normal(scale = 10),
                  iter = 10000)


## -------------------------------------------------------------------------------------------------
arm_fit_FE


## ----eval=FALSE-----------------------------------------------------------------------------------
## # Not run
## print(arm_fit_FE, pars = c("d", "mu"))


## ----arm_FE_pp_plot-------------------------------------------------------------------------------
plot_prior_posterior(arm_fit_FE)


## -------------------------------------------------------------------------------------------------
summary(normal(scale = 100))
summary(half_normal(scale = 5))


## ----eval=!params$run_tests-----------------------------------------------------------------------
## arm_fit_RE <- nma(arm_net,
##                   seed = 379394727,
##                   trt_effects = "random",
##                   prior_intercept = normal(scale = 100),
##                   prior_trt = normal(scale = 100),
##                   prior_het = half_normal(scale = 5),
##                   adapt_delta = 0.99)

## ----eval=params$run_tests, echo=FALSE------------------------------------------------------------
arm_fit_RE <- nowarn_on_ci(nma(arm_net, 
                  seed = 379394727,
                  trt_effects = "random",
                  prior_intercept = normal(scale = 100),
                  prior_trt = normal(scale = 100),
                  prior_het = half_normal(scale = 5),
                  adapt_delta = 0.99,
                  iter = 10000))


## ----plot_arm_RE_pairs, fig.width = 6-------------------------------------------------------------
pairs(arm_fit_RE, pars = c("mu[4]", "d[3]", "delta[4: 3]", "tau"))


## -------------------------------------------------------------------------------------------------
arm_fit_RE


## ----eval=FALSE-----------------------------------------------------------------------------------
## # Not run
## print(arm_fit_RE, pars = c("d", "mu", "delta"))


## ----arm_RE_pp_plot-------------------------------------------------------------------------------
plot_prior_posterior(arm_fit_RE)


## -------------------------------------------------------------------------------------------------
(arm_dic_FE <- dic(arm_fit_FE))

## -------------------------------------------------------------------------------------------------
(arm_dic_RE <- dic(arm_fit_RE))


## ----arm_FE_resdev_plot---------------------------------------------------------------------------
plot(arm_dic_FE)


## ----arm_RE_resdev_plot---------------------------------------------------------------------------
plot(arm_dic_RE)


## ----arm_releff_FE, fig.height=3------------------------------------------------------------------
(arm_releff_FE <- relative_effects(arm_fit_FE, trt_ref = 1))
plot(arm_releff_FE, ref_line = 0)

## ----arm_releff_RE, fig.height=3------------------------------------------------------------------
(arm_releff_RE <- relative_effects(arm_fit_RE, trt_ref = 1))
plot(arm_releff_RE, ref_line = 0)


## ----arm_pred_FE, fig.height = 2------------------------------------------------------------------
arm_pred_FE <- predict(arm_fit_FE, 
                       baseline = distr(qnorm, mean = -0.73, sd = 21^-0.5),
                       type = "response",
                       baseline_trt = 1)
arm_pred_FE
plot(arm_pred_FE)

## ----arm_pred_RE, fig.height = 2------------------------------------------------------------------
arm_pred_RE <- predict(arm_fit_RE, 
                       baseline = distr(qnorm, mean = -0.73, sd = 21^-0.5),
                       type = "response",
                       baseline_trt = 1)
arm_pred_RE
plot(arm_pred_RE)


## ----arm_pred_RE_all, fig.height=8----------------------------------------------------------------
arm_pred_FE_studies <- predict(arm_fit_FE, type = "response")
arm_pred_FE_studies
plot(arm_pred_FE_studies)


## ----parkinsons_arm_ranks, fig.height=2-----------------------------------------------------------
(arm_ranks <- posterior_ranks(arm_fit_FE))
plot(arm_ranks)

## ----parkinson_arm_rankprobs----------------------------------------------------------------------
(arm_rankprobs <- posterior_rank_probs(arm_fit_FE))
plot(arm_rankprobs)

## ----parkinsons_cumrankprobs----------------------------------------------------------------------
(arm_cumrankprobs <- posterior_rank_probs(arm_fit_FE, cumulative = TRUE))
plot(arm_cumrankprobs)


## -------------------------------------------------------------------------------------------------
contr_net <- set_agd_contrast(parkinsons, 
                              study = studyn,
                              trt = trtn,
                              y = diff, 
                              se = se_diff,
                              sample_size = n)
contr_net


## ----parkinsons_contr_network_plot----------------------------------------------------------------
plot(contr_net, weight_edges = TRUE, weight_nodes = TRUE)


## -------------------------------------------------------------------------------------------------
summary(normal(scale = 100))


## ----eval=!params$run_tests-----------------------------------------------------------------------
## contr_fit_FE <- nma(contr_net,
##                     trt_effects = "fixed",
##                     prior_trt = normal(scale = 100))

## ----eval=params$run_tests, echo=FALSE------------------------------------------------------------
contr_fit_FE <- nma(contr_net, 
                    trt_effects = "fixed",
                    prior_trt = normal(scale = 100),
                    iter = 10000)


## -------------------------------------------------------------------------------------------------
contr_fit_FE


## ----contr_FE_pp_plot-----------------------------------------------------------------------------
plot_prior_posterior(contr_fit_FE)


## -------------------------------------------------------------------------------------------------
summary(normal(scale = 100))
summary(half_normal(scale = 5))


## ----eval=!params$run_tests-----------------------------------------------------------------------
## contr_fit_RE <- nma(contr_net,
##                     seed = 1150676438,
##                     trt_effects = "random",
##                     prior_trt = normal(scale = 100),
##                     prior_het = half_normal(scale = 5),
##                     adapt_delta = 0.99)

## ----eval=params$run_tests, echo=FALSE------------------------------------------------------------
contr_fit_RE <- nowarn_on_ci(nma(contr_net, 
                    seed = 1150676438,
                    trt_effects = "random",
                    prior_trt = normal(scale = 100),
                    prior_het = half_normal(scale = 5),
                    adapt_delta = 0.99,
                    iter = 10000))


## ----plot_contr_RE_pairs, fig.width = 6-----------------------------------------------------------
pairs(contr_fit_RE, pars = c("d[3]", "delta[4: 4 vs. 3]", "tau"))


## -------------------------------------------------------------------------------------------------
contr_fit_RE


## ----eval=FALSE-----------------------------------------------------------------------------------
## # Not run
## print(contr_fit_RE, pars = c("d", "delta"))


## ----contr_RE_pp_plot-----------------------------------------------------------------------------
plot_prior_posterior(contr_fit_RE)


## -------------------------------------------------------------------------------------------------
(contr_dic_FE <- dic(contr_fit_FE))

## -------------------------------------------------------------------------------------------------
(contr_dic_RE <- dic(contr_fit_RE))


## ----contr_FE_resdev_plot-------------------------------------------------------------------------
plot(contr_dic_FE)


## ----contr_RE_resdev_plot-------------------------------------------------------------------------
plot(contr_dic_RE)


## ----contr_releff_FE, fig.height=3----------------------------------------------------------------
(contr_releff_FE <- relative_effects(contr_fit_FE, trt_ref = 1))
plot(contr_releff_FE, ref_line = 0)

## ----contr_releff_RE, fig.height=3----------------------------------------------------------------
(contr_releff_RE <- relative_effects(contr_fit_RE, trt_ref = 1))
plot(contr_releff_RE, ref_line = 0)


## ----contr_pred_FE, fig.height = 2----------------------------------------------------------------
contr_pred_FE <- predict(contr_fit_FE, 
                       baseline = distr(qnorm, mean = -0.73, sd = 21^-0.5),
                       type = "response",
                       baseline_trt = 1)
contr_pred_FE
plot(contr_pred_FE)

## ----contr_pred_RE, fig.height = 2----------------------------------------------------------------
contr_pred_RE <- predict(contr_fit_RE, 
                       baseline = distr(qnorm, mean = -0.73, sd = 21^-0.5),
                       type = "response",
                       baseline_trt = 1)
contr_pred_RE
plot(contr_pred_RE)


## ----eval=FALSE-----------------------------------------------------------------------------------
## # Not run
## predict(contr_fit_FE, type = "response")


## ----parkinsons_contr_ranks, fig.height=2---------------------------------------------------------
(contr_ranks <- posterior_ranks(contr_fit_FE))
plot(contr_ranks)

## ----parkinsons_contr_rankprobs-------------------------------------------------------------------
(contr_rankprobs <- posterior_rank_probs(contr_fit_FE))
plot(contr_rankprobs)

## ----parkinsons_contr_cumrankprobs----------------------------------------------------------------
(contr_cumrankprobs <- posterior_rank_probs(contr_fit_FE, cumulative = TRUE))
plot(contr_cumrankprobs)


## -------------------------------------------------------------------------------------------------
studies <- parkinsons$studyn
(parkinsons_arm <- parkinsons[studies %in% 1:3, ])
(parkinsons_contr <- parkinsons[studies %in% 4:7, ])


## -------------------------------------------------------------------------------------------------
mix_arm_net <- set_agd_arm(parkinsons_arm, 
                           study = studyn,
                           trt = trtn,
                           y = y, 
                           se = se,
                           sample_size = n)

mix_contr_net <- set_agd_contrast(parkinsons_contr, 
                                  study = studyn,
                                  trt = trtn,
                                  y = diff, 
                                  se = se_diff,
                                  sample_size = n)

mix_net <- combine_network(mix_arm_net, mix_contr_net)
mix_net


## ----parkinsons_mix_network_plot------------------------------------------------------------------
plot(mix_net, weight_edges = TRUE, weight_nodes = TRUE)


## -------------------------------------------------------------------------------------------------
summary(normal(scale = 100))


## ----eval=!params$run_tests-----------------------------------------------------------------------
## mix_fit_FE <- nma(mix_net,
##                   trt_effects = "fixed",
##                   prior_intercept = normal(scale = 100),
##                   prior_trt = normal(scale = 100))

## ----eval=params$run_tests, echo=FALSE------------------------------------------------------------
mix_fit_FE <- nma(mix_net, 
                  trt_effects = "fixed",
                  prior_intercept = normal(scale = 100),
                  prior_trt = normal(scale = 100),
                  iter = 10000)


## -------------------------------------------------------------------------------------------------
mix_fit_FE


## ----eval=FALSE-----------------------------------------------------------------------------------
## # Not run
## print(mix_fit_FE, pars = c("d", "mu"))


## ----mix_FE_pp_plot-------------------------------------------------------------------------------
plot_prior_posterior(mix_fit_FE)


## -------------------------------------------------------------------------------------------------
summary(normal(scale = 100))
summary(half_normal(scale = 5))


## ----eval=!params$run_tests-----------------------------------------------------------------------
## mix_fit_RE <- nma(mix_net,
##                   seed = 437219664,
##                   trt_effects = "random",
##                   prior_intercept = normal(scale = 100),
##                   prior_trt = normal(scale = 100),
##                   prior_het = half_normal(scale = 5),
##                   adapt_delta = 0.99)

## ----eval=params$run_tests, echo=FALSE------------------------------------------------------------
mix_fit_RE <- nowarn_on_ci(nma(mix_net, 
                  seed = 437219664,
                  trt_effects = "random",
                  prior_intercept = normal(scale = 100),
                  prior_trt = normal(scale = 100),
                  prior_het = half_normal(scale = 5),
                  adapt_delta = 0.99,
                  iter=10000))


## ----plot_mix_RE_pairs, fig.width = 6-------------------------------------------------------------
pairs(mix_fit_RE, pars = c("d[3]", "delta[4: 4 vs. 3]", "tau"))


## -------------------------------------------------------------------------------------------------
mix_fit_RE


## ----eval=FALSE-----------------------------------------------------------------------------------
## # Not run
## print(mix_fit_RE, pars = c("d", "mu", "delta"))


## ----mix_RE_pp_plot-------------------------------------------------------------------------------
plot_prior_posterior(mix_fit_RE)


## -------------------------------------------------------------------------------------------------
(mix_dic_FE <- dic(mix_fit_FE))

## -------------------------------------------------------------------------------------------------
(mix_dic_RE <- dic(mix_fit_RE))


## ----mix_FE_resdev_plot---------------------------------------------------------------------------
plot(mix_dic_FE)


## ----mix_RE_resdev_plot---------------------------------------------------------------------------
plot(mix_dic_RE)


## ----mix_releff_FE, fig.height=3------------------------------------------------------------------
(mix_releff_FE <- relative_effects(mix_fit_FE, trt_ref = 1))
plot(mix_releff_FE, ref_line = 0)

## ----mix_releff_RE, fig.height=3------------------------------------------------------------------
(mix_releff_RE <- relative_effects(mix_fit_RE, trt_ref = 1))
plot(mix_releff_RE, ref_line = 0)


## ----mix_pred_FE, fig.height = 2------------------------------------------------------------------
mix_pred_FE <- predict(mix_fit_FE, 
                       baseline = distr(qnorm, mean = -0.73, sd = 21^-0.5),
                       type = "response",
                       baseline_trt = 1)
mix_pred_FE
plot(mix_pred_FE)

## ----mix_pred_RE, fig.height = 2------------------------------------------------------------------
mix_pred_RE <- predict(mix_fit_RE, 
                       baseline = distr(qnorm, mean = -0.73, sd = 21^-0.5),
                       type = "response",
                       baseline_trt = 1)
mix_pred_RE
plot(mix_pred_RE)


## ----mix_pred_FE_all, fig.height=8----------------------------------------------------------------
mix_pred_FE_studies <- predict(mix_fit_FE, type = "response")
mix_pred_FE_studies
plot(mix_pred_FE_studies)


## ----parkinsons_mix_ranks, fig.height=2-----------------------------------------------------------
(mix_ranks <- posterior_ranks(mix_fit_FE))
plot(mix_ranks)

## ----parkinsons_mix_rankprobs---------------------------------------------------------------------
(mix_rankprobs <- posterior_rank_probs(mix_fit_FE))
plot(mix_rankprobs)

## ----parkinsons_mix_cumrankprobs------------------------------------------------------------------
(mix_cumrankprobs <- posterior_rank_probs(mix_fit_FE, cumulative = TRUE))
plot(mix_cumrankprobs)


## ----parkinsons_tests, include=FALSE, eval=params$run_tests---------------------------------------
#--- Test against TSD 2 results ---
library(testthat)
library(dplyr)

tol <- 0.05
tol_dic <- 0.1


#--- Arm-level data ---

# FE Relative effects
tsd_FE <- tribble(
~trt, ~mean, ~sd , ~median, ~lower, ~upper,
2   , -1.81, 0.33, -1.81  , -2.46 ,-1.16  ,
3   , -0.47, 0.49, -0.47  , -1.43 ,0.49   ,
4   , -0.52, 0.48, -0.52  , -1.46 ,0.43   ,
5   , -0.82, 0.52, -0.82  , -1.84 ,0.22   ,

) %>% 
  mutate(trt = ordered(trt, levels = levels(arm_net$treatments))) %>%
  arrange(trt)

arm_releff_FE <- as.data.frame(arm_releff_FE)

test_that("FE relative effects", {
  expect_equivalent(arm_releff_FE$mean, tsd_FE$mean, tolerance = tol)
  expect_equivalent(arm_releff_FE$sd, tsd_FE$sd, tolerance = tol)
  expect_equivalent(arm_releff_FE$`50%`, tsd_FE$median, tolerance = tol)
  expect_equivalent(arm_releff_FE$`2.5%`, tsd_FE$lower, tolerance = tol)
  expect_equivalent(arm_releff_FE$`97.5%`, tsd_FE$upper, tolerance = tol)
})

# RE Relative effects
tsd_RE <- tribble(
~trt, ~mean, ~sd , ~median, ~lower, ~upper,
2   , -1.85, 0.54, -1.84  , -2.91 ,-0.85  ,
3   , -0.50, 0.66, -0.50  , -1.78 ,0.75   ,
4   , -0.53, 0.65, -0.53  , -1.77 ,0.71   ,
5   , -0.83, 0.80, -0.83  , -2.35 ,0.69   ,
) %>% 
  mutate(trt = ordered(trt, levels = levels(arm_net$treatments))) %>%
  arrange(trt)

arm_releff_RE <- as.data.frame(arm_releff_RE)

test_that("RE relative effects", {
  expect_equivalent(arm_releff_RE$mean, tsd_RE$mean, tolerance = tol)
  expect_equivalent(arm_releff_RE$`50%`, tsd_RE$median, tolerance = tol)
  skip_on_ci()
  expect_equivalent(arm_releff_RE$sd, tsd_RE$sd, tolerance = tol)
  expect_equivalent(arm_releff_RE$`2.5%`, tsd_RE$lower, tolerance = tol)
  expect_equivalent(arm_releff_RE$`97.5%`, tsd_RE$upper, tolerance = tol)
})

# Heterogeneity SD
arm_tau <- as.data.frame(summary(arm_fit_RE, pars = "tau"))

test_that("RE heterogeneity SD", {
  expect_equivalent(arm_tau$mean, 0.4, tolerance = tol)
  expect_equivalent(arm_tau$`50%`, 0.28, tolerance = tol)
  skip_on_ci()
  expect_equivalent(arm_tau$sd, 0.43, tolerance = tol)
  expect_equivalent(arm_tau$`2.5%`, 0.01, tolerance = tol)
  expect_equivalent(arm_tau$`97.5%`, 1.55, tolerance = tol)
})

# FE probabilities
tsd_pred_FE <- tribble(
~trt, ~mean, ~sd , ~median, ~lower, ~upper,
1   , -0.73, 0.22, -0.73  , -1.16 ,-0.30  ,
2   , -2.54, 0.40, -2.54  , -3.32 ,-1.76  ,
3   , -1.21, 0.53, -1.20  , -2.25 ,-0.15  ,
4   , -1.25, 0.53, -1.25  , -2.28 ,-0.21  ,
5   , -1.55, 0.57, -1.55  , -2.66 ,-0.43  ,
) %>% 
  mutate(trt = ordered(trt, levels = levels(arm_net$treatments))) %>%
  arrange(trt)

arm_pred_FE <- as.data.frame(arm_pred_FE)

test_that("FE predicted probabilities at 3 years", {
  expect_equivalent(arm_pred_FE$mean, tsd_pred_FE$mean, tolerance = tol)
  expect_equivalent(arm_pred_FE$sd, tsd_pred_FE$sd, tolerance = tol)
  expect_equivalent(arm_pred_FE$`50%`, tsd_pred_FE$median, tolerance = tol)
  expect_equivalent(arm_pred_FE$`2.5%`, tsd_pred_FE$lower, tolerance = tol)
  expect_equivalent(arm_pred_FE$`97.5%`, tsd_pred_FE$upper, tolerance = tol)
})

# RE probabilities
tsd_pred_RE <- tribble(
~trt, ~mean, ~sd , ~median, ~lower, ~upper,
1   , -0.73, 0.22, -0.73  , -1.16 ,-0.30  ,
2   , -2.58, 0.58, -2.57  , -3.72 ,-1.50  ,
3   , -1.23, 0.70, -1.23  , -2.57 ,0.10   ,
4   , -1.26, 0.69, -1.26  , -2.57 ,0.05   ,
5   , -1.57, 0.83, -1.56  , -3.14 ,0.02   , 
) %>% 
  mutate(trt = ordered(trt, levels = levels(arm_net$treatments))) %>%
  arrange(trt)

arm_pred_RE <- as.data.frame(arm_pred_RE)

test_that("RE predicted probabilities at 3 years", {
  expect_equivalent(arm_pred_RE$mean, tsd_pred_RE$mean, tolerance = tol)
  expect_equivalent(arm_pred_RE$`50%`, tsd_pred_RE$median, tolerance = tol)
  skip_on_ci()
  expect_equivalent(arm_pred_RE$sd, tsd_pred_RE$sd, tolerance = tol)
  expect_equivalent(arm_pred_RE$`2.5%`, tsd_pred_RE$lower, tolerance = tol)
  expect_equivalent(arm_pred_RE$`97.5%`, tsd_pred_RE$upper, tolerance = tol)
})

# FE DIC
test_that("FE DIC", {
  expect_equivalent(arm_dic_FE$resdev, 13.3, tolerance = tol_dic)
  expect_equivalent(arm_dic_FE$pd, 11.0, tolerance = tol_dic)
  expect_equivalent(arm_dic_FE$dic, 24.3, tolerance = tol_dic)
})

# RE DIC
test_that("RE DIC", {
  expect_equivalent(arm_dic_RE$resdev, 13.6, tolerance = tol_dic)
  expect_equivalent(arm_dic_RE$pd, 12.4, tolerance = tol_dic)
  expect_equivalent(arm_dic_RE$dic, 26.0, tolerance = tol_dic)
})


#--- Contrast-level data ---

# Relative effects, heterogeneity, absolute effects are all equal across data scenarios

contr_releff_FE <- as.data.frame(contr_releff_FE)

test_that("FE relative effects", {
  expect_equivalent(contr_releff_FE$mean, tsd_FE$mean, tolerance = tol)
  expect_equivalent(contr_releff_FE$sd, tsd_FE$sd, tolerance = tol)
  expect_equivalent(contr_releff_FE$`50%`, tsd_FE$median, tolerance = tol)
  expect_equivalent(contr_releff_FE$`2.5%`, tsd_FE$lower, tolerance = tol)
  expect_equivalent(contr_releff_FE$`97.5%`, tsd_FE$upper, tolerance = tol)
})

contr_releff_RE <- as.data.frame(contr_releff_RE)

test_that("RE relative effects", {
  expect_equivalent(contr_releff_RE$mean, tsd_RE$mean, tolerance = tol)
  expect_equivalent(contr_releff_RE$`50%`, tsd_RE$median, tolerance = tol)
  skip_on_ci()
  expect_equivalent(contr_releff_RE$sd, tsd_RE$sd, tolerance = tol)
  expect_equivalent(contr_releff_RE$`2.5%`, tsd_RE$lower, tolerance = tol)
  expect_equivalent(contr_releff_RE$`97.5%`, tsd_RE$upper, tolerance = tol)
})

# Heterogeneity SD
contr_tau <- as.data.frame(summary(contr_fit_RE, pars = "tau"))

test_that("RE heterogeneity SD", {
  expect_equivalent(contr_tau$mean, 0.4, tolerance = tol)
  expect_equivalent(contr_tau$`50%`, 0.28, tolerance = tol)
  skip_on_ci()
  expect_equivalent(contr_tau$sd, 0.43, tolerance = tol)
  expect_equivalent(contr_tau$`2.5%`, 0.01, tolerance = tol)
  expect_equivalent(contr_tau$`97.5%`, 1.55, tolerance = tol)
})

contr_pred_FE <- as.data.frame(contr_pred_FE)

test_that("FE predicted probabilities at 3 years", {
  expect_equivalent(contr_pred_FE$mean, tsd_pred_FE$mean, tolerance = tol)
  expect_equivalent(contr_pred_FE$sd, tsd_pred_FE$sd, tolerance = tol)
  expect_equivalent(contr_pred_FE$`50%`, tsd_pred_FE$median, tolerance = tol)
  expect_equivalent(contr_pred_FE$`2.5%`, tsd_pred_FE$lower, tolerance = tol)
  expect_equivalent(contr_pred_FE$`97.5%`, tsd_pred_FE$upper, tolerance = tol)
})

contr_pred_RE <- as.data.frame(contr_pred_RE)

test_that("RE predicted probabilities at 3 years", {
  expect_equivalent(contr_pred_RE$mean, tsd_pred_RE$mean, tolerance = tol)
  expect_equivalent(contr_pred_RE$`50%`, tsd_pred_RE$median, tolerance = tol)
  skip_on_ci()
  expect_equivalent(contr_pred_RE$sd, tsd_pred_RE$sd, tolerance = tol)
  expect_equivalent(contr_pred_RE$`2.5%`, tsd_pred_RE$lower, tolerance = tol)
  expect_equivalent(contr_pred_RE$`97.5%`, tsd_pred_RE$upper, tolerance = tol)
})

test_that("Error message when using predict() on only contrast data", {
  expect_error(predict(contr_fit_FE),
               "No arm-based data \\(IPD or AgD\\) in network")
})

# FE DIC
test_that("FE DIC", {
  expect_equivalent(contr_dic_FE$resdev, 6.3, tolerance = tol_dic)
  expect_equivalent(contr_dic_FE$pd, 4.0, tolerance = tol_dic)
  expect_equivalent(contr_dic_FE$dic, 10.3, tolerance = tol_dic)
})

# RE DIC
test_that("RE DIC", {
  expect_equivalent(contr_dic_RE$resdev, 6.6, tolerance = tol_dic)
  expect_equivalent(contr_dic_RE$pd, 5.5, tolerance = tol_dic)
  expect_equivalent(contr_dic_RE$dic, 12.1, tolerance = tol_dic)
})


# Test contrast-data rows in incorrect order
park_reorder <- sample_frac(parkinsons, size = 1, replace = FALSE)

reorder_net <- set_agd_contrast(park_reorder, 
                              study = studyn,
                              trt = trtn,
                              y = diff, 
                              se = se_diff,
                              sample_size = n)

reorder_fit_FE <- nma(reorder_net, 
                      seed = 1878819627,
                      trt_effects = "fixed",
                      prior_trt = normal(scale = 100),
                      iter = 10000)

reorder_fit_RE <- nowarn_on_ci(nma(reorder_net, 
                      seed = 1147315,
                      trt_effects = "random",
                      prior_trt = normal(scale = 100),
                      prior_het = half_normal(scale = 5),
                      adapt_delta = 0.99,
                      iter = 10000))

expect_equivalent_nma_summary <- function(object, expected, ...) {
  
  act <- quasi_label(enquo(object), arg = "object")
  exp <- quasi_label(enquo(expected), arg = "expected")
  
  comp <- compare(act$val %>% as.data.frame() %>% select(-c(Bulk_ESS, Tail_ESS, Rhat)), 
                  exp$val %>% as.data.frame() %>% select(-c(Bulk_ESS, Tail_ESS, Rhat)), 
                  ...)
  expect(comp$equal, sprintf("%s not equal to %s.\n%s", 
         act$lab, exp$lab, comp$message))
  
  invisible(act$val)
}

test_that("Analysis of reordered contrast data gives same results", {
  expect_equivalent_nma_summary(relative_effects(reorder_fit_FE, trt_ref = 1),
                           contr_releff_FE, 
                           tolerance = tol)
  
  expect_equivalent_nma_summary(predict(reorder_fit_FE, 
                                     baseline = distr(qnorm, mean = -0.73, sd = 21^-0.5),
                                     type = "response",
                                     baseline_trt = 1),
                           contr_pred_FE,
                           tolerance = tol)
  
  expect_equivalent(dic(reorder_fit_FE)$resdev, contr_dic_FE$resdev, tolerance = tol_dic)
  expect_equivalent(dic(reorder_fit_FE)$pd, contr_dic_FE$pd, tolerance = tol_dic)
  expect_equivalent(dic(reorder_fit_FE)$dic, contr_dic_FE$dic, tolerance = tol_dic)
  
  expect_equivalent(dic(reorder_fit_RE)$resdev, contr_dic_RE$resdev, tolerance = tol_dic)
  expect_equivalent(dic(reorder_fit_RE)$pd, contr_dic_RE$pd, tolerance = tol_dic)
  expect_equivalent(dic(reorder_fit_RE)$dic, contr_dic_RE$dic, tolerance = tol_dic)
  
  skip_on_ci()
  expect_equivalent_nma_summary(relative_effects(reorder_fit_RE, trt_ref = 1),
                           contr_releff_RE, 
                           tolerance = tol)
  
  expect_equivalent_nma_summary(predict(reorder_fit_RE, 
                                     baseline = distr(qnorm, mean = -0.73, sd = 21^-0.5),
                                     type = "response",
                                     baseline_trt = 1),
                           contr_pred_RE,
                           tolerance = tol)
  
  expect_equivalent_nma_summary(summary(reorder_fit_RE, pars = "tau"), 
                           contr_tau,
                           tolerance = tol)
})


#--- Mixed data ---

# Relative effects, heterogeneity, absolute effects are all equal across data scenarios

mix_releff_FE <- as.data.frame(mix_releff_FE)

test_that("FE relative effects", {
  expect_equivalent(mix_releff_FE$mean, tsd_FE$mean, tolerance = tol)
  expect_equivalent(mix_releff_FE$sd, tsd_FE$sd, tolerance = tol)
  expect_equivalent(mix_releff_FE$`50%`, tsd_FE$median, tolerance = tol)
  expect_equivalent(mix_releff_FE$`2.5%`, tsd_FE$lower, tolerance = tol)
  expect_equivalent(mix_releff_FE$`97.5%`, tsd_FE$upper, tolerance = tol)
})

mix_releff_RE <- as.data.frame(mix_releff_RE)

test_that("RE relative effects", {
  expect_equivalent(mix_releff_RE$mean, tsd_RE$mean, tolerance = tol)
  expect_equivalent(mix_releff_RE$`50%`, tsd_RE$median, tolerance = tol)
  skip_on_ci()
  expect_equivalent(mix_releff_RE$sd, tsd_RE$sd, tolerance = tol)
  expect_equivalent(mix_releff_RE$`2.5%`, tsd_RE$lower, tolerance = tol)
  expect_equivalent(mix_releff_RE$`97.5%`, tsd_RE$upper, tolerance = tol)
})

# Heterogeneity SD
mix_tau <- as.data.frame(summary(mix_fit_RE, pars = "tau"))

test_that("RE heterogeneity SD", {
  expect_equivalent(mix_tau$mean, 0.4, tolerance = tol)
  expect_equivalent(mix_tau$`50%`, 0.28, tolerance = tol)
  skip_on_ci()
  expect_equivalent(mix_tau$sd, 0.43, tolerance = tol)
  expect_equivalent(mix_tau$`2.5%`, 0.01, tolerance = tol)
  expect_equivalent(mix_tau$`97.5%`, 1.55, tolerance = tol)
})

mix_pred_FE <- as.data.frame(mix_pred_FE)

test_that("FE predicted probabilities at 3 years", {
  expect_equivalent(mix_pred_FE$mean, tsd_pred_FE$mean, tolerance = tol)
  expect_equivalent(mix_pred_FE$sd, tsd_pred_FE$sd, tolerance = tol)
  expect_equivalent(mix_pred_FE$`50%`, tsd_pred_FE$median, tolerance = tol)
  expect_equivalent(mix_pred_FE$`2.5%`, tsd_pred_FE$lower, tolerance = tol)
  expect_equivalent(mix_pred_FE$`97.5%`, tsd_pred_FE$upper, tolerance = tol)
})

mix_pred_RE <- as.data.frame(mix_pred_RE)

test_that("RE predicted probabilities at 3 years", {
  expect_equivalent(mix_pred_RE$mean, tsd_pred_RE$mean, tolerance = tol)
  expect_equivalent(mix_pred_RE$`50%`, tsd_pred_RE$median, tolerance = tol)
  skip_on_ci()
  expect_equivalent(mix_pred_RE$sd, tsd_pred_RE$sd, tolerance = tol)
  expect_equivalent(mix_pred_RE$`2.5%`, tsd_pred_RE$lower, tolerance = tol)
  expect_equivalent(mix_pred_RE$`97.5%`, tsd_pred_RE$upper, tolerance = tol)
})

# FE DIC
test_that("FE DIC", {
  expect_equivalent(mix_dic_FE$resdev, 9.3, tolerance = tol_dic)
  expect_equivalent(mix_dic_FE$pd, 7.0, tolerance = tol_dic)
  expect_equivalent(mix_dic_FE$dic, 16.3, tolerance = tol_dic)
})

# RE DIC
test_that("RE DIC", {
  expect_equivalent(mix_dic_RE$resdev, 9.6, tolerance = tol_dic)
  expect_equivalent(mix_dic_RE$pd, 8.5, tolerance = tol_dic)
  expect_equivalent(mix_dic_RE$dic, 18.1, tolerance = tol_dic)
})

# --- Check UME models ---
arm_fit_FE_UME <- nma(arm_net, 
                      trt_effects = "fixed",
                      consistency = "ume",
                      prior_intercept = normal(scale = 100),
                      prior_trt = normal(scale = 10),
                      iter = 10000)

# NOTE: RE UME models are not really tractable - lots of divergences - not
# enough data to estimate tau

mix_fit_FE_UME <- nma(mix_net, 
                      trt_effects = "fixed",
                      consistency = "ume",
                      prior_intercept = normal(scale = 100),
                      prior_trt = normal(scale = 100),
                      iter = 10000)

test_that("Arm/Mixed UME results are the same", {
  expect_equivalent_nma_summary(summary(arm_fit_FE_UME, pars = "d"), 
                                summary(mix_fit_FE_UME, pars = "d"), 
                                tolerance = tol)
})

# NOTE: Contrast (and reordered contrast) results are different, since the
# choice of independent contrasts is based on the "observed" baseline arms in
# the data rather than the treatment ordering

contr_fit_FE_UME <- nma(contr_net, 
                        trt_effects = "fixed",
                        consistency = "ume",
                        prior_trt = normal(scale = 100),
                        iter = 10000)

reorder_fit_FE_UME <- nma(reorder_net, 
                          seed = 1878819627,
                          trt_effects = "fixed",
                          consistency = "ume",
                          prior_trt = normal(scale = 100),
                          iter = 10000)

test_that("Contr/Reordered UME results are the same", {
  expect_equivalent_nma_summary(summary(contr_fit_FE_UME, pars = "d"), 
                                summary(reorder_fit_FE_UME, pars = "d"), 
                                tolerance = tol)
})

# --- Test regression models with contrast data ---
park_dummy <- dplyr::mutate(parkinsons, x1 = rnorm(dplyr::n(), 0, 1))

arm_net_reg <- set_agd_arm(park_dummy, 
                           study = studyn,
                           trt = trtn,
                           y = y, 
                           se = se,
                           sample_size = n)

arm_fit_FE_reg <- nma(arm_net_reg, 
                      trt_effects = "fixed",
                      regression = ~x1:.trt,
                      prior_intercept = normal(scale = 100),
                      prior_trt = normal(scale = 10),
                      prior_reg = normal(scale = 1),
                      iter = 10000)

contr_net_reg <- set_agd_contrast(park_dummy, 
                                  study = studyn,
                                  trt = trtn,
                                  y = diff, 
                                  se = se_diff,
                                  sample_size = n)

contr_fit_FE_reg <- nma(contr_net_reg, 
                        trt_effects = "fixed",
                        regression = ~x1:.trt,
                        prior_trt = normal(scale = 100),
                        prior_reg = normal(scale = 1),
                        iter = 10000)

mix_net_reg <- combine_network(set_agd_arm(park_dummy[studies %in% 1:3, ], 
                                       study = studyn,
                                       trt = trtn,
                                       y = y, 
                                       se = se,
                                       sample_size = n), 
                           set_agd_contrast(park_dummy[studies %in% 4:7, ], 
                                  study = studyn,
                                  trt = trtn,
                                  y = diff, 
                                  se = se_diff,
                                  sample_size = n))

mix_fit_FE_reg <- nma(mix_net_reg, 
                      trt_effects = "fixed",
                      regression = ~x1:.trt,
                      prior_intercept = normal(scale = 100),
                      prior_trt = normal(scale = 100),
                      prior_reg = normal(scale = 1),
                      iter = 10000)

reorder_net_reg  <- set_agd_contrast(sample_frac(park_dummy, size = 1, replace = FALSE), 
                                     study = studyn,
                                     trt = trtn,
                                     y = diff, 
                                     se = se_diff,
                                     sample_size = n)

reorder_fit_FE_reg <- nma(reorder_net_reg, 
                          seed = 1878819627,
                          trt_effects = "fixed",
                          regression = ~x1:.trt,
                          prior_trt = normal(scale = 100),
                          prior_reg = normal(scale = 1),
                          iter = 10000)

test_that("Regression models work with contrast data", {
  expect_equivalent_nma_summary(summary(arm_fit_FE_reg, pars = c("d", "beta")), 
                                summary(contr_fit_FE_reg, pars = c("d", "beta")), 
                                tolerance = tol)
  
  expect_equivalent_nma_summary(summary(arm_fit_FE_reg, pars = c("d", "beta")), 
                                summary(mix_fit_FE_reg, pars = c("d", "beta")), 
                                tolerance = tol)
  
  expect_equivalent_nma_summary(summary(contr_fit_FE_reg, pars = c("d", "beta")), 
                                summary(reorder_fit_FE_reg, pars = c("d", "beta")), 
                                tolerance = tol)
})

test_that("Error message when using predict() on only contrast data", {
  expect_error(predict(contr_fit_FE_reg),
               "No arm-based data \\(IPD or AgD\\) in network")
})

# ML-NMR regression models too
park_dummy_mlnmr <- dplyr::mutate(parkinsons, 
                                  x1_mean = rnorm(dplyr::n(), 0, 1),
                                  x1_sd = runif(dplyr::n(), 0.1, 1))

arm_net_mlnmr <- set_agd_arm(park_dummy_mlnmr, 
                             study = studyn,
                             trt = trtn,
                             y = y, 
                             se = se,
                             sample_size = n) %>% 
  add_integration(x1 = distr(qnorm, x1_mean, x1_sd), n_int = 10)

arm_fit_FE_mlnmr <- nma(arm_net_mlnmr, 
                        trt_effects = "fixed",
                        regression = ~x1:.trt,
                        prior_intercept = normal(scale = 100),
                        prior_trt = normal(scale = 10),
                        prior_reg = normal(scale = 1),
                        iter = 20000, save_warmup = FALSE)

contr_net_mlnmr <- set_agd_contrast(park_dummy_mlnmr, 
                                  study = studyn,
                                  trt = trtn,
                                  y = diff, 
                                  se = se_diff,
                                  sample_size = n) %>% 
  add_integration(x1 = distr(qnorm, x1_mean, x1_sd), n_int = 10)

contr_fit_FE_mlnmr <- nma(contr_net_mlnmr, 
                          trt_effects = "fixed",
                          regression = ~x1:.trt,
                          prior_trt = normal(scale = 100),
                          prior_reg = normal(scale = 1),
                          iter = 20000, save_warmup = FALSE)

mix_net_mlnmr <- combine_network(set_agd_arm(park_dummy_mlnmr[studies %in% 1:3, ], 
                                       study = studyn,
                                       trt = trtn,
                                       y = y, 
                                       se = se,
                                       sample_size = n), 
                           set_agd_contrast(park_dummy_mlnmr[studies %in% 4:7, ], 
                                  study = studyn,
                                  trt = trtn,
                                  y = diff, 
                                  se = se_diff,
                                  sample_size = n)) %>% 
  add_integration(x1 = distr(qnorm, x1_mean, x1_sd), n_int = 10)

mix_fit_FE_mlnmr <- nma(mix_net_mlnmr, 
                      trt_effects = "fixed",
                      regression = ~x1:.trt,
                      prior_intercept = normal(scale = 100),
                      prior_trt = normal(scale = 100),
                      prior_reg = normal(scale = 1),
                      iter = 20000, save_warmup = FALSE)

reorder_net_mlnmr  <- set_agd_contrast(sample_frac(park_dummy_mlnmr, size = 1, replace = FALSE), 
                                     study = studyn,
                                     trt = trtn,
                                     y = diff, 
                                     se = se_diff,
                                     sample_size = n) %>% 
  add_integration(x1 = distr(qnorm, x1_mean, x1_sd), n_int = 10)

reorder_fit_FE_mlnmr <- nma(reorder_net_mlnmr, 
                          seed = 1878819627,
                          trt_effects = "fixed",
                          regression = ~x1:.trt,
                          prior_trt = normal(scale = 100),
                          prior_reg = normal(scale = 1),
                          iter = 20000, save_warmup = FALSE)

test_that("ML-NMR models work with contrast data", {
  expect_equivalent_nma_summary(summary(arm_fit_FE_mlnmr, pars = c("d", "beta")), 
                                summary(contr_fit_FE_mlnmr, pars = c("d", "beta")), 
                                tolerance = tol)
  
  expect_equivalent_nma_summary(summary(arm_fit_FE_mlnmr, pars = c("d", "beta")), 
                                summary(mix_fit_FE_mlnmr, pars = c("d", "beta")), 
                                tolerance = tol)
  
  expect_equivalent_nma_summary(summary(contr_fit_FE_mlnmr, pars = c("d", "beta")), 
                                summary(reorder_fit_FE_mlnmr, pars = c("d", "beta")), 
                                tolerance = tol)
})

test_that("Error message when using predict() on only contrast data", {
  expect_error(predict(contr_fit_FE_mlnmr),
               "No arm-based data \\(IPD or AgD\\) in network")
})

test_that("Robust to custom options(contrasts) settings", {
  arm_fit_FE_SAS <- withr::with_options(list(contrasts = c(ordered = "contr.SAS",
                                                         unordered = "contr.SAS")),
                  nma(arm_net, 
                      trt_effects = "fixed",
                      prior_intercept = normal(scale = 100),
                      prior_trt = normal(scale = 10),
                      iter = 10000))
  
    expect_equivalent_nma_summary(summary(arm_fit_FE_SAS), summary(arm_fit_FE),
                                  tolerance = tol)
    expect_equivalent_nma_summary(relative_effects(arm_fit_FE_SAS), relative_effects(arm_fit_FE),
                                  tolerance = tol)
  
  contr_fit_FE_SAS <- withr::with_options(list(contrasts = c(ordered = "contr.SAS",
                                                         unordered = "contr.SAS")),
                  nma(contr_net, 
                      trt_effects = "fixed",
                      prior_intercept = normal(scale = 100),
                      prior_trt = normal(scale = 10),
                      iter = 10000))
  
    expect_equivalent_nma_summary(summary(contr_fit_FE_SAS), summary(contr_fit_FE),
                                  tolerance = tol)
    expect_equivalent_nma_summary(relative_effects(contr_fit_FE_SAS), relative_effects(contr_fit_FE),
                                  tolerance = tol)
    
  mix_fit_FE_SAS <- withr::with_options(list(contrasts = c(ordered = "contr.SAS",
                                                         unordered = "contr.SAS")),
                  nma(mix_net, 
                      trt_effects = "fixed",
                      prior_intercept = normal(scale = 100),
                      prior_trt = normal(scale = 10),
                      iter = 10000))
  
    expect_equivalent_nma_summary(summary(mix_fit_FE_SAS), summary(mix_fit_FE),
                                  tolerance = tol)
    expect_equivalent_nma_summary(relative_effects(mix_fit_FE_SAS), relative_effects(mix_fit_FE),
                                  tolerance = tol)

})


# Force clean up
rm(list = ls())
gc()

