From noreply at r-forge.r-project.org Mon Jun 1 17:42:26 2015 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 1 Jun 2015 17:42:26 +0200 (CEST) Subject: [Vinecopula-commits] r99 - pkg/R Message-ID: <20150601154227.05E3A186288@r-forge.r-project.org> Author: tnagler Date: 2015-06-01 17:42:26 +0200 (Mon, 01 Jun 2015) New Revision: 99 Modified: pkg/R/RVinePartialcorr.R Log: fix RVineCor2Pcor for d = 2, 3 and d >= 10 Modified: pkg/R/RVinePartialcorr.R =================================================================== --- pkg/R/RVinePartialcorr.R 2015-05-28 13:37:47 UTC (rev 98) +++ pkg/R/RVinePartialcorr.R 2015-06-01 15:42:26 UTC (rev 99) @@ -34,13 +34,16 @@ RVineCor2pcor <- function(RVM, corMat) { d <- nrow(corMat) stopifnot(d == nrow(RVM$Matrix)) + stopifnot(d > 1) stopifnot(is(RVM, "RVineMatrix")) stopifnot(all(RVM$family %in% c(0, 1, 2))) - if (d <= 2) - return(corMat) + if (d == 2) { + RVM$par <- matrix(c(0, corMat[2, 1], 0, 0), 2, 2) + return(RVM) + } pp <- matrix(0, d, d) - + oldRVM <- RVM oldOrder <- diag(RVM$Matrix) if (any(oldOrder != length(oldOrder):1)) { @@ -50,11 +53,18 @@ if (!is.null(oldRVM$names)) { if (any(!(oldRVM$names %in% paste("V", 1:d, sep = "")))) { - warning("RVM$names are not default and cannot be checked. Make sure - that the correlation matrix has the same ordering of - variables as the RVM.") + if (!is.null(rownames(corMat))) { + nameOrder <- rev(pmatch(rownames(corMat), oldRVM$names)) + if (any(nameOrder != 1:length(oldRVM$names))) { + corMat <- corMat[nameOrder, nameOrder] + } + } else { + warning( + "RVM$names are not default and the correlation matrix is unnamed. Make sure that +the correlation matrix has the same ordering of variables as the RVM.") + } } else { - nameOrder <- order(oldRVM$names) + nameOrder <- order(as.numeric(sub("V", "", oldRVM$names))) if (any(nameOrder != 1:length(oldRVM$names))) { corMat <- corMat[nameOrder, nameOrder] } @@ -78,9 +88,11 @@ # remaining trees for (ell in 3:(d - 1)) { - for (j in (ell + 1):d) { - given <- A[1:(ell - 1), j] - pp[ell, j] <- partcor(corMat, given, A[ell, j], j) # assuming A[j,j]=j + if (ell < d) { + for (j in (ell + 1):d) { + given <- A[1:(ell - 1), j] + pp[ell, j] <- partcor(corMat, given, A[ell, j], j) # assuming A[j,j]=j + } } } @@ -103,7 +115,7 @@ stopifnot(all(RVM$family %in% c(0, 1, 2))) if (is.null(RVM$names)) RVM$names <- paste("V", 1:d, sep = "") - + ## store variable names and set to V1:d if any non-default name occurs oldNames <- RVM$names if (!all(oldNames %in% paste("V", 1:d, sep = ""))) From noreply at r-forge.r-project.org Fri Jun 5 11:59:07 2015 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 5 Jun 2015 11:59:07 +0200 (CEST) Subject: [Vinecopula-commits] r100 - / pkg pkg/R pkg/inst pkg/man pkg/tests pkg/tests/Examples Message-ID: <20150605095908.0A575187930@r-forge.r-project.org> Author: etobi Date: 2015-06-05 11:59:06 +0200 (Fri, 05 Jun 2015) New Revision: 100 Modified: pkg.pdf pkg/DESCRIPTION pkg/R/RVineMLE.R pkg/inst/ChangeLog pkg/man/BiCopGofTest.Rd pkg/man/BiCopPDF.Rd pkg/man/BiCopVuongClarke.Rd pkg/man/RVineClarkeTest.Rd pkg/man/RVineGofTest.Rd pkg/man/RVineMLE.Rd pkg/man/RVinePIT.Rd pkg/man/RVineStructureSelect.Rd pkg/man/RVineVuongTest.Rd pkg/man/VineCopula-package.Rd pkg/man/vineCopula.Rd pkg/tests/Examples/VineCopula-Ex.Rout.save pkg/tests/additonalExampleRuns.Rout.save Log: Some cosmetics to get the package on CRAN (e.g. usage of donttest and dontrun). Update of example/test reference output. Small fix (and comments) in RVineMLE to properly pass on optim control parameters (e.g. trace). Modified: pkg/DESCRIPTION =================================================================== --- pkg/DESCRIPTION 2015-06-01 15:42:26 UTC (rev 99) +++ pkg/DESCRIPTION 2015-06-05 09:59:06 UTC (rev 100) @@ -2,12 +2,12 @@ Type: Package Title: Statistical Inference of Vine Copulas Version: 1.5 -Date: 2015-05-27 -Author: Ulf Schepsmeier, Jakob Stoeber, Eike Christian Brechmann, Benedikt Graeler, Thomas Nagler +Date: 2015-06-05 +Author: Ulf Schepsmeier, Jakob Stoeber, Eike Christian Brechmann, Benedikt Graeler, Thomas Nagler, Tobias Erhardt Maintainer: Tobias Erhardt Depends: R (>= 2.11.0) Imports: MASS, mvtnorm, igraph, methods, copula, ADGofTest, lattice Suggests: CDVine, TSP -Description: Tools for bivariate exploratory data analysis, bivariate copula selection and (vine) tree construction are provided. Vine copula models can be estimated either sequentially or by joint maximum likelihood estimation. Sampling algorithms and plotting methods are included. Data is assumed to lie in the unit hypercube (so-called copula data). For C- and D-vines links to the package CDVine are provided. +Description: Tools for bivariate exploratory data analysis, bivariate copula selection and (vine) tree construction are provided. Vine copula models can be estimated either sequentially or by joint maximum likelihood estimation. Sampling algorithms and plotting methods are included. Data is assumed to lie in the unit hypercube (so-called copula data). For C- and D-vines links to the package 'CDVine' are provided. License: GPL (>= 2) LazyLoad: yes Modified: pkg/R/RVineMLE.R =================================================================== --- pkg/R/RVineMLE.R 2015-06-01 15:42:26 UTC (rev 99) +++ pkg/R/RVineMLE.R 2015-06-05 09:59:06 UTC (rev 100) @@ -1,11 +1,12 @@ RVineMLE <- function(data, RVM, start = RVM$par, start2 = RVM$par2, maxit = 200, max.df = 30, max.BB = list(BB1 = c(5, 6), BB6 = c(6, 6), BB7 = c(5, 6), BB8 = c(6, 1)), grad = FALSE, hessian = FALSE, se = FALSE, ...) { + + ## sanity checks if (is(RVM)[1] != "RVineMatrix") stop("'RVM' has to be an RVineMatrix object.") if (maxit <= 0) stop("'maxit' has to be greater than zero.") - if (max.df <= 2) stop("The upper bound for the degrees of freedom parameter has to be larger than 2.") if (!is.list(max.BB)) @@ -27,9 +28,8 @@ if (max.BB$BB8[2] < 0.001 || max.BB$BB8[2] > 1) stop("The upper bound for the second parameter of the BB1 copula should be in the interval [0,1].") - + ## sanity checks for start parameters Matrix <- RVM$Matrix - if (!all(start %in% c(0, NA))) { for (i in 2:dim(Matrix)[1]) { for (j in 1:(i - 1)) { @@ -102,6 +102,7 @@ } } + ## sanity checks for input data data <- as.matrix(data) if (any(data > 1) || any(data < 0)) stop("Data has be in the interval [0,1].") @@ -114,6 +115,7 @@ if (T < 2) stop("Number of observations has to be at least 2.") + ## normalization of R-vine matrix o <- diag(RVM$Matrix) oldRVM <- RVM RVM <- normalizeRVineMatrix(RVM) @@ -123,36 +125,36 @@ n <- dim(RVM) N <- dim(data)[1] + ## sequential estimation of start parameters if not provided if (all(start == 0)) { est_start <- RVineSeqEst(data, RVM, max.df = max.df, max.BB = max.BB) start <- est_start$RVM$par start2 <- est_start$RVM$par2 } + ## Position of parameters in R-vine matrix posParams <- (RVM$family > 0) posParams2 <- (RVM$family %in% c(2, 7, 8, 9, 10, 17, 18, 19, 20, 27, 28, 29, 30, 37, 38, 39, 40, 104, 114, 124, 134, 204, 214, 224, 234)) - posParams[is.na(posParams)] <- FALSE posParams2[is.na(posParams2)] <- FALSE + ## number of parameters nParams <- sum(posParams, na.rm = TRUE) nParams2 <- sum(posParams2, na.rm = TRUE) + ## vectors of start parameters and corresponding pair-copula families startpar <- double(nParams + nParams2) - Copula.Types <- RVM$family[posParams] - startpar[1:nParams] <- start[posParams] if (nParams2 > 0) { startpar[(nParams + 1):(nParams + nParams2)] <- start2[posParams2] } - # Grenzen + ## lower and upper bounds lb <- double(nParams + nParams2) ub <- double(nParams + nParams2) - for (i in 1:nParams) { if (Copula.Types[i] %in% c(1, 2)) { # Normal @@ -231,7 +233,6 @@ lb[i] <- -20 ub[i] <- -1.001 } - } if (nParams2 > 0) { @@ -282,11 +283,9 @@ } } - startpar1 <- startpar[Copula.Types != 0] - - # calcupdate=NA V=NA - + ## log-likelihood function to be maximized optim_LL <- function(parm, data, posParams, posParams2, Copula.Types, start, start2, RVM, calcupdate = NA) { + # calcupdate=NA V=NA nParams <- sum(posParams, na.rm = TRUE) nParams2 <- sum(posParams2, na.rm = TRUE) @@ -318,7 +317,7 @@ } } - + ## gradient ableitung <- function(parm, data, posParams, posParams2, Copula.Types, start, start2, RVM, calcupdate) { nParams <- sum(posParams, na.rm = TRUE) nParams2 <- sum(posParams2, na.rm = TRUE) @@ -347,6 +346,7 @@ return(grad) } + ## default values for parscale (see optim) pscale <- numeric() for (i in 1:nParams) { pscale[i] <- ifelse(Copula.Types[i] %in% c(1, 2, 43, 44), 0.01, 1) @@ -359,14 +359,20 @@ pscale <- c(pscale, pscale2) } - if (!exists("factr")) factr <- 1e+08 # Toleranz etwas hoch setzen (groeber) + ## (default) values for control parameters of optim + ctrl <- list(fnscale = -1, + maxit = maxit, + trace = 1, + parscale = pscale, + factr = 1e+08) + ctrl <- modifyList(ctrl, list(...)) - + ## optimization if (all(Copula.Types %in% c(0, 1, 2, 3:6, 13, 14, 16, 23, 24, 26, 33, 34, 36, 43, 44)) && grad == TRUE) { # n=dim(RVM) calcupdate=array(0,dim=c(n,n,n,n)) for(i in (n-1):1){ for(k in n:(i+1)){ calcupdate[, ,k,i ]=RVineMatrixUpdate(RVM,k,i) } } if (hessian == TRUE || se == TRUE) { - out1 <- optim(par = startpar1, + out1 <- optim(par = startpar, fn = optim_LL, gr = ableitung, data = data, @@ -376,16 +382,12 @@ start2 = start2, RVM = RVM, method = "L-BFGS-B", - control = list(fnscale = -1, - maxit = maxit, - trace = 1, - parscale = pscale, - factr = factr), + control = ctrl, lower = lb, upper = ub, hessian = TRUE) } else { - out1 <- optim(par = startpar1, + out1 <- optim(par = startpar, fn = optim_LL, gr = ableitung, data = data, @@ -396,17 +398,13 @@ start2 = start2, RVM = RVM, method = "L-BFGS-B", - control = list(fnscale = -1, - maxit = maxit, - trace = 1, - parscale = pscale, - factr = factr), + control = ctrl, lower = lb, upper = ub) } } else { if (hessian == TRUE || se == TRUE) { - out1 <- optim(par = startpar1, + out1 <- optim(par = startpar, fn = optim_LL, data = data, posParams = posParams, @@ -417,18 +415,12 @@ RVM = RVM, calcupdate = NA, method = "L-BFGS-B", - control = list(fnscale = -1, - maxit = maxit, - trace = 1, - parscale = pscale, - factr = factr, - ...), + control = ctrl, lower = lb, upper = ub, hessian = TRUE) } else { - # print('startpar1') print(startpar1) print('lower') print(lb) print('upper') print(ub) - out1 <- optim(par = startpar1, + out1 <- optim(par = startpar, fn = optim_LL, data = data, posParams = posParams, @@ -439,23 +431,20 @@ RVM = RVM, calcupdate = NA, method = "L-BFGS-B", - control = list(fnscale = -1, - maxit = maxit, - trace = 1, - parscale = pscale, - factr = factr, - ...), + control = ctrl, lower = lb, upper = ub) } } + ## list for final output out <- list() - + out$value <- out1$value out$convergence <- out1$convergence out$message <- out1$message out$counts <- out1$counts + if (hessian == TRUE) out$hessian <- out1$hessian Modified: pkg/inst/ChangeLog =================================================================== --- pkg/inst/ChangeLog 2015-06-01 15:42:26 UTC (rev 99) +++ pkg/inst/ChangeLog 2015-06-05 09:59:06 UTC (rev 100) @@ -5,7 +5,7 @@ Maintainer: Tobias Erhardt and Thomas Nagler -Version 1.5 (May 27, 2015) +Version 1.5 (June 2, 2015) - New functionality: * as.copuladata: coerce to class copuladata @@ -22,7 +22,7 @@ * BiCopEst: extend search interval for Tawn MLE to avoid optim-errors * BiCopEst: fix for optim error ('non-finite value supplied') * RVineSim: reorder U so that it corresponds to the order of RVM - * RVineCor2pcor: include normalization step for a more intuitive behavior + * RVineCor2pcor: include normalization step for a more intuitive behavior, bug fix for d = 2, 3 and d >= 10 * RVinePcor2cor: bug fixes for d=2 and d>9 * RVineCopSelect: RVM object now uses variable names as provided by data Modified: pkg/man/BiCopGofTest.Rd =================================================================== --- pkg/man/BiCopGofTest.Rd 2015-06-01 15:42:26 UTC (rev 99) +++ pkg/man/BiCopGofTest.Rd 2015-06-05 09:59:06 UTC (rev 100) @@ -137,16 +137,15 @@ # perform Kendall's goodness-of-fit test for the Frank copula BiCopGofTest(u1, u2, family = 5) -\donttest{ + # perform Kendall's goodness-of-fit test for the true copula -gof <- BiCopGofTest(u1, u2, family = 3, method = "kendall") +gof <- BiCopGofTest(u1, u2, family = 3, method = "kendall", B=50) gof$p.value.CvM gof$p.value.KS # perform Kendall's goodness-of-fit test for the Frank copula -gof <- BiCopGofTest(u1, u2, family = 5, method = "kendall") +gof <- BiCopGofTest(u1, u2, family = 5, method = "kendall", B=50) gof$p.value.CvM gof$p.value.KS } -} Modified: pkg/man/BiCopPDF.Rd =================================================================== --- pkg/man/BiCopPDF.Rd 2015-06-01 15:42:26 UTC (rev 99) +++ pkg/man/BiCopPDF.Rd 2015-06-05 09:59:06 UTC (rev 100) @@ -85,6 +85,6 @@ ## estimate a bivariate copula from the data and evaluate its PDF cop <- BiCopSelect(u1, u2) -BiCopPDF(u1, u2, cop) +round(BiCopPDF(u1, u2, cop), 8) } Modified: pkg/man/BiCopVuongClarke.Rd =================================================================== --- pkg/man/BiCopVuongClarke.Rd 2015-06-01 15:42:26 UTC (rev 99) +++ pkg/man/BiCopVuongClarke.Rd 2015-06-05 09:59:06 UTC (rev 100) @@ -118,15 +118,16 @@ } \examples{ -\donttest{ # simulate from a t-copula set.seed(123) dat <- BiCopSim(500, 2, 0.7, 5) # apply the test for families 1-10 -vcgof <- BiCopVuongClarke(dat[,1], dat[,2], familyset = c(1:10)) +vcgof <- BiCopVuongClarke(dat[,1], dat[,2], familyset = 1:6) # display the Vuong test scores vcgof[1,] + +# display the Clarke test scores +vcgof[2,] } -} Modified: pkg/man/RVineClarkeTest.Rd =================================================================== --- pkg/man/RVineClarkeTest.Rd 2015-06-01 15:42:26 UTC (rev 99) +++ pkg/man/RVineClarkeTest.Rd 2015-06-05 09:59:06 UTC (rev 100) @@ -63,8 +63,12 @@ \examples{ -\donttest{data(daxreturns) +\dontrun{ +# vine structure selection time-consuming (~ 20 sec) +# load data set +data(daxreturns) + # select the R-vine structure, families and parameters RVM <- RVineStructureSelect(daxreturns[,1:5], c(1:6)) RVM$Matrix Modified: pkg/man/RVineGofTest.Rd =================================================================== --- pkg/man/RVineGofTest.Rd 2015-06-01 15:42:26 UTC (rev 99) +++ pkg/man/RVineGofTest.Rd 2015-06-05 09:59:06 UTC (rev 100) @@ -166,7 +166,10 @@ \seealso{\code{\link{BiCopGofTest}}, \code{\link{RVinePIT}}} \examples{ -\donttest{# load data set +\dontrun{ +# time-consuming example + +# load data set data(daxreturns) # select the R-vine structure, families and parameters Modified: pkg/man/RVineMLE.Rd =================================================================== --- pkg/man/RVineMLE.Rd 2015-06-01 15:42:26 UTC (rev 99) +++ pkg/man/RVineMLE.Rd 2015-06-05 09:59:06 UTC (rev 100) @@ -71,7 +71,6 @@ \code{\link{RVineHessian}}} \examples{ -\donttest{ # define 5-dimensional R-vine tree structure matrix Matrix <- c(5, 2, 3, 1, 4, 0, 2, 3, 4, 1, @@ -109,7 +108,8 @@ simdata <- RVineSim(300, RVM) # compute the MLE -mle <- RVineMLE(simdata, RVM, grad=TRUE) -mle$RVM +mle <- RVineMLE(simdata, RVM, grad = TRUE, trace = 0) + +# compare parameters +round(mle$RVM$par - RVM$par, 2) } -} Modified: pkg/man/RVinePIT.Rd =================================================================== --- pkg/man/RVinePIT.Rd 2015-06-01 15:42:26 UTC (rev 99) +++ pkg/man/RVinePIT.Rd 2015-06-05 09:59:06 UTC (rev 100) @@ -52,19 +52,18 @@ } \examples{ -\donttest{# load data set +# load data set data(daxreturns) # select the R-vine structure, families and parameters -RVM <- RVineStructureSelect(daxreturns[,1:5], c(1:6)) +RVM <- RVineStructureSelect(daxreturns[,1:3], c(1:6)) # PIT data -pit <- RVinePIT(daxreturns[,1:5], RVM) +pit <- RVinePIT(daxreturns[,1:3], RVM) par(mfrow = c(1,2)) plot(daxreturns[,1], daxreturns[,2]) # correlated data plot(pit[,1], pit[,2]) # i.i.d. data cor(pit, method = "kendall") -} } \ No newline at end of file Modified: pkg/man/RVineStructureSelect.Rd =================================================================== --- pkg/man/RVineStructureSelect.Rd 2015-06-01 15:42:26 UTC (rev 99) +++ pkg/man/RVineStructureSelect.Rd 2015-06-05 09:59:06 UTC (rev 100) @@ -125,13 +125,13 @@ # we allow for the copula families: Gauss, t, Clayton, Gumbel, Frank and Joe RVM <- RVineStructureSelect(daxreturns[1:750,1:4], c(1:6), progress = TRUE) -# specify a C-vine copula model with only Clayton, Gumbel and Frank copulas \dontrun{ +# specify a C-vine copula model with only Clayton, Gumbel and Frank copulas (time-consuming) CVM <- RVineStructureSelect(daxreturns, c(3,4,5), "CVine") } -# determine the order of the nodes in a D-vine using the package TSP \dontrun{ +# determine the order of the nodes in a D-vine using the package TSP (time-consuming) library(TSP) d <- dim(daxreturns)[2] M <- 1 - abs(TauMatrix(daxreturns)) Modified: pkg/man/RVineVuongTest.Rd =================================================================== --- pkg/man/RVineVuongTest.Rd 2015-06-01 15:42:26 UTC (rev 99) +++ pkg/man/RVineVuongTest.Rd 2015-06-05 09:59:06 UTC (rev 100) @@ -68,7 +68,9 @@ \examples{ -\donttest{ +\dontrun{ +# vine structure selection time-consuming (~ 20 sec) + # load data set data(daxreturns) Modified: pkg/man/VineCopula-package.Rd =================================================================== --- pkg/man/VineCopula-package.Rd 2015-06-01 15:42:26 UTC (rev 99) +++ pkg/man/VineCopula-package.Rd 2015-06-05 09:59:06 UTC (rev 100) @@ -10,7 +10,7 @@ Vine copula models can be estimated either sequentially or by joint maximum likelihood estimation. Sampling algorithms and plotting methods are included. Data is assumed to lie in the unit hypercube (so-called copula data). -For C- and D-vines links to the package CDVine are provided. +For C- and D-vines links to the package 'CDVine' are provided. } \section{Remark}{ @@ -80,7 +80,7 @@ Package: \tab VineCopula\cr Type: \tab Package\cr Version: \tab 1.5\cr -Date: \tab 2015-05-27\cr +Date: \tab 2015-06-05\cr License: \tab GPL (>=2)\cr Depends: \tab R (\eqn{\geq 2.11.0}{>= 2.11.0})\cr Imports: \tab MASS, mvtnorm, igraph, methods, copula, ADGofTest, lattice\cr @@ -90,7 +90,7 @@ } \author{ -Ulf Schepsmeier, Jakob Stoeber, Eike Christian Brechmann, Benedikt Graeler, Thomas Nagler +Ulf Schepsmeier, Jakob Stoeber, Eike Christian Brechmann, Benedikt Graeler, Thomas Nagler, Tobias Erhardt } \references{ Modified: pkg/man/vineCopula.Rd =================================================================== --- pkg/man/vineCopula.Rd 2015-06-01 15:42:26 UTC (rev 99) +++ pkg/man/vineCopula.Rd 2015-06-05 09:59:06 UTC (rev 100) @@ -22,11 +22,10 @@ # a C-vine of independent copulas vine <- vineCopula(4L, "CVine") -\dontrun{ library(copula) library(lattice) -cloud(V1 ~ V2 + V3, as.data.frame(rCopula(500, vine)))} +cloud(V1 ~ V2 + V3, as.data.frame(rCopula(500, vine))) } \keyword{ mulitvariate } \keyword{ distribution } \ No newline at end of file Modified: pkg/tests/Examples/VineCopula-Ex.Rout.save =================================================================== --- pkg/tests/Examples/VineCopula-Ex.Rout.save 2015-06-01 15:42:26 UTC (rev 99) +++ pkg/tests/Examples/VineCopula-Ex.Rout.save 2015-06-05 09:59:06 UTC (rev 100) @@ -1,5 +1,5 @@ -R Under development (unstable) (2015-01-14 r67471) -- "Unsuffered Consequences" +R Under development (unstable) (2015-06-01 r68455) -- "Unsuffered Consequences" Copyright (C) 2015 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 (64-bit) @@ -20,7 +20,6 @@ > pkgname <- "VineCopula" > source(file.path(R.home("share"), "R", "examples-header.R")) > options(warn = 1) -> options(pager = "console") > library('VineCopula') > > base::assign(".oldSearch", base::search(), pos = 'CheckExEnv') @@ -351,10 +350,10 @@ fitCopula > -> persp(BB8Copula(c(1,0.5)), dCopula, zlim = c(0,10)) -> persp(surBB8Copula(c(1,0.5)), dCopula, zlim = c(0,10)) -> persp(r90BB8Copula(c(-1,-0.5)), dCopula, zlim = c(0,10)) -> persp(r270BB8Copula(c(-1,-0.5)), dCopula, zlim = c(0,10)) +> persp(BB8Copula(c(2,0.9)), dCopula, zlim = c(0,10)) +> persp(surBB8Copula(c(2,0.9)), dCopula, zlim = c(0,10)) +> persp(r90BB8Copula(c(-2,-0.9)), dCopula, zlim = c(0,10)) +> persp(r270BB8Copula(c(-2,-0.9)), dCopula, zlim = c(0,10)) > > > @@ -430,6 +429,29 @@ > > > cleanEx() +> nameEx("BiCop") +> ### * BiCop +> +> flush(stderr()); flush(stdout()) +> +> ### Name: BiCop +> ### Title: Cunstructing BiCop-objects +> ### Aliases: BiCop +> +> ### ** Examples +> +> ## create BiCop object for bivariate t-copula +> obj <- BiCop(family = 2, par = 0.4, par2 = 6) +> +> ## a selection of function that can be used with BiCop objects +> simdata <- BiCopSim(300, obj) # simulate data +> BiCopPDF(0.5, 0.5, obj) # evaluate density in (0.5,0.5) +[1] 1.185466 +> plot(obj) # normal contour plot +> +> +> +> cleanEx() > nameEx("BiCopCDF") > ### * BiCopCDF > @@ -441,10 +463,10 @@ > > ### ** Examples > -> # simulate from a bivariate Clayton +> ## simulate from a bivariate Clayton > simdata <- BiCopSim(300, 3, 3.4) > -> # evaluate the distribution function of the bivariate t-copula +> ## evaluate the distribution function of the bivariate Clayton copula > u1 <- simdata[,1] > u2 <- simdata[,2] > BiCopCDF(u1, u2, 3, 3.4) @@ -499,8 +521,62 @@ [289] 0.544744934 0.786205589 0.344101052 0.302395620 0.488473797 0.066509090 [295] 0.889908357 0.401278597 0.705956499 0.752430964 0.408975709 0.316904963 > +> ## estimate a bivariate copula from the data and evaluate its CDF +> cop <- BiCopSelect(u1, u2) +> BiCopCDF(u1, u2, cop) + [1] 0.213216361 0.561008774 0.197236168 0.860096106 0.334804311 0.139513635 + [7] 0.554371769 0.658277825 0.716335159 0.359996241 0.657527529 0.407697840 + [13] 0.216399514 0.010822285 0.681623292 0.430807824 0.338131450 0.755860247 + [19] 0.479629602 0.592911839 0.744537845 0.685541705 0.503124391 0.019829322 + [25] 0.674830291 0.462498913 0.319578089 0.041980793 0.273789767 0.541308396 + [31] 0.691557591 0.359030873 0.479907006 0.451671644 0.081941037 0.326676238 + [37] 0.271528622 0.464832278 0.698735220 0.770415516 0.403785409 0.311398528 + [43] 0.527923774 0.441572279 0.158513265 0.126258223 0.623954559 0.740551781 + [49] 0.373484916 0.724368183 0.518481361 0.269859897 0.447276229 0.109997213 + [55] 0.822869960 0.909410754 0.296176897 0.055377098 0.427911236 0.404784905 + [61] 0.845634223 0.326501237 0.632198210 0.358961615 0.204261745 0.321831983 + [67] 0.032299365 0.826675443 0.486459913 0.844530768 0.609772903 0.176481229 + [73] 0.610563572 0.164521992 0.101841370 0.539808836 0.276047786 0.340570883 + [79] 0.294963515 0.196305998 0.278249224 0.422886796 0.721156144 0.050056254 + [85] 0.566950501 0.606857037 0.692705135 0.371692154 0.603090792 0.592001660 + [91] 0.202603930 0.759150340 0.601440022 0.705542175 0.823406212 0.575818547 + [97] 0.099324759 0.252486045 0.106402718 0.301726125 0.190263156 0.385015452 +[103] 0.156881388 0.354530035 0.238724108 0.570046601 0.754230654 0.627653964 +[109] 0.642831097 0.746688916 0.175146559 0.277849264 0.793720035 0.128553546 +[115] 0.403976552 0.219780393 0.338751489 0.359832271 0.604571311 0.360483725 +[121] 0.271877924 0.585222654 0.292663715 0.271907811 0.454380558 0.750324545 +[127] 0.421278359 0.293873718 0.212588231 0.367609085 0.405294134 0.264149235 +[133] 0.467605133 0.060701786 0.415778051 0.037737876 0.255996211 0.206230706 +[139] 0.175224244 0.451084944 0.024154988 0.704412381 0.030736108 0.211272774 +[145] 0.094320757 0.143308328 0.761505765 0.466102570 0.061359945 0.049688157 +[151] 0.395313338 0.414980517 0.374520908 0.168809829 0.055903281 0.097611365 +[157] 0.781513222 0.228932219 0.065998964 0.871116495 0.511827844 0.405356930 +[163] 0.846018444 0.768864981 0.252745335 0.746641034 0.381902257 0.061647496 +[169] 0.291561991 0.578402618 0.667172990 0.437995040 0.503339529 0.315656159 +[175] 0.344435118 0.260740693 0.644881631 0.736421169 0.481093613 0.748148132 +[181] 0.085457241 0.626432926 0.564624095 0.065960968 0.588497186 0.384957989 +[187] 0.665610581 0.183134099 0.323413243 0.151720473 0.378929204 0.653060795 +[193] 0.168820081 0.764722127 0.112658005 0.095183629 0.793406193 0.122514551 +[199] 0.507887441 0.228597453 0.450343689 0.931382639 0.877097675 0.351195641 +[205] 0.011010749 0.786592226 0.710039249 0.597790420 0.380147232 0.665689393 +[211] 0.375483599 0.427376357 0.282068634 0.084102394 0.814610670 0.515550764 +[217] 0.330500913 0.100246392 0.378522636 0.473694693 0.031611083 0.449222860 +[223] 0.218488453 0.362039582 0.067816097 0.801479944 0.248641760 0.049502885 +[229] 0.576543593 0.325042180 0.137649307 0.001613980 0.257523528 0.475176385 +[235] 0.439159996 0.456422134 0.579207899 0.085554734 0.716050141 0.459345035 +[241] 0.499019090 0.839125240 0.504927825 0.045352070 0.556467125 0.022452326 +[247] 0.195166493 0.336067118 0.375265178 0.438435095 0.510523722 0.600837658 +[253] 0.469138872 0.388417996 0.657056326 0.736128168 0.007593754 0.491003015 +[259] 0.563750426 0.304066745 0.767631062 0.219407620 0.382023356 0.756210444 +[265] 0.955928178 0.272406638 0.252683608 0.057525544 0.290619802 0.156634778 +[271] 0.394069415 0.509030666 0.121131637 0.799042254 0.524954532 0.767819462 +[277] 0.010814273 0.620809014 0.047650019 0.787493128 0.414902775 0.319504795 +[283] 0.836079497 0.219601321 0.278258568 0.130653678 0.147888465 0.716106630 +[289] 0.546417874 0.786877612 0.344434356 0.302831019 0.490246935 0.066866270 +[295] 0.890101345 0.402804874 0.707038001 0.753313037 0.410718305 0.318459416 > > +> > cleanEx() > nameEx("BiCopChiPlot") > ### * BiCopChiPlot @@ -547,10 +623,10 @@ > > ### ** Examples > -> # simulate from a bivariate t-copula +> ## simulate from a bivariate t-copula > simdata <- BiCopSim(300, 2, -0.7, par2 = 4) > -> # derivative of the bivariate t-copula with respect to the first parameter +> ## derivative of the bivariate t-copula with respect to the first parameter > u1 <- simdata[,1] > u2 <- simdata[,2] > BiCopDeriv(u1, u2, 2, -0.7, par2 = 4, deriv = "par") @@ -615,8 +691,73 @@ [291] 1.307238920 1.553288676 -2.277551572 -4.393119872 1.180012547 [296] -1.006935254 -0.716277972 -0.594563456 -2.172846043 -1.984262894 > +> ## estimate a bivariate copula from the data +> ## and evaluate its derivative w.r.t. the parameter +> cop <- BiCopEst(u1, u2, family = 2) +> BiCopDeriv(u1, u2, cop, deriv = "par") + [1] -1.07402602 1.37042330 -0.64372355 0.62196733 1.35466362 + [6] 1.28034577 -2.98767753 -2.68934278 0.96820579 -1.18745623 + [11] -12.05303853 0.17400295 -1.26038597 0.97921453 -5.90195029 + [16] -2.20309341 0.15346666 -0.13257668 -0.79676426 -3.18269540 + [21] -0.46886149 -1.97214553 -0.04068413 -4.35098126 -0.25170332 + [26] 0.64162638 -0.29860471 1.39128233 -2.65398260 -2.83465866 + [31] -8.82492615 -1.41004765 -1.92194270 -0.62895120 -6.37084242 + [36] -0.54997370 -0.91969868 1.02541436 -5.06575257 1.31313438 + [41] -1.56012220 -1.05758140 -2.49591265 -0.20473843 1.36872194 + [46] 1.43896198 1.27571131 1.05676245 -2.05702485 -1.14326167 + [51] -2.69550025 1.65418013 -1.17043342 -2.58657139 -0.84939513 + [56] 2.27583602 -1.98686536 0.95988528 0.19285155 -2.11724625 + [61] -11.65595583 0.36322584 -3.08999263 -0.22404972 -3.58513454 + [66] 1.25983646 -14.33445072 -0.84247371 -2.36652023 -6.80051662 + [71] -1.55887500 0.45862097 -2.98469253 -4.64768025 -5.23078174 + [76] -2.12934188 -2.14025942 0.18848780 1.35353859 0.76859877 + [81] 0.15438211 -0.65622644 -5.02163898 0.57066834 -3.24816757 + [86] 0.95825001 -4.86719603 0.72520493 -0.06732159 1.38224945 + [91] 0.91151793 -3.08225619 -5.87032957 0.24914136 -2.26983278 + [96] -3.15986098 -1.52524738 -3.14449993 -5.82427832 -1.70624895 +[101] 0.74966685 -1.03664334 -3.08265890 0.59877098 -3.23350140 +[106] -13.12286946 1.40599543 -4.67879232 1.46973879 -12.71655787 +[111] 1.20661671 -2.58890708 -3.24971295 1.39714761 0.24807573 +[116] 1.24416666 -2.56239814 -2.09633371 -2.04332203 -2.25888136 +[121] -2.97213832 -6.79947280 0.22568825 1.03514235 1.48383935 +[126] 1.46496733 -2.22433918 1.11988054 -2.60957813 1.31050648 +[131] -1.60083608 -2.12394834 -1.04103839 -12.17702297 -0.37995002 +[136] 1.42829180 0.82259284 0.88634412 1.10884764 -0.57920484 +[141] -7.37451534 -5.77654941 1.58514075 1.13307793 1.25119672 +[146] 1.44310696 -27.89778120 -1.44327977 1.50769139 -5.32549061 +[151] 0.64309305 -2.38204539 1.40865566 -3.65932889 -0.79197797 +[156] 1.37487181 0.59177860 -2.54198800 0.06306557 0.32268877 +[161] -2.55566841 1.10525515 1.24658181 1.05556276 -2.62408820 +[166] -41.96645377 -0.52347133 -0.06669671 0.73877395 1.43207881 +[171] -71.38303394 -2.21142574 -2.29709032 0.45254066 -1.92392828 +[176] 1.47393763 -3.59695663 -32.92692237 -0.69491217 -3.81908780 +[181] 0.20201024 -5.14029364 0.77533235 -10.36165562 -2.79973699 +[186] -2.47533166 -11.10477575 -1.59950810 -0.11697461 -2.70627739 +[191] -2.49218341 1.27334241 0.67035122 1.33184077 1.59142360 +[196] 1.50843176 -3.39022289 -0.28678539 -2.50819338 1.11018708 +[201] -0.96055861 1.34683567 1.41166327 -1.22007225 -27.37125299 +[206] -57.62031303 0.91248907 -2.74088446 -1.34347480 0.99825856 +[211] -2.47712697 -0.24330093 -1.71237804 -1.74991952 1.51140412 +[216] -3.80820550 -2.60729926 -7.22111758 1.32951572 1.33356671 +[221] 1.50705655 -2.07321492 -1.72157373 1.40459293 1.34526831 +[226] -8.34515941 0.85233987 -11.19796244 1.21200950 1.35268254 +[231] -2.44372785 -4.42761130 1.09809566 -1.15547793 -1.52676238 +[236] 1.54151697 -3.15037909 1.18963888 -4.25588064 -1.38534381 +[241] -1.59218149 1.29971351 -2.44846117 0.72513278 -4.15239402 +[246] -11.88232111 1.13592511 -2.26052491 -2.48119356 0.72178433 +[251] -1.12588905 -0.93363293 1.53441967 0.08589610 -2.25042260 +[256] -3.77424843 -73.17491447 -1.63156806 -2.20551357 -2.79762544 +[261] 0.40220022 1.26275596 1.25120452 0.81834036 0.95740256 +[266] 1.60954473 -0.20156744 1.16728068 -1.05649474 -4.47171694 +[271] 1.55141609 -2.56420784 1.49924558 -71.13310806 -0.57123567 +[276] -1.56408563 -49.80547361 -3.70029259 1.15236406 1.37663360 +[281] 0.01564266 -2.10994044 0.73222237 -3.64342657 1.55911728 +[286] -1.44119111 1.49661090 -2.41277164 -2.86366925 0.78398052 +[291] 1.46863332 1.62659023 -2.54797876 -4.48187041 1.62781393 +[296] -0.95598676 -0.58419738 -0.40475104 -2.43389298 -2.17743788 > > +> > cleanEx() > nameEx("BiCopDeriv2") > ### * BiCopDeriv2 @@ -629,10 +770,10 @@ > > ### ** Examples > -> # simulate from a bivariate t-copula +> ## simulate from a bivariate t-copula > simdata <- BiCopSim(300, 2, -0.7, par2 = 4) > -> # second derivative of the bivariate t-copula with respect to the first parameter +> ## second derivative of the bivariate t-copula with respect to the first parameter > u1 <- simdata[,1] > u2 <- simdata[,2] > BiCopDeriv2(u1, u2, 2, -0.7, par2 = 4, deriv = "par") @@ -697,8 +838,73 @@ [291] -9.6068616 -8.6709300 12.2354089 11.2373337 -17.6110050 [296] 2.1594059 -0.8513871 -2.9233828 12.0301834 10.0336656 > +> ## estimate a bivariate copula from the data and evaluate its derivative +> cop <- BiCopEst(u1, u2, family = 2) +> BiCopDeriv2(u1, u2, cop, deriv = "par") + [1] 1.52572159 -6.85383040 -9.44469977 -16.32525875 -9.55003371 + [6] -7.49189953 16.11886292 11.88475842 1.12516154 1.76278713 + [11] 53.13556067 -7.46998617 2.77731540 -45.65415552 28.49029946 + [16] 11.90780320 -4.91690702 -5.87744491 -8.28398244 16.96124372 + [21] -4.15612698 6.21419993 -3.74266436 -18.89105926 -3.21917413 + [26] -7.21258431 -2.12574147 -2.20855663 14.07304691 15.60206392 + [31] 42.01154177 5.51168259 6.87777116 -0.59884327 9.15581586 + [36] -3.72921785 1.62070731 -8.08693394 23.30681283 -0.58228463 + [41] 5.79401112 2.86415413 6.73131836 -7.34022882 -6.68192352 + [46] -2.19426102 -6.91754143 -7.75769697 10.78925089 -0.16713918 + [51] 14.09381072 -4.08093892 1.29841589 5.31301947 -9.68283213 + [56] -19.88390531 9.54000088 1.74898803 -9.42116404 10.77990911 + [61] -46.76728653 -5.80738955 15.42864029 -3.03725763 18.38371365 + [66] -8.74143769 55.40298840 -10.39419043 13.35792258 -26.86158001 + [71] 5.75242155 -6.58981117 15.44839278 20.60276477 8.52308118 + [76] 10.99536460 10.32501426 -5.14721330 -7.89683772 -6.99225511 + [81] -9.23997435 -0.81471939 21.15221838 -14.85381904 16.64580619 + [86] -7.06956998 22.65949093 -8.87719849 -3.42677389 -6.60384596 + [91] -7.12852012 6.94085564 20.78419292 -5.83102631 -7.62961596 + [96] 16.92915905 -18.71434726 16.84376192 15.89941804 3.96790777 +[101] -7.03162148 2.31872033 12.45370947 -7.56345940 14.81412504 +[106] 13.32293093 -1.66924297 22.97270938 -2.96143468 54.01301009 +[111] -7.22708541 13.69281721 2.25464559 -1.56087395 -6.43850278 +[116] -6.97870795 13.66361248 9.56672742 9.25217102 12.40401371 +[121] 16.14987887 15.92912889 -4.83818908 -7.33854205 -7.25834817 +[126] -2.72646683 12.01632479 -7.76461529 11.91694485 -9.59809604 +[131] 6.65643507 5.66216917 -1.85834594 56.84506254 -3.77493847 +[136] -2.66998238 -6.85871547 -7.07406600 -7.39481902 -0.94206569 +[141] 1.25785753 26.59136030 -4.51237277 -7.12932869 -9.17972725 +[146] -6.11200548 111.95951267 5.62925744 -3.93395657 -24.55524317 [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/vinecopula -r 100 From noreply at r-forge.r-project.org Tue Jun 23 21:51:11 2015 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 23 Jun 2015 21:51:11 +0200 (CEST) Subject: [Vinecopula-commits] r101 - pkg/src Message-ID: <20150623195111.23A60183D7F@r-forge.r-project.org> Author: tnagler Date: 2015-06-23 21:51:10 +0200 (Tue, 23 Jun 2015) New Revision: 101 Modified: pkg/src/hfunc.c Log: hfunc.c: increased accuracy of numerical inversion of h-functions (for BBs and Tawns) Modified: pkg/src/hfunc.c =================================================================== --- pkg/src/hfunc.c 2015-06-05 09:59:06 UTC (rev 100) +++ pkg/src/hfunc.c 2015-06-23 19:51:10 UTC (rev 101) @@ -930,7 +930,7 @@ { int br=0, in=1; - double ans=0.0, tol=0.000001, x0=UMIN, x1=UMAX, fl, fh, val; + double ans=0.0, tol=UMIN, x0=UMIN, x1=UMAX, fl, fh, val; //Rprintf("family in HNumInv: %d\n", *family); Hfunc1(family,&in,&x0,v,theta,nu,&fl); fl -= *u; Hfunc1(family,&in,&x1,v,theta,nu,&fh); fh -= *u;