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

## ----default------------------------------------------------------------------
x <- data.frame(
  first = rnorm(60),
  second = rgamma(60, shape = 2)
)
fit_kde <- vine(
  x,
  copula_controls = list(family_set = "indep")
)
summary(fit_kde)$margins

## ----configured-kde-----------------------------------------------------------
fit_bounded <- vine(
  transform(x, second = pmin(second, 10)),
  margins_controls = list(
    family_set = list(
      kde1d_family(mult = 1.5),
      kde1d_family(xmin = 0, xmax = 10, deg = 1)
    )
  ),
  copula_controls = list(family_set = "indep")
)

## ----weighted-custom, eval=FALSE----------------------------------------------
# weighted_normal <- margin_family(
#   fit = function(x, weights, type) {
#     location <- weighted.mean(x, weights)
#     scale <- sqrt(weighted.mean((x - location)^2, weights))
#     margin_dist(
#       d = function(y) dnorm(y, location, scale),
#       p = function(y) pnorm(y, location, scale),
#       q = function(p) qnorm(p, location, scale),
#       family = "weighted-normal",
#       type = type,
#       npars = 2,
#       loglik = sum(weights * dnorm(x, location, scale, log = TRUE))
#     )
#   },
#   family_name = "weighted-normal"
# )
# fit_weighted <- vine(x, margins_controls = list(family_set = weighted_normal),
#                      weights = runif(nrow(x)))

## ----parametric, eval=requireNamespace("univariateML", quietly = TRUE)--------
fit_parametric <- vine(
  x,
  margins_controls = list(
    family_set = c("norm", "cauchy", "gamma"),
    selcrit = "bic"
  ),
  copula_controls = list(family_set = "indep")
)
summary(fit_parametric)$margins

## ----per-variable, eval=FALSE-------------------------------------------------
# fit_mixed <- vine(
#   data.frame(amount = rexp(100), count = rpois(100, 3)),
#   var_types = c("c", "d"),
#   margins_controls = list(
#     family_set = list(
#       amount = c("exp", "gamma", "weibull"),
#       count = c("pois", "nbinom")
#     )
#   )
# )

## ----custom-family------------------------------------------------------------
normal_family <- margin_family(
  fit = function(x, weights, type) {
    location <- mean(x)
    scale <- sqrt(mean((x - location)^2))
    margin_dist(
      d = function(y) dnorm(y, location, scale),
      p = function(y) pnorm(y, location, scale),
      q = function(p) qnorm(p, location, scale),
      family = "custom_normal",
      type = type,
      npars = 2,
      loglik = sum(dnorm(x, location, scale, log = TRUE))
    )
  },
  family_name = "custom_normal",
  types = "c"
)

fit_custom <- vine(
  x,
  margins_controls = list(family_set = normal_family),
  copula_controls = list(family_set = "indep")
)
summary(fit_custom)$margins

## ----nested, eval=FALSE-------------------------------------------------------
# margins_controls <- list(
#   family_set = list(
#     list("norm", normal_family),
#     list("gamma", "weibull")
#   ),
#   selcrit = "aic"
# )

## ----protocol, eval=FALSE-----------------------------------------------------
# dmargin.my_margin <- function(x, margin) { ... }
# pmargin.my_margin <- function(x, margin) { ... }
# qmargin.my_margin <- function(p, margin) { ... }
# margin_info.my_margin <- function(object) {
#   list(
#     family_name = "my-family",
#     type = "c",
#     support = c(-Inf, Inf),
#     npars = object$npars,
#     loglik = object$loglik
#   )
# }

## ----ordered-default----------------------------------------------------------
ordered_data <- data.frame(
  rating = ordered(
    sample(c("low", "middle", "high"), 80, replace = TRUE),
    levels = c("low", "middle", "high")
  ),
  value = rnorm(80)
)
fit_ordered <- vine(
  ordered_data,
  copula_controls = list(family_set = "indep")
)
str(rvine(4, fit_ordered))

## ----zero-inflated-data-------------------------------------------------------
zero_data <- data.frame(
  claim = zero_inflated(c(rep(0, 20), rexp(60))),
  score = rnorm(80)
)
inherits(zero_data$claim, "zero_inflated")

## ----fixed--------------------------------------------------------------------
fixed_model <- vine_dist(
  margins = list(
    stats_margin("norm", mean = 0, sd = 1),
    stats_margin("lnorm", meanlog = 0, sdlog = 0.5)
  ),
  pair_copulas = list(list(bicop_dist())),
  structure = dvine_structure(1:2)
)
rvine(3, fixed_model)

## ----persistence--------------------------------------------------------------
path <- tempfile(fileext = ".rds")
saveRDS(fit_custom, path)
restored <- readRDS(path)
unlink(path)
all.equal(dvine(x, restored), dvine(x, fit_custom))