---
title: "Benchmark blasso p>n"
output: rmarkdown::html_vignette
vignette: >
  %\VignetteIndexEntry{Benchmark blasso p>n lasso prior}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE,
  message = FALSE,
  warning = FALSE,
  fig.width = 7,
  fig.height = 5)
```



```{r load-helpers, include=FALSE}
helpers_dir <- file.path(dirname(knitr::current_input()), "helpers")

helper_files <- c(
  "benchmark_3bg.R",
  "benchmark_4bg.R",
  "benchmark_blasso_bayeslm.R",
  "benchmark_blasso_bayesreg.R",
  "benchmark_blasso_hans.R",
  "benchmark_blasso_monomvn.R",
  "benchmark_blasso_rstan.R",
  "benchmark_EHS.R",
  "benchmark_horseshoe.R",
  "benchmark_horseshoe_bayeslm.R",
  "benchmark_horseshoe_bayesreg.R",
  "benchmark_horseshoe_brms.R",
  "generate_data.R",
  "plot_densities.R"
)

for (f in helper_files) {
  source(file.path(helpers_dir, f))
}
```


# Load R scripts

Note that each of the benchamrking functions the inputs are

* vy
* mX
* nburn
* nsamples
* a, b, u, v - prior hyperparameters
* trials - the number of times each MCMC sampler is run
* beta_inds - an index set of beta coefficients for plotting - if NA will calculate these.

The outputs are:

* Median efficiencies for beta, sigma2, lambda2 over the number of trials
* beta_inds
* (x,y) grid for plotting the top 10 average betas
* (x,y) grid for plotting posterior for sigma2 and lambda2
* rhat values for sigma2 and lambda2
* sigma2 and lambda2 samples


# Select a dataset name

```{r}

# if (!requireNamespace("flare", quietly = TRUE)) {
#   knitr::knit_exit()
# }
# dataset_name <- "eyedata"




# if (!requireNamespace("hdi", quietly = TRUE)) {
#   knitr::knit_exit()
# }
# dataset_name <- "riboflavin"


```

# Set options

```{r}

library(LassoHiDFastGibbs)

# Set prior hyperparameter constants
a = 1.0E-2  # Prior shape for sigma2
b = 1.0E-2  # Prior scale for sigma2
u = 1.0E-2  # Prior shape for lambda2
v = 1.0E-2  # Prior scale for lambda2

# Initial values for lambda2 and sigma2
lambda2_init  = 10
lambda_init = sqrt(lambda2_init)
sigma2_init = 1

# Number of samples to run the MCMC
nburn = 1000
nsamples = 11000
inds_use = (nburn + 1):nsamples

# How many times to run each sampler
trials = 20
if (dataset_name=="qtl") {
  trials = 5
}
```

# Generate and normalize dataset

```{r}
res = generate_data(dataset_name)

mX = res$mX
vy = res$vy
p = res$p
n = res$n

rm(res)
```


 

# The modified Park and Casella Gibbs sampler



```{r tiny-example, eval=TRUE}
res_4BG = benchmark_4bg(vy, mX, "lasso", lambda_init, sigma2_init, a, b, u, v, nburn, nsamples, trials, beta_inds=NA) 
# print(res_4BG)
```


```{r, eval=interactive()}
res_3BG = benchmark_3bg(vy, mX, "lasso", lambda_init, sigma2_init, a, b, u, v, nburn, nsamples, trials, beta_inds=res_4BG$beta_inds) 
# print(res_3BG)
```


# The two-block Gibbs sampler with 3/1 grouping

 

```{r, eval=interactive()}
res_ng1 = benchmark_nested_gibbs(vy,
                                mX,
                                penalty_type="lasso",
                                lambda_init=1,
                                sigma2_init=1,
                                a, b, u, v,
                                nburn, nsamples,
                                s_beta=1,
                                trials,
                                beta_inds=res_4BG$beta_inds) 
