From noreply at r-forge.r-project.org Mon May 25 16:52:12 2015 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 25 May 2015 16:52:12 +0200 (CEST) Subject: [spcopula-commits] r142 - pkg Message-ID: <20150525145212.DCD4318798B@r-forge.r-project.org> Author: ben_graeler Date: 2015-05-25 16:52:12 +0200 (Mon, 25 May 2015) New Revision: 142 Modified: pkg/DESCRIPTION Log: - issue rebuild on r-forge Modified: pkg/DESCRIPTION =================================================================== --- pkg/DESCRIPTION 2015-04-27 13:55:03 UTC (rev 141) +++ pkg/DESCRIPTION 2015-05-25 14:52:12 UTC (rev 142) @@ -2,7 +2,7 @@ Type: Package Title: copula driven spatial analysis Version: 0.2-1 -Date: 2015-02-06 +Date: 2015-05-25 Authors at R: c(person("Benedikt", "Graeler", role = c("aut", "cre"), email = "ben.graeler at uni-muenster.de"), person("Marius", "Appel",role = "ctb")) From noreply at r-forge.r-project.org Mon May 25 18:10:32 2015 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 25 May 2015 18:10:32 +0200 (CEST) Subject: [spcopula-commits] r143 - in pkg: R man Message-ID: <20150525161032.1822518473E@r-forge.r-project.org> Author: ben_graeler Date: 2015-05-25 18:10:31 +0200 (Mon, 25 May 2015) New Revision: 143 Modified: pkg/R/KendallDistribution.R pkg/man/dependencePlot.Rd pkg/man/spcopula-package.Rd Log: - few doc error corrections Modified: pkg/R/KendallDistribution.R =================================================================== --- pkg/R/KendallDistribution.R 2015-05-25 14:52:12 UTC (rev 142) +++ pkg/R/KendallDistribution.R 2015-05-25 16:10:31 UTC (rev 143) @@ -1,238 +1,234 @@ -# derivation of kendall distributions in higher dimensions for Archimedean copulas - -########### -## Frank ## -########### - -# generator -genFrank <- function(t, theta) copFrank at iPsi(t, theta) -# -log( (exp(-theta*u)-1) / (exp(-theta)-1) ) - -# use series expansion for small u? -d1genFrank <- function(t, theta) { - theta / (1 - exp(theta * t)) -} - -d2genFrank <- function(t, theta) { - (theta^2 * exp(theta * t)) / (1 - exp(theta * t))^2 -} - -d3genFrank <- function(t, theta) { - -(theta^3 * exp(theta*t) * (exp(theta * t) + 1))/(exp(theta * t)-1)^3 -} - -## inverse generator -igenFrank <- function(s, theta) copFrank at psi(s, theta) -# -log(1-(1-exp(-theta))*exp(-t))/theta - -d1igenFrank <- function(s, theta) { - eth <- exp(theta) - (1 - eth) / (theta * (-eth + 1 + exp(theta + s))) -} - -d2igenFrank <- function(s, theta) { - eth <- exp(theta) - eths <- exp(theta + s) - ((eth-1) * eths) / (theta * (-eth + eths + 1)^2) -} - -d3igenFrank <- function(s, theta) { - eth <- exp(theta) - eths <- exp(theta + s) - ((eth - 1) * eths) / (theta * (-eth + eths + 1)^2)-(2*(eth-1) * exp(2 * theta + 2 * s))/(theta * (-eth + eths + 1)^3) -} - -kdFrank <- function(t, cop) { - # K^d (t) = t + sum_{i=1}^{d-1} (?1)^i/i! \varphi(t)^i (\varphi^{-1})^(i)(\varphi(t)) - stopifnot(cop at dimension <=4) - .theta <- cop at parameters - .val <- 0 < t & t < 1 - - gt <- genFrank(t[.val], .theta) - sum1 <- 0 - for (i in 1:(cop at dimension-1)) { - digen <- switch(i, - d1igenFrank(gt, .theta), - d2igenFrank(gt, .theta), - d3igenFrank(gt, .theta)) - sum1 <- sum1 + (-1)^i/factorial(i) * gt^i * digen - } - - res <- t - res[.val] <- res[.val] + sum1 - res -} - -setMethod("kendall", signature("numeric", "frankCopula"), function(t, copula) kdFrank(t, copula)) - -################### -## Gumbel Copula ## -################### -# generator -genGumbel <- function(t, theta) copGumbel at iPsi(t, theta) -# -log(t)^theta - -# d1genGumbel <- function(t, theta) {} -# d2genGumbel <- function(t, theta) {} -# d3genGumbel <- function(t, theta) {} - -## inverse generator -igenGumbel <- function(s, theta) copGumbel at psi(s, theta) -# exp(-s^(1/theta)) - -d1igenGumbel <- function(s, theta) { - -(exp(-s^(1/theta)) * s^(1/theta-1))/theta -} - -d2igenGumbel <- function(s, theta) { - s1th <- s^(1/theta) - (exp(-s1th) * s^(1/theta-2) * (theta+s1th-1))/theta^2 -} - -d3igenGumbel <- function(s, theta) { - s1th <- s^(1/theta) - ems1th <- exp(-s1th) - s2th3 <- s^(2 / theta - 3) - -(ems1th * (theta + s1th - 1) * s2th3) / (theta^3 + ems1th * s2th3) / theta^3 + ( (1 / theta - 2) * ems1th * (theta + s1th-1) * s^(1 / theta - 3)) / theta^2 -} - -kdGumbel <- function(t, cop) { - # K^d (t) = t + sum_{i=1}^{d-1} (?1)^i/i! \varphi(t)^i (\varphi^{-1})^(i)(\varphi(t)) - stopifnot(cop at dimension <=4) - .theta <- cop at parameters - .val <- 0 < t & t < 1 - - gt <- genGumbel(t[.val], .theta) - sum1 <- 0 - for (i in 1:(cop at dimension-1)) { - digen <- switch(i, - d1igenGumbel(gt, .theta), - d2igenGumbel(gt, .theta), - d3igenGumbel(gt, .theta)) - sum1 <- sum1 + (-1)^i/factorial(i) * gt^i * digen - } - - res <- t - res[.val] <- res[.val] + sum1 - res -} - -setMethod("kendall", signature("numeric", "gumbelCopula"), function(t, copula) kdGumbel(t, copula)) - -############# -## Clayton ## -############# - -# generator -genClayton <- function(t, theta) copClayton at iPsi(t, theta) -# u^(-theta) - 1 - -# d1genClayton <- function(t, theta) {} -# d2genClayton <- function(t, theta) {} -# d3genClayton <- function(t, theta) {} - -## inverse generator -igenClayton <- function(s, theta) copClayton at psi(s, theta) -# (1 + t)^(-1/theta) - -d1igenClayton <- function(s, theta) { - -(s+1)^(-(theta+1)/theta)/theta -} - -d2igenClayton <- function(s, theta) { - ((theta + 1) * (s + 1)^(-1 / theta - 2)) / theta^2 -} - -d3igenClayton <- function(s, theta) { - -((theta + 1) * (2 * theta + 1) * (s + 1)^(-1 / theta - 3)) / theta^3 -} - -kdClayton <- function(t, cop) { - # K^d (t) = t + sum_{i=1}^{d-1} (?1)^i/i! \varphi(t)^i (\varphi^{-1})^(i)(\varphi(t)) - stopifnot(cop at dimension <=4) - .theta <- cop at parameters - .val <- 0 < t & t < 1 - - gt <- genClayton(t[.val], .theta) - sum1 <- 0 - for (i in 1:(cop at dimension-1)) { - digen <- switch(i, - d1igenClayton(gt, .theta), - d2igenClayton(gt, .theta), - d3igenClayton(gt, .theta)) - sum1 <- sum1 + (-1)^i/factorial(i) * gt^i * digen - } - - res <- t - res[.val] <- res[.val] + sum1 - res -} - -setMethod("kendall", signature("numeric", "claytonCopula"), function(t, copula) kdClayton(t, copula)) - -######### -## Joe ## -######### - - -# generator -genJoe <- function(t, theta) copJoe at iPsi(t, theta) -# -log(1-(1 - t)^theta) - -# d1genClayton <- function(t, theta) {} -# d2genClayton <- function(t, theta) {} -# d3genClayton <- function(t, theta) {} - -## inverse generator -igenJoe <- function(s, theta) copJoe at psi(s, theta) -# 1 - (1 - exp(-s))^(1 / theta) - -d1igenJoe <- function(s, theta) { - ( -expm1(-s))^(1/theta)/(theta-theta * exp(s)) -} - -d2igenJoe <- function(s, theta) { - exps <- exp(s) - expm1ms <- expm1(-s) - expm1s <- expm1(s) - - ((-expm1ms)^(1/theta) * (theta * exps - 1))/(theta * expm1s)^2 -} - -# (e^(-s) (1-e^(-s))^(1/theta-1))/(theta (theta-theta e^s)) -# (theta e^s (1-e^(-s))^(1/theta))/(theta-theta e^s)^2 - -d3igenJoe <- function(s, theta) { - exps <- exp(s) - expm1ms <- expm1(-s) - expm1s <- expm1(s) - - ds1 <- (-expm1ms)^(1 / theta) * (2 * theta * exps - 1) - ds2 <- -theta * (exps * (-expm1ms)^(1/theta) * (theta + theta * exps - 1)) - - (ds1 + ds2) / (theta * expm1s)^3 -} - -kdJoe <- function(t, cop) { - # K^d (t) = t + sum_{i=1}^{d-1} (?1)^i/i! \varphi(t)^i (\varphi^{-1})^(i)(\varphi(t)) - stopifnot(cop at dimension <= 4) - .theta <- cop at parameters - .val <- 0 < t & t < 1 - - gt <- genJoe(t[.val], .theta) - sum1 <- 0 - for (i in 1:(cop at dimension-1)) { - digen <- switch(i, - d1igenJoe(gt, .theta), - d2igenJoe(gt, .theta), - d3igenJoe(gt, .theta)) - sum1 <- sum1 + (-1)^i/factorial(i) * gt^i * digen - } - - res <- t - res[.val] <- res[.val] + sum1 - res -} - -setMethod("kendall", signature("numeric", "joeCopula"), function(t, copula) kdJoe(t, copula)) +# derivation of kendall distributions in higher dimensions for Archimedean copulas + +########### +## Frank ## +########### + +# generator +genFrank <- function(t, theta) copFrank at iPsi(t, theta) +# -log( (exp(-theta*u)-1) / (exp(-theta)-1) ) + +# use series expansion for small u? +d1genFrank <- function(t, theta) { + theta / (1 - exp(theta * t)) +} + +d2genFrank <- function(t, theta) { + (theta^2 * exp(theta * t)) / (1 - exp(theta * t))^2 +} + +d3genFrank <- function(t, theta) { + -(theta^3 * exp(theta*t) * (exp(theta * t) + 1))/(exp(theta * t)-1)^3 +} + +## inverse generator +igenFrank <- function(s, theta) copFrank at psi(s, theta) +# -log(1-(1-exp(-theta))*exp(-t))/theta + +d1igenFrank <- function(s, theta) { + eth <- exp(theta) + (1 - eth) / (theta * (-eth + 1 + exp(theta + s))) +} + +d2igenFrank <- function(s, theta) { + eth <- exp(theta) + eths <- exp(theta + s) + ((eth-1) * eths) / (theta * (-eth + eths + 1)^2) +} + +d3igenFrank <- function(s, theta) { + eth <- exp(theta) + eths <- exp(theta + s) + ((eth - 1) * eths) / (theta * (-eth + eths + 1)^2)-(2*(eth-1) * exp(2 * theta + 2 * s))/(theta * (-eth + eths + 1)^3) +} + +kdFrank <- function(t, cop) { + stopifnot(cop at dimension <=4) + .theta <- cop at parameters + .val <- 0 < t & t < 1 + + gt <- genFrank(t[.val], .theta) + sum1 <- 0 + for (i in 1:(cop at dimension-1)) { + digen <- switch(i, + d1igenFrank(gt, .theta), + d2igenFrank(gt, .theta), + d3igenFrank(gt, .theta)) + sum1 <- sum1 + (-1)^i/factorial(i) * gt^i * digen + } + + res <- t + res[.val] <- res[.val] + sum1 + res +} + +setMethod("kendall", signature("numeric", "frankCopula"), function(t, copula) kdFrank(t, copula)) + +################### +## Gumbel Copula ## +################### +# generator +genGumbel <- function(t, theta) copGumbel at iPsi(t, theta) +# -log(t)^theta + +# d1genGumbel <- function(t, theta) {} +# d2genGumbel <- function(t, theta) {} +# d3genGumbel <- function(t, theta) {} + +## inverse generator +igenGumbel <- function(s, theta) copGumbel at psi(s, theta) +# exp(-s^(1/theta)) + +d1igenGumbel <- function(s, theta) { + -(exp(-s^(1/theta)) * s^(1/theta-1))/theta +} + +d2igenGumbel <- function(s, theta) { + s1th <- s^(1/theta) + (exp(-s1th) * s^(1/theta-2) * (theta+s1th-1))/theta^2 +} + +d3igenGumbel <- function(s, theta) { + s1th <- s^(1/theta) + ems1th <- exp(-s1th) + s2th3 <- s^(2 / theta - 3) + -(ems1th * (theta + s1th - 1) * s2th3) / (theta^3 + ems1th * s2th3) / theta^3 + ( (1 / theta - 2) * ems1th * (theta + s1th-1) * s^(1 / theta - 3)) / theta^2 +} + +kdGumbel <- function(t, cop) { + stopifnot(cop at dimension <=4) + .theta <- cop at parameters + .val <- 0 < t & t < 1 + + gt <- genGumbel(t[.val], .theta) + sum1 <- 0 + for (i in 1:(cop at dimension-1)) { + digen <- switch(i, + d1igenGumbel(gt, .theta), + d2igenGumbel(gt, .theta), + d3igenGumbel(gt, .theta)) + sum1 <- sum1 + (-1)^i/factorial(i) * gt^i * digen + } + + res <- t + res[.val] <- res[.val] + sum1 + res +} + +setMethod("kendall", signature("numeric", "gumbelCopula"), function(t, copula) kdGumbel(t, copula)) + +############# +## Clayton ## +############# + +# generator +genClayton <- function(t, theta) copClayton at iPsi(t, theta) +# u^(-theta) - 1 + +# d1genClayton <- function(t, theta) {} +# d2genClayton <- function(t, theta) {} +# d3genClayton <- function(t, theta) {} + +## inverse generator +igenClayton <- function(s, theta) copClayton at psi(s, theta) +# (1 + t)^(-1/theta) + +d1igenClayton <- function(s, theta) { + -(s+1)^(-(theta+1)/theta)/theta +} + +d2igenClayton <- function(s, theta) { + ((theta + 1) * (s + 1)^(-1 / theta - 2)) / theta^2 +} + +d3igenClayton <- function(s, theta) { + -((theta + 1) * (2 * theta + 1) * (s + 1)^(-1 / theta - 3)) / theta^3 +} + +kdClayton <- function(t, cop) { + stopifnot(cop at dimension <=4) + .theta <- cop at parameters + .val <- 0 < t & t < 1 + + gt <- genClayton(t[.val], .theta) + sum1 <- 0 + for (i in 1:(cop at dimension-1)) { + digen <- switch(i, + d1igenClayton(gt, .theta), + d2igenClayton(gt, .theta), + d3igenClayton(gt, .theta)) + sum1 <- sum1 + (-1)^i/factorial(i) * gt^i * digen + } + + res <- t + res[.val] <- res[.val] + sum1 + res +} + +setMethod("kendall", signature("numeric", "claytonCopula"), function(t, copula) kdClayton(t, copula)) + +######### +## Joe ## +######### + + +# generator +genJoe <- function(t, theta) copJoe at iPsi(t, theta) +# -log(1-(1 - t)^theta) + +# d1genClayton <- function(t, theta) {} +# d2genClayton <- function(t, theta) {} +# d3genClayton <- function(t, theta) {} + +## inverse generator +igenJoe <- function(s, theta) copJoe at psi(s, theta) +# 1 - (1 - exp(-s))^(1 / theta) + +d1igenJoe <- function(s, theta) { + ( -expm1(-s))^(1/theta)/(theta-theta * exp(s)) +} + +d2igenJoe <- function(s, theta) { + exps <- exp(s) + expm1ms <- expm1(-s) + expm1s <- expm1(s) + + ((-expm1ms)^(1/theta) * (theta * exps - 1))/(theta * expm1s)^2 +} + +# (e^(-s) (1-e^(-s))^(1/theta-1))/(theta (theta-theta e^s)) +# (theta e^s (1-e^(-s))^(1/theta))/(theta-theta e^s)^2 + +d3igenJoe <- function(s, theta) { + exps <- exp(s) + expm1ms <- expm1(-s) + expm1s <- expm1(s) + + ds1 <- (-expm1ms)^(1 / theta) * (2 * theta * exps - 1) + ds2 <- -theta * (exps * (-expm1ms)^(1/theta) * (theta + theta * exps - 1)) + + (ds1 + ds2) / (theta * expm1s)^3 +} + +kdJoe <- function(t, cop) { + stopifnot(cop at dimension <= 4) + .theta <- cop at parameters + .val <- 0 < t & t < 1 + + gt <- genJoe(t[.val], .theta) + sum1 <- 0 + for (i in 1:(cop at dimension-1)) { + digen <- switch(i, + d1igenJoe(gt, .theta), + d2igenJoe(gt, .theta), + d3igenJoe(gt, .theta)) + sum1 <- sum1 + (-1)^i/factorial(i) * gt^i * digen + } + + res <- t + res[.val] <- res[.val] + sum1 + res +} + +setMethod("kendall", signature("numeric", "joeCopula"), function(t, copula) kdJoe(t, copula)) setMethod("kendall", signature("numeric", "joeBiCopula"), function(t, copula) kdJoe(t, copula)) \ No newline at end of file Modified: pkg/man/dependencePlot.Rd =================================================================== --- pkg/man/dependencePlot.Rd 2015-05-25 14:52:12 UTC (rev 142) +++ pkg/man/dependencePlot.Rd 2015-05-25 16:10:31 UTC (rev 143) @@ -7,10 +7,10 @@ Plots a kernel smoothed scatter plot of the provided rank-transformed sample. The work is done by the function \code{\link{panel.smoothScatter}}. } \usage{ -dependencePlot(var = NULL, smpl, bandwidth = 0.075, main="Stength of dependence", +dependencePlot(var = NULL, smpl, bandwidth = 0.075, main="Strength of dependence", transformation = function(x) x, margin=NULL, ...) } -%- maybe also 'usage' for other objects documented here. + \arguments{ \item{var}{Column IDs or variable names to be used. If not provided, the first two columns will be used.} \item{smpl}{a matrix (two-columns at least) holding the data} Modified: pkg/man/spcopula-package.Rd =================================================================== --- pkg/man/spcopula-package.Rd 2015-05-25 14:52:12 UTC (rev 142) +++ pkg/man/spcopula-package.Rd 2015-05-25 16:10:31 UTC (rev 143) @@ -2,11 +2,9 @@ \alias{spcopula-package} \alias{spcopula} \docType{package} -\title{ -copula driven spatial analysis -} +\title{Copula Driven Spatio-Temporal Analysis} \description{ -This package provides a framework to analyse spatial data provided in the format of the \code{\link[sp:sp]{sp}} package with copulas. Additionally, support for calculating multivariate return periods is implemented. +A framework is provided to analyse spatial and spatio-temporal data with copulas and vine copulas. Data handled needs to be in the format of the sp or spacetime R packages respectively. Additionally, support for calculating multivariate return periods based on copulas and vine copulas is implemented. } \details{ \tabular{ll}{ From noreply at r-forge.r-project.org Tue May 26 16:41:36 2015 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 26 May 2015 16:41:36 +0200 (CEST) Subject: [spcopula-commits] r144 - in pkg: . demo man tests Message-ID: <20150526144136.1FBE5185157@r-forge.r-project.org> Author: ben_graeler Date: 2015-05-26 16:41:35 +0200 (Tue, 26 May 2015) New Revision: 144 Modified: pkg/DESCRIPTION pkg/NAMESPACE pkg/demo/MRP.R pkg/demo/pureSpVineCopula.R pkg/demo/stCoVarVineCop.R pkg/demo/stVineCopFit.R pkg/demo/tailDepFunctions.R pkg/man/condSpVine.Rd pkg/man/condStCoVarVine.Rd pkg/man/condStVine.Rd pkg/man/spCopPredict.Rd pkg/man/spVineCopula.Rd pkg/man/stCoVarVineCopula.Rd pkg/man/stCopPredict.Rd pkg/man/stVineCopula.Rd pkg/man/tailDepFun.Rd pkg/tests/spCopulaTest.Rout.save pkg/tests/stCopulaTest.Rout.save Log: - solved long lasting issue of warning on overloading pobs from copula by vineCopula on package installation Modified: pkg/DESCRIPTION =================================================================== --- pkg/DESCRIPTION 2015-05-25 16:10:31 UTC (rev 143) +++ pkg/DESCRIPTION 2015-05-26 14:41:35 UTC (rev 144) @@ -1,17 +1,17 @@ Package: spcopula Type: Package -Title: copula driven spatial analysis +Title: Copula Driven Spatio-Temporal Analysis Version: 0.2-1 -Date: 2015-05-25 +Date: 2015-05-26 Authors at R: c(person("Benedikt", "Graeler", role = c("aut", "cre"), email = "ben.graeler at uni-muenster.de"), person("Marius", "Appel",role = "ctb")) Maintainer: Benedikt Graeler -Description: This package provides a framework to analyse via copulas spatial and spatio-temporal data provided in the format of sp and spacetime package respectively. Additionally, support for calculating different multivariate return periods is implemented. +Description: We provide a framework to analyse spatial and spatio-temporal data via copulas and vine copulas. The data needs to be provided in the form of the sp and spacetime package respectively. Additionally, support for calculating different multivariate return periods based on copulas and vine copulas is implemented. License: GPL-3 LazyLoad: yes -Depends: copula (>= 0.999-12), VineCopula (>= 1.4), R (>= 3.1.0) -Imports: methods, sp, spacetime (>= 1.0-9) +Depends: copula (>= 0.999-12), R (>= 3.1.0) +Imports: methods, sp, spacetime (>= 1.0-9), VineCopula (>= 1.4) Suggests: evd URL: http://r-forge.r-project.org/projects/spcopula/ Collate: Modified: pkg/NAMESPACE =================================================================== --- pkg/NAMESPACE 2015-05-25 16:10:31 UTC (rev 143) +++ pkg/NAMESPACE 2015-05-26 14:41:35 UTC (rev 144) @@ -1,7 +1,35 @@ -import(copula, VineCopula) +import(copula) import(sp, spacetime) import(methods) +importMethodsFrom(VineCopula, fitCopula) +importMethodsFrom(VineCopula, dduCopula,ddvCopula) + +importFrom(VineCopula, BB1Copula, surBB1Copula, r90BB1Copula, r270BB1Copula) +importFrom(VineCopula, BB6Copula, surBB6Copula, r90BB6Copula, r270BB6Copula) +importFrom(VineCopula, BB7Copula, surBB7Copula, r90BB7Copula, r270BB7Copula) +importFrom(VineCopula, BB8Copula, surBB8Copula, r90BB8Copula, r270BB8Copula) +importFrom(VineCopula, joeBiCopula, surJoeBiCopula, r90JoeBiCopula, r270JoeBiCopula) +importFrom(VineCopula, surClaytonCopula, r90ClaytonCopula, r270ClaytonCopula) +importFrom(VineCopula, surGumbelCopula, r90GumbelCopula, r270GumbelCopula) +importFrom(VineCopula, tawnT1Copula, surTawnT1Copula, r90TawnT1Copula, r270TawnT1Copula) +importFrom(VineCopula, tawnT2Copula, surTawnT2Copula, r90TawnT2Copula, r270TawnT2Copula) +importFrom(VineCopula, vineCopula) +importFrom(VineCopula, copulaFromFamilyIndex) +importFrom(VineCopula, TauMatrix, BiCopSelect) + +importClassesFrom(VineCopula, BB1Copula, surBB1Copula, r90BB1Copula, r270BB1Copula) +importClassesFrom(VineCopula, BB6Copula, surBB6Copula, r90BB6Copula, r270BB6Copula) +importClassesFrom(VineCopula, BB7Copula, surBB7Copula, r90BB7Copula, r270BB7Copula) +importClassesFrom(VineCopula, BB8Copula, surBB8Copula, r90BB8Copula, r270BB8Copula) +importClassesFrom(VineCopula, joeBiCopula, surJoeBiCopula, r90JoeBiCopula, r270JoeBiCopula) +importClassesFrom(VineCopula, surClaytonCopula, r90ClaytonCopula, r270ClaytonCopula) +importClassesFrom(VineCopula, surGumbelCopula, r90GumbelCopula, r270GumbelCopula) +importClassesFrom(VineCopula, tawnT1Copula, surTawnT1Copula, r90TawnT1Copula, r270TawnT1Copula) +importClassesFrom(VineCopula, tawnT2Copula, surTawnT2Copula, r90TawnT2Copula, r270TawnT2Copula) +importClassesFrom(VineCopula, vineCopula) + + # constructor export(asCopula, cqsCopula) export(tawn3pCopula) Modified: pkg/demo/MRP.R =================================================================== --- pkg/demo/MRP.R 2015-05-25 16:10:31 UTC (rev 143) +++ pkg/demo/MRP.R 2015-05-26 14:41:35 UTC (rev 144) @@ -1,3 +1,5 @@ +library("VineCopula") + ## get the data data("simulatedTriples") Modified: pkg/demo/pureSpVineCopula.R =================================================================== --- pkg/demo/pureSpVineCopula.R 2015-05-25 16:10:31 UTC (rev 143) +++ pkg/demo/pureSpVineCopula.R 2015-05-26 14:41:35 UTC (rev 144) @@ -1,6 +1,5 @@ ## librarys ## -library("spcopula") -# library("evd") +library("VineCopula") library("sp") par(mfrow=c(1,1)) ## meuse - spatial poionts data.frame ## Modified: pkg/demo/stCoVarVineCop.R =================================================================== --- pkg/demo/stCoVarVineCop.R 2015-05-25 16:10:31 UTC (rev 143) +++ pkg/demo/stCoVarVineCop.R 2015-05-26 14:41:35 UTC (rev 144) @@ -6,6 +6,7 @@ # sary to maintain the "runability" of this demo. ###################################################################### library("spcopula") +library("VineCopula") library("evd") data("EU_RB") Modified: pkg/demo/stVineCopFit.R =================================================================== --- pkg/demo/stVineCopFit.R 2015-05-25 16:10:31 UTC (rev 143) +++ pkg/demo/stVineCopFit.R 2015-05-26 14:41:35 UTC (rev 144) @@ -2,6 +2,7 @@ ## selected smaller subset of the original data to reduce calculation demands. ## Thus, results are likely to differ (a little) from the original study. +library("VineCopula") library("spcopula") data("EU_RB_2005") Modified: pkg/demo/tailDepFunctions.R =================================================================== --- pkg/demo/tailDepFunctions.R 2015-05-25 16:10:31 UTC (rev 143) +++ pkg/demo/tailDepFunctions.R 2015-05-26 14:41:35 UTC (rev 144) @@ -1,3 +1,4 @@ +library("VineCopula") library("spcopula") data("simulatedTriples") Modified: pkg/man/condSpVine.Rd =================================================================== --- pkg/man/condSpVine.Rd 2015-05-25 16:10:31 UTC (rev 143) +++ pkg/man/condSpVine.Rd 2015-05-26 14:41:35 UTC (rev 144) @@ -35,6 +35,7 @@ \code{\linkS4class{spVineCopula}} } \examples{ +library("VineCopula") data("spCopDemo") calcKTauPol <- fitCorFun(bins, degree=3) Modified: pkg/man/condStCoVarVine.Rd =================================================================== --- pkg/man/condStCoVarVine.Rd 2015-05-25 16:10:31 UTC (rev 143) +++ pkg/man/condStCoVarVine.Rd 2015-05-26 14:41:35 UTC (rev 144) @@ -43,6 +43,7 @@ } \examples{ +library("VineCopula") spCopT0 <- spCopula(components=list(claytonCopula(8), claytonCopula(4), claytonCopula(2), claytonCopula(1), claytonCopula(0.5), indepCopula()), Modified: pkg/man/condStVine.Rd =================================================================== --- pkg/man/condStVine.Rd 2015-05-25 16:10:31 UTC (rev 143) +++ pkg/man/condStVine.Rd 2015-05-26 14:41:35 UTC (rev 144) @@ -36,6 +36,7 @@ } \examples{ # a spatio-temporal C-vine copula (with independent copulas in the upper vine) +library("VineCopula") spCopT0 <- spCopula(components=list(claytonCopula(8), claytonCopula(4), claytonCopula(2), claytonCopula(1), Modified: pkg/man/spCopPredict.Rd =================================================================== --- pkg/man/spCopPredict.Rd 2015-05-25 16:10:31 UTC (rev 143) +++ pkg/man/spCopPredict.Rd 2015-05-26 14:41:35 UTC (rev 144) @@ -39,6 +39,7 @@ } \examples{ library("sp") +library("VineCopula") data("meuse.grid") coordinates(meuse.grid) <- ~x+y gridded(meuse.grid) <- TRUE Modified: pkg/man/spVineCopula.Rd =================================================================== --- pkg/man/spVineCopula.Rd 2015-05-25 16:10:31 UTC (rev 143) +++ pkg/man/spVineCopula.Rd 2015-05-26 14:41:35 UTC (rev 144) @@ -25,6 +25,7 @@ } \examples{ # a spatial C-vine copula (with independent dummy copulas in the upper vine) +library("VineCopula") data("spCopDemo") calcKTauPol <- fitCorFun(bins, degree=3) Modified: pkg/man/stCoVarVineCopula.Rd =================================================================== --- pkg/man/stCoVarVineCopula.Rd 2015-05-25 16:10:31 UTC (rev 143) +++ pkg/man/stCoVarVineCopula.Rd 2015-05-26 14:41:35 UTC (rev 144) @@ -38,6 +38,7 @@ \examples{ # a spatio-temporal C-vine copula (with independent copulas in the upper vine) +library("VineCopula") spCopT0 <- spCopula(components=list(claytonCopula(8), claytonCopula(4), claytonCopula(2), claytonCopula(1), claytonCopula(0.5), indepCopula()), Modified: pkg/man/stCopPredict.Rd =================================================================== --- pkg/man/stCopPredict.Rd 2015-05-25 16:10:31 UTC (rev 143) +++ pkg/man/stCopPredict.Rd 2015-05-26 14:41:35 UTC (rev 144) @@ -36,6 +36,7 @@ \examples{ library("sp") library("spacetime") +library("VineCopula") spCopT0 <- spCopula(components=list(claytonCopula(8), claytonCopula(4), claytonCopula(2), claytonCopula(1), Modified: pkg/man/stVineCopula.Rd =================================================================== --- pkg/man/stVineCopula.Rd 2015-05-25 16:10:31 UTC (rev 143) +++ pkg/man/stVineCopula.Rd 2015-05-26 14:41:35 UTC (rev 144) @@ -21,6 +21,8 @@ } \examples{ # a spatio-temporal C-vine copula (with independent copulas in the upper vine) +library("VineCopula") + spCopT0 <- spCopula(components=list(claytonCopula(8), claytonCopula(4), claytonCopula(2), claytonCopula(1), claytonCopula(0.5), indepCopula()), Modified: pkg/man/tailDepFun.Rd =================================================================== --- pkg/man/tailDepFun.Rd 2015-05-25 16:10:31 UTC (rev 143) +++ pkg/man/tailDepFun.Rd 2015-05-26 14:41:35 UTC (rev 144) @@ -43,6 +43,7 @@ } \examples{ +library("VineCopula") data("simulatedTriples") X <- rankTransform(triples[,c(1,3)]) Modified: pkg/tests/spCopulaTest.Rout.save =================================================================== --- pkg/tests/spCopulaTest.Rout.save 2015-05-25 16:10:31 UTC (rev 143) +++ pkg/tests/spCopulaTest.Rout.save 2015-05-26 14:41:35 UTC (rev 144) @@ -1,6 +1,6 @@ -R version 3.1.1 (2014-07-10) -- "Sock it to Me" -Copyright (C) 2014 The R Foundation for Statistical Computing +R version 3.2.0 (2015-04-16) -- "Full of Ingredients" +Copyright (C) 2015 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. @@ -17,7 +17,6 @@ > library("spcopula") Loading required package: copula -Loading required package: VineCopula > data("spCopDemo") > calcKTauPol <- fitCorFun(bins, degree=3) @@ -63,4 +62,4 @@ > > proc.time() user system elapsed - 6.92 0.17 7.19 + 3.72 0.06 3.79 Modified: pkg/tests/stCopulaTest.Rout.save =================================================================== --- pkg/tests/stCopulaTest.Rout.save 2015-05-25 16:10:31 UTC (rev 143) +++ pkg/tests/stCopulaTest.Rout.save 2015-05-26 14:41:35 UTC (rev 144) @@ -1,6 +1,6 @@ -R version 3.1.1 (2014-07-10) -- "Sock it to Me" -Copyright (C) 2014 The R Foundation for Statistical Computing +R version 3.2.0 (2015-04-16) -- "Full of Ingredients" +Copyright (C) 2015 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. @@ -17,7 +17,6 @@ > library("spcopula") Loading required package: copula -Loading required package: VineCopula > spCopT0 <- spCopula(components=list(claytonCopula(8), claytonCopula(4), + claytonCopula(2), claytonCopula(1), + claytonCopula(0.5), indepCopula()), @@ -56,4 +55,4 @@ > > proc.time() user system elapsed - 6.03 0.24 6.33 + 3.08 0.10 3.19