## ----setup, include=FALSE-----------------------------------------------------
knitr::opts_chunk$set(collapse = TRUE, comment = "#>")
library(rvinecopulib)
set.seed(301)

## ----structure----------------------------------------------------------------
structure <- rvine_structure(
  order = 1:4,
  struct_array = list(c(4, 4, 4), c(3, 3), 2)
)
structure
as_rvine_matrix(structure)

## ----special-structures-------------------------------------------------------
cvine_structure(c(4, 1, 3, 2))
dvine_structure(c(4, 1, 3, 2))
rvine_structure_sim(4)

## ----construct-model----------------------------------------------------------
pair_copulas <- list(
  list(
    bicop_dist("gaussian", parameters = 0.6),
    bicop_dist("clayton", parameters = 1.5)
  ),
  list(bicop_dist("frank", parameters = 2))
)
model <- vinecop_dist(
  pair_copulas,
  structure = dvine_structure(1:3)
)
model
summary(model)

## ----use-model----------------------------------------------------------------
u <- rvinecop(5, model)
dvinecop(u, model)
pvinecop(u[1:2, ], model, n_mc = 1000)

## ----fit-model----------------------------------------------------------------
n <- 150
z <- rnorm(n)
x <- cbind(
  z + rnorm(n, sd = 0.7),
  0.6 * z + rnorm(n),
  -0.4 * z + rnorm(n),
  rnorm(n)
)
u <- pseudo_obs(x)

fit <- vinecop(u, family_set = "onepar", selcrit = "bic")
fit
summary(fit)

## ----inspect------------------------------------------------------------------
get_structure(fit)
get_matrix(fit)
get_pair_copula(fit, tree = 1, edge = 1)
get_family(fit, tree = 1, edge = 1)
get_parameters(fit, tree = 1, edge = 1)
get_ktau(fit, tree = 1, edge = 1)
get_all_families(fit)

## ----structure-controls, eval=FALSE-------------------------------------------
# custom_strength <- function(data, weights) {
#   if (length(weights)) {
#     abs(weighted.mean(data[, 1] * data[, 2], weights))
#   } else {
#     abs(mean(data[, 1] * data[, 2]))
#   }
# }
# 
# custom_fit <- vinecop(u, tree_crit = custom_strength)
# random_fit <- vinecop(u, tree_algorithm = "random_weighted")

## ----fixed-structure----------------------------------------------------------
fixed_structure_fit <- vinecop(
  u,
  structure = dvine_structure(1:4),
  family_set = c("gaussian", "clayton")
)

first_tree <- rvine_structure(order = 1:4, struct_array = list(rep(4, 3)))
partial_fit <- vinecop(
  u,
  structure = first_tree,
  family_set = "onepar"
)

## ----sparse-models------------------------------------------------------------
truncated <- vinecop(u, family_set = "onepar", trunc_lvl = 1)
thresholded <- vinecop(u, family_set = "onepar", threshold = 0.1)
truncate_model(fit, trunc_lvl = 1)

## ----refit--------------------------------------------------------------------
refitted <- vinecop(u, vinecop_object = fit)
stopifnot(identical(get_all_families(refitted), get_all_families(fit)))