## ----setup, echo = FALSE, results = "hide", message = FALSE-------------------
set.seed(241068)

knitr::opts_chunk$set(echo = TRUE, results = 'markup', error = FALSE,
                      warning = FALSE, message = FALSE,
                      tidy = FALSE, cache = TRUE, size = "small",
                      fig.width = 5, fig.height = 4, fig.align = "center",
                      out.width = NULL, ###'.6\\linewidth',
                      out.height = NULL,
                      fig.scap = NA)
## R settings
options(width = 80, digits = 3)

library("tramvs")

abess_available <- require("abess")
tramnet_available <- require("tramnet")

# Colors
if (require("colorspace")) {
  col <- diverge_hcl(2, h = c(246, 40), c = 96, l = c(65, 90))
  fill <- diverge_hcl(2, h = c(246, 40), c = 96, l = c(65, 90), alpha = .3)
}

## ----args---------------------------------------------------------------------
args(abess_tram)

## ----args2--------------------------------------------------------------------
args(tramvs)

## ----tram1, results='hide'----------------------------------------------------
N <- 1e2; P <- 10; nz <- 3
beta <- rep(c(3, 0), c(nz, P - nz))
X <- matrix(rnorm(N * P), nrow = N, ncol = P)
Y <- 1 + X %*% beta + rnorm(N)

dat <- data.frame(y = Y, x = X)
cont_res <- tramvs(y ~ ., data = dat, modFUN = Lm)

## ----tram11, results='hide', eval=abess_available-----------------------------
res_abess <- abess(y ~ ., data = dat, family = "gaussian", num.threads = 2)

## ----tram2--------------------------------------------------------------------
support(cont_res)

## ----tram21, eval=abess_available---------------------------------------------
extract(res_abess, support.size = res_abess$best.size)$support.vars

## ----tram3, eval=FALSE--------------------------------------------------------
#  BoxCoxVS(y ~ ., data = dat)

## ----tram4, eval=FALSE--------------------------------------------------------
#  BoxCoxVS(y ~ ., data = dat, order = 3, extrapolate = TRUE)

## ----mandatory, eval=FALSE----------------------------------------------------
#  BoxCoxVS(y ~ ., data = dat, mandatory = y ~ x.1)

## ----cotram, results="hide"---------------------------------------------------
library(cotram)

data("birds", package = "TH.data")
birds$noise <- rnorm(nrow(birds), sd = 10)

# Estimate support sice via HBIC
count_res <- tramvs(SG5 ~ AOT + AFS + GST + DBH + DWC + LOG + noise, data = birds,
                       modFUN = cotram)

## ----pcotram, out.width="49%", echo=FALSE, fig.show='hold'--------------------
plot(count_res, type = "b")
plot(count_res, which = "path")

## ----profile, eval=tramnet_available------------------------------------------
m0 <- Lm(y ~ 1, data = dat)
X <- model.matrix(y ~ 0 + ., data = dat)
mt <- tramnet(m0, X, lambda = 0, alpha = 1)
pfl <- prof_lambda(mt, nprof = 5)

## ----pprofile, out.width="49%", fig.show='hold', echo=FALSE, eval=tramnet_available----
plot(cont_res, which = "path")
opar <- par(no.readonly = TRUE)
par(mar = c(5.1, 5.1, 4.1, 2.1), las = 1)
matplot(pfl$lambdas, pfl$cfx, type = "l", xlab = expression(lambda),
        ylab = expression(hat(beta)[j]), xlim = rev(range(pfl$lambdas)))
text(min(pfl$lambdas) - 0.25, pfl$cfx[1, ], colnames(pfl$cfx),
     cex = 0.8)
par(opar)

## ----methods1-----------------------------------------------------------------
# More elaborate summary
summary(cont_res)

## ----methods2-----------------------------------------------------------------
# logLik of best model
logLik(cont_res)
nparm <- coef(cont_res, with_baseline = TRUE, best_only = TRUE)
logLik(cont_res, newdata = dat[1:5, ], parm = nparm)

## ----methods3-----------------------------------------------------------------
# High-dimensional information criterion
SIC(cont_res)
SIC(cont_res, best_only = TRUE)

## ----methods4-----------------------------------------------------------------
coef(cont_res)
coef(cont_res, best_only = TRUE)
coef(cont_res, as.lm = TRUE)

## ----methods5, eval=FALSE-----------------------------------------------------
#  head(predict(cont_res, which = "distribution", type = "trafo"))
#  simulate(cont_res)[1:5]
#  head(residuals(cont_res))

## ----sesinf, echo=FALSE-------------------------------------------------------
sessionInfo()

