Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

speed-up of RVineMatrix by not calling BiCop for the independence copula #29

Merged
merged 5 commits into from Dec 10, 2016
Merged

speed-up of RVineMatrix by not calling BiCop for the independence copula #29

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
b746934
speed-up of RVineMatrix by not calling BiCop for the independence copula
tvatter Dec 6, 2016
d69599e
Merge remote-tracking branch 'upstream/master'
tvatter Dec 6, 2016
a559b45
small mistake
tvatter Dec 6, 2016
1c22a99
thibault should check his code before he commits
tvatter Dec 6, 2016
93c0707
correction with suggestion from Thomas
tvatter Dec 9, 2016
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Jump to
Jump to file
Failed to load files.
Diff view
Diff view
18 changes: 13 additions & 5 deletions R/BiCop.R
View file
Open in desktop
Expand Up @@ -124,11 +124,19 @@ BiCop <- function(family, par, par2 = 0, tau = NULL, check.pars = TRUE) {
}

# calculate dependence measures
tau <- BiCopPar2Tau(family, par, par2, check.pars = FALSE)
taildep <- BiCopPar2TailDep(family, par, par2, check.pars = FALSE)
beta <- NA # beta does not work for t copula (cdf disabled)
if (family != 2)
beta <- BiCopPar2Beta(family, par, par2, check.pars = FALSE)
if (family == 0) {
tau <- 0
beta <- 0
taildep <- list()
taildep$upper <- 0
taildep$lower <- 0
} else {
tau <- BiCopPar2Tau(family, par, par2, check.pars = FALSE)
taildep <- BiCopPar2TailDep(family, par, par2, check.pars = FALSE)
beta <- NA # beta does not work for t copula (cdf disabled)
if (family != 2)
beta <- BiCopPar2Beta(family, par, par2, check.pars = FALSE)
}

## get full family name and calculate number of parameters
familyname <- BiCopName(family, short = FALSE)
Expand Down
20 changes: 13 additions & 7 deletions R/RVineMatrix.R
View file
Open in desktop
Expand Up @@ -202,16 +202,22 @@ RVineMatrix <- function(Matrix,
}

## add dependence measures

# create list of BiCop ojbects
objlst <- apply(cbind(family[sel], par[sel], par2[sel]),
1,
function(x) BiCop(x[1], x[2], x[3], check.pars = FALSE))
objlst <- apply(cbind(family[sel], par[sel], par2[sel]), 1, function(x)
ifelse(x[1] == 0, NA, BiCop(x[1], x[2], x[3], check.pars = FALSE)))

# construct dependence measure matrices
taus <- utds <- ltds <- bets <- matrix(0, nrow(Matrix), ncol(Matrix))
taus[sel] <- sapply(objlst, function(x) x$tau)
utds[sel] <- sapply(objlst, function(x) x$taildep$upper)
ltds[sel] <- sapply(objlst, function(x) x$taildep$lower)
bets[sel] <- sapply(objlst, function(x) x$beta)
taus[sel] <- vapply(objlst, function(x)
ifelse(inherits(x, "BiCop"), x$tau, 0), numeric(1))
utds[sel] <- vapply(objlst, function(x)
ifelse(inherits(x, "BiCop"), x$taildep$upper, 0), numeric(1))
ltds[sel] <- vapply(objlst, function(x)
ifelse(inherits(x, "BiCop"), x$taildep$lower, 0), numeric(1))
bets[sel] <- vapply(objlst, function(x)
ifelse(inherits(x, "BiCop"), x$beta, 0), numeric(1))

RVM$tau <- taus
RVM$taildep$upper <- utds
RVM$taildep$lower <- ltds
Expand Down