```


```{r, eval=interactive()}
res_ng5 = benchmark_nested_gibbs(vy,
                                mX,
                                penalty_type="lasso",
                                lambda_init=1,
                                sigma2_init=1,
                                a, b, u, v,
                                nburn, nsamples,
                                s_beta=5,
                                trials,
                                beta_inds=res_4BG$beta_inds) 
```





```{r, eval=interactive()}
res_ng10 = benchmark_nested_gibbs(vy,
                                mX,
                                penalty_type="lasso",
                                lambda_init=1,
                                sigma2_init=1,
                                a, b, u, v,
                                nburn, nsamples,
                                s_beta=10,
                                trials,
                                beta_inds=res_4BG$beta_inds) 
```


# Modified Hans sampler


```{r, eval=interactive()}
res_hans = benchmark_blasso_hans(vy, mX,lambda_init, sigma2_init, a, b, u, v, nburn, nsamples, trials, beta_inds=res_4BG$beta_inds) 
# print(res_hans)
```



# The two two-block Gibbs samplers with 2/2 grouping

```{r, eval=interactive()}

res_2BG_bs = benchmark_blasso_2BG_beta_sigma2(vy, mX,lambda_init, sigma2_init, a, b, u, v, nburn, nsamples, trials, beta_inds=res_4BG$beta_inds) 
# print(res_2BG_bs)
```


```{r, eval=interactive()}
res_2BG_bl = benchmark_blasso_2BG_beta_lambda2(vy, mX,lambda_init, sigma2_init, a, b, u, v, nburn, nsamples, trials, beta_inds=res_4BG$beta_inds) 
# print(res_2BG_bl)
```


# The partially collapsed Gibbs samplers


```{r, eval=interactive()}
res_pcg_ls = benchmark_pcg_lambda2_col_sigma2(vy, mX, "lasso", lambda_init, sigma2_init, a, b, u, v, nburn, nsamples, trials, beta_inds=res_4BG$beta_inds) 
# print(res_pcg_ls)
```


```{r, eval=interactive()}
res_pcg_sl = benchmark_pcg_sigma2_col_lambda2(vy, mX, "lasso", lambda_init, sigma2_init, a, b, u, v, nburn, nsamples, trials, beta_inds=res_4BG$beta_inds) 
# print(res_pcg_sl)
```


```{r, eval=interactive()}
res_pcg_la = benchmark_blasso_pcg_lambda2_col_va(vy, mX,lambda_init, sigma2_init, a, b, u, v, nburn, nsamples, trials, beta_inds=res_4BG$beta_inds) 
# print(res_pcg_la)
```



```{r, eval=interactive()}
res_pcg_sa = benchmark_blasso_pcg_sigma2_col_va(vy, mX,lambda_init, sigma2_init, a, b, u, v, nburn, nsamples, trials, beta_inds=res_4BG$beta_inds) 
# print(res_pcg_sa)
```


```{r, eval=interactive()}
res_pcg_bs = benchmark_pcg_vbeta_col_sigma2(vy, mX, "lasso", lambda_init, sigma2_init, a, b, u, v, nburn, nsamples, trials, beta_inds=res_4BG$beta_inds) 
# print(res_pcg_bs)
```



```{r, eval=interactive()}
res_pcg_sb = benchmark_pcg_vbeta_col_sigma2(vy, mX, "lasso", lambda_init, sigma2_init, a, b, u, v, nburn, nsamples, trials, beta_inds=res_4BG$beta_inds) 
# print(res_pcg_sb)
```


 

```{r, eval=interactive()}
trials <- 2  # 5
if (dataset_name == "cookie") set.seed(3)
if (dataset_name == "covid")  { set.seed(2); trials <- 1 }
if (dataset_name == "qtl")    trials <- 1

res_bayesreg <- NULL

if (requireNamespace("bayesreg", quietly = TRUE)) {

  res_bayesreg <- benchmark_blasso_bayesreg(
    vy, mX,
    lambda_init, sigma2_init, a, b, u, v,
    nburn, nsamples, trials,
    beta_inds = res_4BG$beta_inds
  )

  # print(res_bayesreg)

} else {
  message("Skipping bayesreg benchmark: package 'bayesreg' is not installed.")
}

```

