tests/dontrun/test-LocLikFit.R

In mlysy/LocalCop: Local Likelihood Inference for Conditional Copula Models

#--- test the Frank Local likelihood model --------------------------------

context("Local Likelihood for Frank Copula")

require(tsVine)
source("loclik-functions.R")

# generate data
set.seed(180219)

n <- 2500 # number of time points
X <- (1:n)/n  # time points in  (0,1] interval
family <- 5   # Frank copula
eta.fnc <- function(t) 2*cos(12*pi*t)  # oscillating calibration function
true.par <- BiCopEta2Par(family = family, eta.fnc(X))$par
true.tau <- BiCopEta2Tau(family = family, eta.fnc(X))
udata <- VineCopula::BiCopSim(N=n, family=family, par = true.par)

# function value
eta <- c(1,1)
band <- .1
x0 <- mean(X)
wgt <- KernWeight(X = X, x = x0, band = band)

# R
fn_r <- function(eta) {
  -llfrank(u1 = udata[,1],
           u2 = udata[,2],
           z = X - x0, wgt = wgt, eta = eta)
}

# TMB
obj_tmb <- CondiCopLocFun(u1 = udata[,1], u2 = udata[,2],
                          family = 5, z = X-mean(X), wgt = wgt,
                          eta = eta, nu = 0)

test_that("R and TMB local likelihoods are the same.", {
  nll_r <- fn_r(eta)
  nll_tmb <- obj_tmb$fn(eta)
  expect_equal(nll_tmb, nll_r)
})

test_that("R and TMB optimization are the same.", {
  opt_r <- optim(par = eta, fn = fn_r)
  eta_r <- as.numeric(opt_r$par)
  ll_r <- -opt_r$value
  opt_tmb <- CondiCopLocFit1(u1 = udata[,1], u2 = udata[,2],
                             family = 5, z = X-mean(X), wgt = wgt,
                             eta = eta, nu = 0)
  eta_tmb <- as.numeric(opt_tmb$eta)
  ll_tmb <- opt_tmb$loglik
  expect_equal(eta_r, eta_tmb, tol = 1e-3,
               scale = if(ll_r > ll_tmb) abs(eta_r) else abs(eta_tmb))
  expect_equal(ll_r, ll_tmb, tol = 1e-3,
               scale = if(ll_r > ll_tmb) abs(ll_r) else abs(ll_tmb))
})