[spcopula-commits] r131 - in pkg: . R man tests tests/Examples
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Mar 18 12:48:50 CET 2014
Author: ben_graeler
Date: 2014-03-18 12:48:49 +0100 (Tue, 18 Mar 2014)
New Revision: 131
Added:
pkg/tests/
pkg/tests/Examples/
pkg/tests/Examples/spcopula-Ex.Rout.save
pkg/tests/spCopulaTest.R
pkg/tests/spCopulaTest.Rout.save
pkg/tests/stCopulaTest.R
pkg/tests/stCopulaTest.Rout.save
Modified:
pkg/DESCRIPTION
pkg/R/stCopula.R
pkg/man/condCovariate.Rd
pkg/man/getStNeighbours.Rd
pkg/man/invdduCopula-methods.Rd
pkg/man/invddvCopula-methods.Rd
pkg/man/reduceNeighbours.Rd
pkg/man/spCopula.Rd
pkg/man/stCopPredict.Rd
pkg/man/stNeighbourhood.Rd
Log:
- added tests and tests/Examples
- added invdduCopula and invddvCopula methods for bivariate spatio-temporal copulas
Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION 2014-03-18 09:32:19 UTC (rev 130)
+++ pkg/DESCRIPTION 2014-03-18 11:48:49 UTC (rev 131)
@@ -2,7 +2,7 @@
Type: Package
Title: copula driven spatial analysis
Version: 0.2-0
-Date: 2014-02-21
+Date: 2014-03-18
Authors at R: c(person("Benedikt", "Graeler", role = c("aut", "cre"),
email = "ben.graeler at uni-muenster.de"),
person("Marius", "Appel",role = "ctb"))
Modified: pkg/R/stCopula.R
===================================================================
--- pkg/R/stCopula.R 2014-03-18 09:32:19 UTC (rev 130)
+++ pkg/R/stCopula.R 2014-03-18 11:48:49 UTC (rev 131)
@@ -129,7 +129,7 @@
tDist <- unique(h[,2])
if(any(is.na(match(tDist,copula at tlags))))
- stop("Prediction time(s) do(es) not math the modelled time slices.")
+ stop("Prediction time(s) do(es) not match the modelled time slices.")
if (length(tDist)==1) {
res <- dduSpCopula(u, copula at spCopList[[match(tDist, copula at tlags)]], h[,1])
@@ -148,7 +148,33 @@
function(u, copula, ...) dduStCopula(matrix(u,ncol=2), copula, ...))
setMethod("dduCopula", signature("matrix","stCopula"), dduStCopula)
+invdduStCopula <- function(u, copula, y, h, tol=.Machine$double.eps^0.5) {
+ message("invdduCopula is numerically evalauted.")
+
+ if(!is.matrix(h))
+ h <- matrix(h,ncol=2)
+
+ nElem <- length(u)
+ stopifnot(nElem == length(y))
+ stopifnot(nrow(h) == 1 | nrow(h)==nElem)
+
+ optFun <- function(u, v, y, h) abs(dduStCopula(cbind(rep(u, length(v)), v), copula, h)-y)
+
+ optMe <- function(aU, aY, aH) optimise(function(v) optFun(u=aU, v, y=aY, h=aH), c(0,1))$minimum
+
+ if(nrow(h) == 1 & nElem > 1)
+ h <- matrix(rep(h,nElem),ncol=2, byrow=T)
+
+ rV <- numeric(nElem)
+ for (i in 1:nElem) {
+ rV[i] <- optMe(u[i], y[i], h[i,,drop=FALSE])
+ }
+
+ return(rV)
+}
+setMethod("invdduCopula", signature("numeric", "stCopula"), invdduStCopula)
+
## ddvSpCopula ##
#################
@@ -160,7 +186,7 @@
tDist <- unique(h[,2])
if(any(is.na(match(tDist,copula at tlags))))
- stop("Prediction time(s) do(es) not math the modelled time slices.")
+ stop("Prediction time(s) do(es) not match the modelled time slices.")
if (length(tDist)==1) {
res <- ddvSpCopula(u, copula at spCopList[[match(tDist,copula at tlags)]], h[,1])
@@ -179,6 +205,33 @@
function(u, copula, ...) ddvStCopula(matrix(u,ncol=2), copula, ...))
setMethod("ddvCopula", signature("matrix","stCopula"), ddvStCopula)
+invddvStCopula <- function(v, copula, y, h, tol=.Machine$double.eps^0.5) {
+ message("invdduCopula is numerically evalauted.")
+
+ if(!is.matrix(h))
+ h <- matrix(h,ncol=2)
+
+ nElem <- length(v)
+ stopifnot(nElem == length(y))
+ stopifnot(nrow(h) == 1 | nrow(h)==nElem)
+
+ optFun <- function(u, v, y, h) abs(ddvStCopula(cbind(u, rep(v, length(u))), copula, h)-y)
+
+ optMe <- function(aV, aY, aH) optimise(function(u) optFun(u, v=aV, y=aY, h=aH), c(0,1))$minimum
+
+ if(nrow(h) == 1 & nElem > 1)
+ h <- matrix(rep(h,nElem),ncol=2, byrow=T)
+
+ rU <- numeric(nElem)
+ for (i in 1:nElem) {
+ rU[i] <- optMe(v[i], y[i], h[i,,drop=FALSE])
+ }
+
+ return(rU)
+}
+
+setMethod("invddvCopula", signature("numeric", "stCopula"), invddvStCopula)
+
# log-likelihood by copula for all spatio-temporal lags
Modified: pkg/man/condCovariate.Rd
===================================================================
--- pkg/man/condCovariate.Rd 2014-03-18 09:32:19 UTC (rev 130)
+++ pkg/man/condCovariate.Rd 2014-03-18 11:48:49 UTC (rev 131)
@@ -29,7 +29,7 @@
library(spacetime)
sp <- SpatialPoints(matrix(c(181000,181100,333500,333600),2))
-time <- Sys.time()+60*60*24*c(0,1,2)
+time <- as.POSIXct("2014-03-18")+60*60*24*c(0,1,2)
data <- data.frame(var=runif(6))
data$coVar <- invdduCopula(data$var, gumbelCopula(7), runif(6))
Modified: pkg/man/getStNeighbours.Rd
===================================================================
--- pkg/man/getStNeighbours.Rd 2014-03-18 09:32:19 UTC (rev 130)
+++ pkg/man/getStNeighbours.Rd 2014-03-18 11:48:49 UTC (rev 131)
@@ -45,7 +45,7 @@
library(spacetime)
sp <- SpatialPoints(matrix(c(181000,181100,333500,333600),2))
-time <- Sys.time()+60*60*24*c(0,1,2)
+time <- as.POSIXct("2014-03-18")+60*60*24*c(0,1,2)
data <- data.frame(measure=runif(6))
stData <- STFDF(sp, time, data)
Modified: pkg/man/invdduCopula-methods.Rd
===================================================================
--- pkg/man/invdduCopula-methods.Rd 2014-03-18 09:32:19 UTC (rev 130)
+++ pkg/man/invdduCopula-methods.Rd 2014-03-18 11:48:49 UTC (rev 131)
@@ -7,6 +7,7 @@
\alias{invdduCopula,numeric,indepCopula,numeric-method}
\alias{invdduCopula,numeric,normalCopula,numeric-method}
\alias{invdduCopula,numeric,spCopula,ANY-method}
+\alias{invdduCopula,numeric,stCopula,ANY-method}
\title{Methods for Function \code{invdduCopula} in Package \pkg{spcopula}}
\description{
@@ -14,19 +15,24 @@
}
\section{Methods}{
\describe{
-
+\item{\code{signature(u = "ANY", copula = "ANY", y = "ANY")}}{
+The inverse of the partial derivative of a copula is evaluated. For a given \code{u} and \code{y} a \code{v} is returned such that C(u,v)=y. In case no closed form is known, the evaluation is done numerically using \code{\link{optimise}}.}
+\item{\code{signature(u = "numeric", copula = "asCopula", y = "numeric")}}{
+Closed form evaluation of \code{invdduCopula} for the \code{\linkS4class{asCopula}}.}
\item{\code{signature(u = "numeric", copula = "claytonCopula", y = "numeric")}}{
-%% ~~describe this method here~~
-}
+Closed form evaluation of \code{invdduCopula} for the \code{\linkS4class{claytonCopula}}.}
+\item{\code{signature(u = "numeric", copula = "cqsCopula", y = "numeric")}}{
+Closed form evaluation of \code{invdduCopula} for the \code{\linkS4class{cqsCopula}}.}
\item{\code{signature(u = "numeric", copula = "frankCopula", y = "numeric")}}{
-%% ~~describe this method here~~
-}
+Closed form evaluation of \code{invdduCopula} for the \code{\linkS4class{frankCopula}}.}
\item{\code{signature(u = "numeric", copula = "indepCopula", y = "numeric")}}{
-%% ~~describe this method here~~
-}
-\item{\code{signature(u = "numeric", copula = "normalCopula", y = "ANY")}}{
-%% ~~describe this method here~~
-}
+Closed form evaluation of \code{invdduCopula} for the \code{\linkS4class{indepCopula}}.}
+\item{\code{signature(u = "numeric", copula = "normalCopula", y = "numeric")}}{
+Closed form evaluation of \code{invdduCopula} for the \code{\linkS4class{normalCopula}}.}
+\item{\code{signature(u = "numeric", copula = "spCopula", y = "ANY")}}{
+Numerical evaluation of \code{invdduCopula} for the \code{\linkS4class{spCopula}}.}
+\item{\code{signature(u = "numeric", copula = "stCopula", y = "ANY")}}{
+Numerical evaluation of \code{invdduCopula} for the \code{\linkS4class{stCopula}}.}
}}
\keyword{methods}
\keyword{inverse partial derivatives}
\ No newline at end of file
Modified: pkg/man/invddvCopula-methods.Rd
===================================================================
--- pkg/man/invddvCopula-methods.Rd 2014-03-18 09:32:19 UTC (rev 130)
+++ pkg/man/invddvCopula-methods.Rd 2014-03-18 11:48:49 UTC (rev 131)
@@ -7,6 +7,7 @@
\alias{invddvCopula,numeric,indepCopula,numeric-method}
\alias{invddvCopula,numeric,normalCopula,numeric-method}
\alias{invddvCopula,numeric,spCopula,ANY-method}
+\alias{invddvCopula,numeric,stCopula,ANY-method}
\title{Methods for Function \code{invddvCopula} in Package \pkg{spcopula}}
\description{
@@ -14,19 +15,24 @@
}
\section{Methods}{
\describe{
-
+\item{\code{signature(u = "ANY", copula = "ANY", y = "ANY")}}{
+The inverse of the partial derivative of a copula is evaluated. For a given \code{u} and \code{y} a \code{v} is returned such that C(u,v)=y. In case no closed form is known, the evaluation is done numerically using \code{\link{optimise}}.}
+\item{\code{signature(u = "numeric", copula = "asCopula", y = "numeric")}}{
+Closed form evaluation of \code{invddvCopula} for the \code{\linkS4class{asCopula}}.}
\item{\code{signature(u = "numeric", copula = "claytonCopula", y = "numeric")}}{
-%% ~~describe this method here~~
-}
+Closed form evaluation of \code{invddvCopula} for the \code{\linkS4class{claytonCopula}}.}
+\item{\code{signature(u = "numeric", copula = "cqsCopula", y = "numeric")}}{
+Closed form evaluation of \code{invddvCopula} for the \code{\linkS4class{cqsCopula}}.}
\item{\code{signature(u = "numeric", copula = "frankCopula", y = "numeric")}}{
-%% ~~describe this method here~~
-}
+Closed form evaluation of \code{invddvCopula} for the \code{\linkS4class{frankCopula}}.}
\item{\code{signature(u = "numeric", copula = "indepCopula", y = "numeric")}}{
-%% ~~describe this method here~~
-}
-\item{\code{signature(u = "numeric", copula = "normalCopula", y = "ANY")}}{
-%% ~~describe this method here~~
-}
+Closed form evaluation of \code{invddvCopula} for the \code{\linkS4class{indepCopula}}.}
+\item{\code{signature(u = "numeric", copula = "normalCopula", y = "numeric")}}{
+Closed form evaluation of \code{invddvCopula} for the \code{\linkS4class{normalCopula}}.}
+\item{\code{signature(u = "numeric", copula = "spCopula", y = "ANY")}}{
+Numerical evaluation of \code{invddvCopula} for the \code{\linkS4class{spCopula}}.}
+\item{\code{signature(u = "numeric", copula = "stCopula", y = "ANY")}}{
+Numerical evaluation of \code{invddvCopula} for the \code{\linkS4class{stCopula}}.}
}}
\keyword{methods}
\keyword{inverse partial derivatives}
\ No newline at end of file
Modified: pkg/man/reduceNeighbours.Rd
===================================================================
--- pkg/man/reduceNeighbours.Rd 2014-03-18 09:32:19 UTC (rev 130)
+++ pkg/man/reduceNeighbours.Rd 2014-03-18 11:48:49 UTC (rev 131)
@@ -39,7 +39,7 @@
library(spacetime)
sp <- SpatialPoints(matrix(c(181000,181100,333500,333600),2))
-time <- Sys.time()+60*60*24*c(0,1,2,3,4)
+time <- as.POSIXct("2014-03-18")+60*60*24*c(0,1,2,3,4)
data <- data.frame(var1=runif(10))
stData <- STFDF(sp, time, data)
Modified: pkg/man/spCopula.Rd
===================================================================
--- pkg/man/spCopula.Rd 2014-03-18 09:32:19 UTC (rev 130)
+++ pkg/man/spCopula.Rd 2014-03-18 11:48:49 UTC (rev 131)
@@ -42,10 +42,10 @@
calcKTauPol <- fitCorFun(bins, degree=3)
-spCop <- spCopula(components=list(normalCopula(0), tCopula(0, dispstr = "un"),
- frankCopula(1), normalCopula(0), claytonCopula(0),
- claytonCopula(0), claytonCopula(0), claytonCopula(0),
- claytonCopula(0), indepCopula()),
+spCop <- spCopula(components=list(normalCopula(), tCopula(),
+ frankCopula(), normalCopula(), claytonCopula(),
+ claytonCopula(), claytonCopula(), claytonCopula(),
+ claytonCopula(), indepCopula()),
distances=bins$meanDists,
spDepFun=calcKTauPol, unit="m")
}
Modified: pkg/man/stCopPredict.Rd
===================================================================
--- pkg/man/stCopPredict.Rd 2014-03-18 09:32:19 UTC (rev 130)
+++ pkg/man/stCopPredict.Rd 2014-03-18 11:48:49 UTC (rev 131)
@@ -54,7 +54,7 @@
stVineCop <- stVineCopula(stCop, vineCopula(4L))
sp <- SpatialPoints(matrix(c(181000,181100,333500,333600),2))
-time <- Sys.time()+60*60*24*c(0,1,2)
+time <- as.POSIXct("2014-03-18")+60*60*24*c(0,1,2)
data <- data.frame(var1=runif(6))
stData <- STFDF(sp, time, data)
Modified: pkg/man/stNeighbourhood.Rd
===================================================================
--- pkg/man/stNeighbourhood.Rd 2014-03-18 09:32:19 UTC (rev 130)
+++ pkg/man/stNeighbourhood.Rd 2014-03-18 11:48:49 UTC (rev 131)
@@ -28,7 +28,7 @@
library(spacetime)
sp <- SpatialPoints(matrix(c(181000,181100,333500,333600),2))
-time <- Sys.time()+60*60*24*c(0,1,2)
+time <- as.POSIXct("2014-03-18")+60*60*24*c(0,1,2)
data <- data.frame(var1=runif(6))
stData <- STFDF(sp, time, data)
Added: pkg/tests/Examples/spcopula-Ex.Rout.save
===================================================================
--- pkg/tests/Examples/spcopula-Ex.Rout.save (rev 0)
+++ pkg/tests/Examples/spcopula-Ex.Rout.save 2014-03-18 11:48:49 UTC (rev 131)
@@ -0,0 +1,2704 @@
+
+R version 3.1.0 alpha (2014-03-13 r65184) -- "Unsuffered Consequences"
+Copyright (C) 2014 The R Foundation for Statistical Computing
+Platform: x86_64-w64-mingw32/x64 (64-bit)
+
+R is free software and comes with ABSOLUTELY NO WARRANTY.
+You are welcome to redistribute it under certain conditions.
+Type 'license()' or 'licence()' for distribution details.
+
+ Natural language support but running in an English locale
+
+R is a collaborative project with many contributors.
+Type 'contributors()' for more information and
+'citation()' on how to cite R or R packages in publications.
+
+Type 'demo()' for some demos, 'help()' for on-line help, or
+'help.start()' for an HTML browser interface to help.
+Type 'q()' to quit R.
+
+> pkgname <- "spcopula"
+> source(file.path(R.home("share"), "R", "examples-header.R"))
+> options(warn = 1)
+> options(pager = "console")
+> library('spcopula')
+Loading required package: copula
+Loading required package: VineCopula
+>
+> base::assign(".oldSearch", base::search(), pos = 'CheckExEnv')
+> cleanEx()
+> nameEx("asCopula-class")
+> ### * asCopula-class
+>
+> flush(stderr()); flush(stdout())
+>
+> ### Name: asCopula-class
+> ### Title: Class '"asCopula"'
+> ### Aliases: asCopula-class dduCopula,matrix,asCopula-method
+> ### dduCopula,numeric,asCopula-method ddvCopula,matrix,asCopula-method
+> ### ddvCopula,numeric,asCopula-method fitCopula,asCopula-method
+> ### invdduCopula,numeric,asCopula,numeric-method
+> ### invddvCopula,numeric,asCopula,numeric-method
+> ### Keywords: classes asymmetric copula copula
+>
+> ### ** Examples
+>
+> showClass("asCopula")
+Class "asCopula" [package "spcopula"]
+
+Slots:
+
+Name: dimension parameters param.names param.lowbnd param.upbnd
+Class: integer numeric character numeric numeric
+
+Name: fullname
+Class: character
+
+Extends:
+Class "copula", directly
+Class "Copula", by class "copula", distance 2
+>
+>
+>
+> cleanEx()
+> nameEx("asCopula")
+> ### * asCopula
+>
+> flush(stderr()); flush(stdout())
+>
+> ### Name: asCopula
+> ### Title: Constructor of an asymmetric copula with cubic and quadratic
+> ### sections (Nelsen 2006).
+> ### Aliases: asCopula
+> ### Keywords: asymmetric copula cubic quadratic sections
+>
+> ### ** Examples
+>
+> persp(asCopula(c(-2,1)),dCopula)
+>
+>
+>
+> cleanEx()
+> nameEx("calcBins")
+> ### * calcBins
+>
+> flush(stderr()); flush(stdout())
+>
+> ### Name: calcBins
+> ### Title: A function calculating the spatial/spatio-temporal bins
+> ### Aliases: calcBins calcBins-methods calcBins,Spatial-method
+> ### calcBins,STFDF-method
+> ### Keywords: spatial preparation spatio-temporal preparation
+>
+> ### ** Examples
+>
+> library(sp)
+> data(meuse)
+> coordinates(meuse) = ~x+y
+> meuse$rtZinc <- rank(meuse$zinc)/(length(meuse)+1)
+>
+> ## lag classes ##
+> bins <- calcBins(meuse, var="rtZinc", nbins=10, cutoff=800)
+>
+>
+>
+> cleanEx()
+
+detaching 'package:sp'
+
+> nameEx("composeSpCopula")
+> ### * composeSpCopula
+>
+> flush(stderr()); flush(stdout())
+>
+> ### Name: composeSpCopula
+> ### Title: Composing a bivariate Spatial Copula
+> ### Aliases: composeSpCopula
+> ### Keywords: spatial multivariate distribution
+>
+> ### ** Examples
+>
+> composeSpCopula(c(1,1,2,3),families=list(frankCopula(.4), gumbelCopula(1.6),gumbelCopula(1.4)),
++ bins=data.frame(meanDists=c(500,1000,1500,2000,2500)),range=2250)
+Spatial Copula: distance dependent convex combination of bivariate copulas
+Dimension: 2
+Copulas:
+ Frank copula family; Archimedean copula at 500 [m]
+ Frank copula family; Archimedean copula at 1000 [m]
+ Gumbel copula family; Archimedean copula; Extreme value copula at 1500 [m]
+ Gumbel copula family; Archimedean copula; Extreme value copula at 2000 [m]
+>
+>
+>
+> cleanEx()
+> nameEx("condCovariate")
+> ### * condCovariate
+>
+> flush(stderr()); flush(stdout())
+>
+> ### Name: condCovariate
+> ### Title: Conditioning of a Covariate
+> ### Aliases: condCovariate
+>
+> ### ** Examples
+>
+> library(sp)
+> library(spacetime)
+>
+> sp <- SpatialPoints(matrix(c(181000,181100,333500,333600),2))
+> time <- as.POSIXct("2014-03-18")+60*60*24*c(0,1,2)
+> data <- data.frame(var=runif(6))
+> data$coVar <- invdduCopula(data$var, gumbelCopula(7), runif(6))
+Numerical evaluation of invddu takes place.
+>
+> stData <- STFDF(sp, time, data)
+> stQuerry <- STF(SpatialPoints(matrix(c(181000,181200,333600,333600),2)),
++ time[2:3])
+>
+> stNeigh <- getStNeighbours(stData=stData, ST=stQuerry,
++ spSize=3, tlags=-(0:1),
++ var="var", coVar="coVar", prediction=TRUE)
+>
+> condCovariate(stNeigh, function(x) gumbelCopula(7))
+[1] 2.558620e-05 5.677942e-09 6.178627e-02 1.765568e-01
+>
+>
+>
+> cleanEx()
+
+detaching 'package:spacetime', 'package:sp'
+
+> nameEx("condSpVine")
+> ### * condSpVine
+>
+> flush(stderr()); flush(stdout())
+>
+> ### Name: condSpVine
+> ### Title: Conditions a spatial vine copula for conditional prediction
+> ### Aliases: condSpVine
+> ### Keywords: distribution
+>
+> ### ** Examples
+>
+> data(spCopDemo)
+>
+> calcKTauPol <- fitCorFun(bins, degree=3)
+
+Call:
+lm(formula = lagCor ~ poly(meanDists, degree), data = bins)
+
+Coefficients:
+ (Intercept) poly(meanDists, degree)1 poly(meanDists, degree)2
+ 0.20756 -0.58268 0.16262
+poly(meanDists, degree)3
+ -0.02181
+
+Sum of squared residuals: 0.006621988
+>
+> spCop <- spCopula(components=list(normalCopula(0), tCopula(0, dispstr = "un"),
++ frankCopula(1), normalCopula(0), claytonCopula(0),
++ claytonCopula(0), claytonCopula(0), claytonCopula(0),
++ claytonCopula(0), indepCopula()),
++ distances=bins$meanDists,
++ spDepFun=calcKTauPol, unit="m")
+The parameters of the components will be recalculated according to the provided spDepFun where possible.
+In case no 1-1 relation is known, the copula as in components is used.
+parameter at boundary ==> returning indepCopula()
+parameter at boundary ==> returning indepCopula()
+parameter at boundary ==> returning indepCopula()
+parameter at boundary ==> returning indepCopula()
+parameter at boundary ==> returning indepCopula()
+>
+> spVineCop <- spVineCopula(spCop, vineCopula(4L))
+>
+> dists <- list(c(473, 124, 116, 649))
+> condVar <- c(0.29, 0.55, 0.05, 0.41)
+> condDensity <- condSpVine(condVar,dists,spVineCop)
+>
+> curve(condDensity)
+> mtext(paste("Dists:",paste(round(dists[[1]],0),collapse=", ")),line=0)
+> mtext(paste("Cond.:",paste(round(condVar,2),collapse=", ")),line=1)
+>
+>
+>
+> cleanEx()
+> nameEx("condStCoVarVine")
+> ### * condStCoVarVine
+>
+> flush(stderr()); flush(stdout())
+>
+> ### Name: condStCoVarVine
+> ### Title: conditional distribution function of spatio-temporal covariate
+> ### vine copula
+> ### Aliases: condStCoVarVine
+>
+> ### ** Examples
+>
+> spCopT0 <- spCopula(components=list(claytonCopula(8), claytonCopula(4),
++ claytonCopula(2), claytonCopula(1),
++ claytonCopula(0.5), indepCopula()),
++ distances=c(100,200,300,400,500,600),
++ unit="km")
+> spCopT1 <- spCopula(components=list(claytonCopula(4), claytonCopula(2),
++ claytonCopula(1), claytonCopula(0.5),
++ indepCopula()),
++ distances=c(100,200,300,400,500),
++ unit="km")
+> spCopT2 <- spCopula(components=list(claytonCopula(2), claytonCopula(1),
++ claytonCopula(0.5), indepCopula()),
++ distances=c(100,200,300,400),
++ unit="km")
+>
+> stCop <- stCopula(components=list(spCopT0, spCopT1, spCopT2),
++ tlags=-(0:2))
+>
+> # only a constant copula ius used for the covariate
+> stCVVC <- stCoVarVineCopula(function(x) gumbelCopula(7), stCop, vineCopula(5L))
+>
+> dists <- array(c(150, 250, 150, 250,0,0,-1,-1),dim=c(1,4,2))
+> condVar <- c(0.95, 0.29, 0.55, 0.05, 0.41)
+>
+> condDensity <- condStCoVarVine(condVar, dists, stCVVC, c(1,1))
+> curve(condDensity)
+>
+>
+>
+> cleanEx()
+> nameEx("condStVine")
+> ### * condStVine
+>
+> flush(stderr()); flush(stdout())
+>
+> ### Name: condStVine
+> ### Title: Conditions a spatio-temporal vine copula for conditional
+> ### prediction
+> ### Aliases: condStVine
+> ### Keywords: distribution
+>
+> ### ** Examples
+>
+> # a spatio-temporal C-vine copula (with independent copulas in the upper vine)
+>
+> spCopT0 <- spCopula(components=list(claytonCopula(8), claytonCopula(4),
++ claytonCopula(2), claytonCopula(1),
++ claytonCopula(0.5), indepCopula()),
++ distances=c(100,200,300,400,500,600),
++ unit="km")
+> spCopT1 <- spCopula(components=list(claytonCopula(4), claytonCopula(2),
++ claytonCopula(1), claytonCopula(0.5),
++ indepCopula()),
++ distances=c(100,200,300,400,500),
++ unit="km")
+>
+> stCop <- stCopula(components=list(spCopT0, spCopT1),
++ tlags=-(0:1))
+>
+> stVineCop <- stVineCopula(stCop, vineCopula(4L))
+>
+> dists <- array(c(150, 250, 150, 250,0,0,-1,-1),dim=c(1,4,2))
+> condVar <- c(0.29, 0.55, 0.05, 0.41)
+>
+> condDensity <- condStVine(condVar,dists,stVineCop)
+> curve(condDensity)
+>
+>
+>
+> cleanEx()
+> nameEx("cqsCopula-class")
+> ### * cqsCopula-class
+>
+> flush(stderr()); flush(stdout())
+>
+> ### Name: cqsCopula-class
+> ### Title: Class '"cqsCopula"'
+> ### Aliases: cqsCopula-class dduCopula,matrix,cqsCopula-method
+> ### dduCopula,numeric,cqsCopula-method ddvCopula,matrix,cqsCopula-method
+> ### ddvCopula,numeric,cqsCopula-method fitCopula,cqsCopula-method
+> ### invdduCopula,numeric,cqsCopula,numeric-method
+> ### invddvCopula,numeric,cqsCopula,numeric-method
+> ### Keywords: classes copula
+>
+> ### ** Examples
+>
+> showClass("cqsCopula")
+Class "cqsCopula" [package "spcopula"]
+
+Slots:
+
+Name: fixed dimension parameters param.names param.lowbnd
+Class: character integer numeric character numeric
+
+Name: param.upbnd fullname
+Class: numeric character
+
+Extends:
+Class "copula", directly
+Class "Copula", by class "copula", distance 2
+>
+>
+>
+> cleanEx()
+> nameEx("cqsCopula")
+> ### * cqsCopula
+>
+> flush(stderr()); flush(stdout())
+>
+> ### Name: cqsCopula
+> ### Title: Constructor of a symmetric copula with cubic quadratic sections.
+> ### Aliases: cqsCopula
+> ### Keywords: copula cubic quadratic sections
+>
+> ### ** Examples
+>
+> persp(cqsCopula(c(-2,1)),dCopula)
+>
+>
+>
+> cleanEx()
+> nameEx("criticalLevel")
+> ### * criticalLevel
+>
+> flush(stderr()); flush(stdout())
+>
+> ### Name: criticalLevel
+> ### Title: Calculating the critical level for a given Kendall Return Period
+> ### Aliases: criticalLevel
+> ### Keywords: survival multivariate
+>
+> ### ** Examples
+>
+> criticalLevel(getKendallDistr(frankCopula(.7)), KRP=c(10,100,1000))
+[1] 0.6244540 0.8801567 0.9620758
+>
+>
+>
+> cleanEx()
+> nameEx("criticalPair")
+> ### * criticalPair
+>
+> flush(stderr()); flush(stdout())
+>
+> ### Name: criticalPair
+> ### Title: Calculate Critical Pairs
+> ### Aliases: criticalPair
+> ### Keywords: ~kwd1 ~kwd2
+>
+> ### ** Examples
+>
+> v <- criticalPair(frankCopula(0.7), 0.9, u=.97, 1)
+> pCopula(c(0.97, v),frankCopula(0.7))
+[1] 0.9
+>
+>
+>
+> cleanEx()
+> nameEx("criticalTriple")
+> ### * criticalTriple
+>
+> flush(stderr()); flush(stdout())
+>
+> ### Name: criticalTriple
+> ### Title: calculate critical triples
+> ### Aliases: criticalTriple
+> ### Keywords: multivariate distribution
+>
+> ### ** Examples
+>
+> w <- criticalTriple(frankCopula(0.7,dim=3), 0.9, c(.97,.97), c(1,2))
+>
+> # check the triple
+> pCopula(c(0.97, 0.97, w), frankCopula(0.7, dim=3))
+[1] 0.9
+>
+>
+>
+>
+> cleanEx()
+> nameEx("dduCopula")
+> ### * dduCopula
+>
+> flush(stderr()); flush(stdout())
+>
+> ### Name: dduCopula
+> ### Title: partial derivatives of copulas
+> ### Aliases: dduCopula ddvCopula
+> ### Keywords: partial derivative conditional probabilities
+>
+> ### ** Examples
+>
+> ####################################
+> ## Asymmetric vs. Gaussian copula ##
+> ####################################
+>
+> asCop <- asCopula(c(-2,1))
+> asCopSmpl <- rCopula(100,asCop)
+>
+> unitScatter(smpl=asCopSmpl)
+>
+> # conditional probabilities of an asymmetric copula given u
+> asGivenU <- dduCopula(asCopSmpl,asCop)
+>
+> # vs. conditional probabilities of an asymmetric copula given v
+> asGivenV <- ddvCopula(asCopSmpl[,c(2,1)],asCop)
+> unitScatter(smpl=cbind(asGivenU, asGivenV))
+>
+> normalCop <- normalCopula(.6)
+> normCopSmpl <- rCopula(100,normalCop)
+>
+> unitScatter(smpl=normCopSmpl)
+>
+> # conditional probabilities of a Gaussian copula given u
+> normGivenU <- dduCopula(normCopSmpl,normalCop)
+>
+> # vs. conditional probabilities of a Gaussian copula given v
+> normGivenV <- ddvCopula(normCopSmpl[,c(2,1)],normalCop)
+> unitScatter(smpl=cbind(normGivenU, normGivenV))
+>
+>
+>
+> cleanEx()
+> nameEx("dependencePlot")
+> ### * dependencePlot
+>
+> flush(stderr()); flush(stdout())
+>
+> ### Name: dependencePlot
+> ### Title: Kernel smoothed scatter plot
+> ### Aliases: dependencePlot
+> ### Keywords: plot
+>
+> ### ** Examples
+>
+> ## Not run: dependencePlot(smpl=rCopula(500,asCopula(c(-1,1))))
+>
+>
+>
+> cleanEx()
+> nameEx("empiricalCopula-class")
+> ### * empiricalCopula-class
+>
+> flush(stderr()); flush(stdout())
+>
+> ### Name: empiricalCopula-class
+> ### Title: Class '"empiricalCopula"'
+> ### Aliases: empiricalCopula-class
+> ### Keywords: classes
+>
+> ### ** Examples
+>
+> showClass("empiricalCopula")
+Class "empiricalCopula" [package "spcopula"]
+
+Slots:
+
+Name: sample dimension parameters param.names param.lowbnd
+Class: matrix integer numeric character numeric
+
+Name: param.upbnd fullname
+Class: numeric character
+
+Extends:
+Class "copula", directly
+Class "Copula", by class "copula", distance 2
+>
+>
+>
+> cleanEx()
+> nameEx("empiricalCopula")
+> ### * empiricalCopula
+>
+> flush(stderr()); flush(stdout())
+>
+> ### Name: empiricalCopula
+> ### Title: Constructor of an empirical copula class
+> ### Aliases: empiricalCopula
+> ### Keywords: multivariate
+>
+> ### ** Examples
+>
+> empCop <- empiricalCopula(rCopula(500,frankCopula(0.7)))
+> str(empCop)
+Formal class 'empiricalCopula' [package "spcopula"] with 7 slots
+ ..@ sample : num [1:500, 1:2] 0.266 0.372 0.573 0.908 0.202 ...
+ ..@ dimension : int 2
+ ..@ parameters : num NA
+ ..@ param.names : chr "unknown"
+ ..@ param.lowbnd: num NA
+ ..@ param.upbnd : num NA
+ ..@ fullname : chr "Unkown empirical copula based on a sample."
+>
+> empCop <- empiricalCopula(copula=frankCopula(0.7))
+Note: the copula will be empirically represented by a sample of size: 1e+05
+> str(empCop)
+Formal class 'empiricalCopula' [package "spcopula"] with 7 slots
+ ..@ sample : num [1:100000, 1:2] 0.531 0.685 0.383 0.955 0.118 ...
+ ..@ dimension : int 2
+ ..@ parameters : num 0.7
+ ..@ param.names : chr "param"
+ ..@ param.lowbnd: num -Inf
+ ..@ param.upbnd : num Inf
+ ..@ fullname : chr "Empirical copula derived from Frank copula family; Archimedean copula"
+>
+> empCop <- empiricalCopula(rCopula(500,frankCopula(0.7)), frankCopula(0.7))
+> str(empCop)
+Formal class 'empiricalCopula' [package "spcopula"] with 7 slots
+ ..@ sample : num [1:500, 1:2] 0.8219 0.2413 0.0371 0.2891 0.7464 ...
+ ..@ dimension : int 2
+ ..@ parameters : num 0.7
+ ..@ param.names : chr "param"
+ ..@ param.lowbnd: num -Inf
+ ..@ param.upbnd : num Inf
+ ..@ fullname : chr "Empirical copula derived from Frank copula family; Archimedean copula"
+>
+> # the empirical value
+> pCopula(c(0.3, 0.5), empCop)
+[1] 0.156
+>
+> # the theoretical value
+> pCopula(c(0.3, 0.5), frankCopula(0.7))
+[1] 0.1682671
+>
+>
+>
+> cleanEx()
+> nameEx("fitCorFun")
+> ### * fitCorFun
+>
+> flush(stderr()); flush(stdout())
+>
+> ### Name: fitCorFun
+> ### Title: Automated fitting of a correlation function to the correlogram
+> ### Aliases: fitCorFun
+> ### Keywords: correlogram spcopula
+>
+> ### ** Examples
+>
+> # a simplified bins object (from demo(spcopula))
+> bins <- list(meanDists=c(64, 128, 203, 281, 361, 442, 522, 602, 681, 760),
++ lagCor=c(0.57, 0.49, 0.32, 0.29, 0.15, 0.14, 0.10, -0.00, 0.03, -0.01))
+> attr(bins,"cor.method") <- "kendall"
+>
+> # plot the correlogram
+> plot(lagCor~meanDists,bins)
+>
+> # fit and plot a linear model
+> calcKTauLin <- fitCorFun(bins, degree=1, cutoff=600)
+
+Call:
+lm(formula = lagCor ~ poly(meanDists, degree), data = bins)
+
+Coefficients:
+ (Intercept) poly(meanDists, degree)
+ 0.2943 -0.4284
+
+Sum of squared residuals: 0.01381904
+> curve(calcKTauLin,0, 1000, col="red",add=TRUE)
+>
+> # fit and plot a polynomial model
+> calcKTauPol <- fitCorFun(bins, degree=5)
+
+Call:
+lm(formula = lagCor ~ poly(meanDists, degree), data = bins)
+
+Coefficients:
+ (Intercept) poly(meanDists, degree)1 poly(meanDists, degree)2
+ 0.208000 -0.581940 0.161524
+poly(meanDists, degree)3 poly(meanDists, degree)4 poly(meanDists, degree)5
+ -0.023774 0.004097 0.011434
+
+Sum of squared residuals: 0.006503102
+> curve(calcKTauPol,0, 1000, col="purple",add=TRUE)
+>
+>
+>
+> cleanEx()
+> nameEx("fitSpCopula")
+> ### * fitSpCopula
+>
+> flush(stderr()); flush(stdout())
+>
+> ### Name: fitSpCopula
+> ### Title: Spatial Copula Fitting
+> ### Aliases: fitSpCopula
+> ### Keywords: spatial multivariate distribution
+>
+> ### ** Examples
+>
+> # reload some spatial data
+> library(sp)
+> data(meuse)
+> coordinates(meuse) <- ~x+y
+>
+> # drop margins
+> meuse$marZinc <- plnorm(meuse$zinc, mean(log(meuse$zinc)), sd(log(meuse$zinc)))
+>
+> # load data from a provided binning
+> data(spCopDemo)
+>
+> fitSpCopula(bins, meuse, 600)
+
+Call:
+lm(formula = lagCor ~ poly(meanDists, degree), data = bins)
+
+Coefficients:
+ (Intercept) poly(meanDists, degree)1 poly(meanDists, degree)2
+ 0.294212 -0.428150 0.100339
+poly(meanDists, degree)3
+ 0.007255
+
+Sum of squared residuals: 0.003770511
+Normal copula family
+
+ |
+ | | 0%
+ |
+ |======= | 10%
+ |
+ |============== | 20%
+ |
+ |===================== | 30%
+ |
+ |============================ | 40%
+ |
+ |=================================== | 50%
+ |
+ |========================================== | 60%
+ |
+ |================================================= | 70%
+ |
+ |======================================================== | 80%
+ |
+ |=============================================================== | 90%
+ |
+ |======================================================================| 100%
+t copula family
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/spcopula -r 131
More information about the spcopula-commits
mailing list