[spcopula-commits] r143 - in pkg: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon May 25 18:10:32 CEST 2015
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}{
More information about the spcopula-commits
mailing list