[spcopula-commits] r63 - in pkg: . R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Sep 12 13:54:46 CEST 2012
Author: ben_graeler
Date: 2012-09-12 13:54:46 +0200 (Wed, 12 Sep 2012)
New Revision: 63
Modified:
pkg/DESCRIPTION
pkg/R/asCopula.R
pkg/R/cqsCopula.R
pkg/R/partialDerivatives.R
pkg/R/returnPeriods.R
Log:
still fixinf major changes in copula
Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION 2012-09-12 11:37:40 UTC (rev 62)
+++ pkg/DESCRIPTION 2012-09-12 11:54:46 UTC (rev 63)
@@ -1,8 +1,8 @@
Package: spcopula
Type: Package
Title: copula driven spatial analysis
-Version: 1.0.61
-Date: 2012-09-11
+Version: 1.0.63
+Date: 2012-09-12
Author: Benedikt Graeler
Maintainer: Benedikt Graeler <ben.graeler at uni-muenster.de>
Description: This package provides a framework to analyse spatial data provided in the format of the spacetime package with copulas. Additionally, support for calculating multivariate return periods is implemented.
Modified: pkg/R/asCopula.R
===================================================================
--- pkg/R/asCopula.R 2012-09-12 11:37:40 UTC (rev 62)
+++ pkg/R/asCopula.R 2012-09-12 11:54:46 UTC (rev 63)
@@ -48,55 +48,63 @@
return(pmax(a * u2 * (((12 - 9 * u1) * u1 - 3) * u2 + u1 * (6 * u1 - 8) + 2) + b * (u2 * ((u1 * (9 * u1 - 12) + 3) * u2 + (12 - 6 * u1) * u1 - 4) - 2 * u1 + 1) + 1,0))
}
-setMethod("dCopula", signature("numeric","asCopula"), dASC2)
+setMethod("dCopula", signature("numeric","asCopula"),
+ function(u, copula, ...) {
+ dASC2(matrix(u,ncol=copula at dimension),copula)
+ })
+setMethod("dCopula", signature("matrix","asCopula"), dASC2)
## jcdf ##
+pASC2 <- function (u, copula) {
+ a <- copula at parameters[1]
+ b <- copula at parameters[2]
-pASC2 <-
-function (u, copula)
-{
- a <- copula at parameters[1]
- b <- copula at parameters[2]
- if (!is.matrix(u))
- u <- matrix(u, ncol = 2)
- u1 <- u[, 1]
- u2 <- u[, 2]
- return( u1 * u2 + u1 * u2 * (1 - u1) * (1 - u2) * ((a - b) * u2 * (1 - u1) + b) )
+ u1 <- u[, 1]
+ u2 <- u[, 2]
+ return( u1 * u2 + u1 * u2 * (1 - u1) * (1 - u2) * ((a - b) * u2 * (1 - u1) + b) )
}
-setMethod("pCopula", signature("numeric", "asCopula"), pASC2)
+setMethod("pCopula", signature("numeric", "asCopula"),
+ function(u, copula, ...) {
+ pASC2(matrix(u,ncol=copula at dimension),copula)
+ })
+setMethod("pCopula", signature("matrix", "asCopula"), pASC2)
## partial derivatives ##
## ddu
-dduASC2 <- function (u, copula)
-{
- a <- copula at parameters[1]
- b <- copula at parameters[2]
- if (!is.matrix(pair)) u <- matrix(u, ncol = 2)
+dduASC2 <- function (u, copula) {
+ a <- copula at parameters[1]
+ b <- copula at parameters[2]
+
+ u1 <- u[, 1]
+ u2 <- u[, 2]
- u1 <- u[, 1]
- u2 <- u[, 2]
-
- return(u2*(1 + b*(-1 + 2*u1)*(-1 + u2) - (a - b)*(1 - 4*u1 + 3*u1^2)*(-1 + u2)*u2))
+ return(u2*(1 + b*(-1 + 2*u1)*(-1 + u2) - (a - b)*(1 - 4*u1 + 3*u1^2)*(-1 + u2)*u2))
}
-setMethod("dduCopula", signature("numeric", "asCopula"), dduASC2)
+setMethod("dduCopula", signature("numeric", "asCopula"),
+ function(u, copula, ...) {
+ dduASC2(matrix(u,ncol=copula at dimension),copula)
+ })
+setMethod("dduCopula", signature("matrix", "asCopula"), dduASC2)
## ddv
-
ddvASC2 <- function (u, copula){
- a <- copula at parameters[1]
- b <- copula at parameters[2]
- if (!is.matrix(pair)) u <- matrix(u, ncol = 2)
+ a <- copula at parameters[1]
+ b <- copula at parameters[2]
- u1 <- u[, 1]
- u2 <- u[, 2]
+ u1 <- u[, 1]
+ u2 <- u[, 2]
- return( u1 + b*(-1 + u1)*u1*(-1 + 2*u2) - (a - b)*(-1 + u1)^2*u1*u2*(-2 + 3*u2))
+ return( u1 + b*(-1 + u1)*u1*(-1 + 2*u2) - (a - b)*(-1 + u1)^2*u1*u2*(-2 + 3*u2))
}
-setMethod("ddvCopula", signature("numeric", "asCopula"),ddvASC2)
+setMethod("ddvCopula", signature("numeric", "asCopula"),
+ function(u, copula, ...) {
+ ddvASC2(matrix(u,ncol=copula at dimension),copula)
+ })
+setMethod("ddvCopula", signature("matrix", "asCopula"),ddvASC2)
## random number generater
# incorporating the inverse of the partial derivative that is solved numerically using optimize
Modified: pkg/R/cqsCopula.R
===================================================================
--- pkg/R/cqsCopula.R 2012-09-12 11:37:40 UTC (rev 62)
+++ pkg/R/cqsCopula.R 2012-09-12 11:54:46 UTC (rev 63)
@@ -46,7 +46,11 @@
return(pmax(1-b*(1-2*u2)*(1-2*u1)+(b-a)*(1-u2)*(1-3*u2)*(1-u1)*(1-3*u1),0))
}
-setMethod("dCopula", signature("numeric", "cqsCopula"), dCQSec)
+setMethod("dCopula", signature("numeric", "cqsCopula"),
+ function(u, copula, ...) {
+ dCQSec(matrix(u,ncol=copula at dimension), copula)
+ })
+setMethod("dCopula", signature("matrix", "cqsCopula"), dCQSec)
## jcdf ##
@@ -59,8 +63,12 @@
u2 <- u[, 2]
return(u1*u2*(1- b*(1-u1)*(1-u2) + (b-a)*(1-u2)^2*(1-u1)^2))
}
+setMethod("pCopula", signature("numeric", "cqsCopula"),
+ function(u, copula, ...) {
+ pCQSec(matrix(u,ncol=copula at dimension), copula)
+ })
-setMethod("dCopula", signature("numeric","cqsCopula"), pCQSec)
+setMethod("pCopula", signature("matrix","cqsCopula"), pCQSec)
## partial derivatives ##
@@ -105,19 +113,21 @@
## partial derivative ddu pCQSec
-dduCQSec <- function (u, copula)
-{
- a <- copula at parameters[1]
- b <- copula at parameters[2]
- if (!is.matrix(u)) u <- matrix(u, ncol = 2)
+dduCQSec <- function (u, copula) {
+ a <- copula at parameters[1]
+ b <- copula at parameters[2]
- u1 <- u[, 1]
- u2 <- u[, 2]
+ u1 <- u[, 1]
+ u2 <- u[, 2]
-return(u2-b*(u2-u2^2-2*u1*u2+2*u1*u2^2)+(b-a)*(u2-4*u1*u2+3*u1^2*u2-2*u2^2+8*u1*u2^2-6*u1^2*u2^2+u2^3-4*u1*u2^3+3*u1^2*u2^3))
+ return(u2-b*(u2-u2^2-2*u1*u2+2*u1*u2^2)+(b-a)*(u2-4*u1*u2+3*u1^2*u2-2*u2^2+8*u1*u2^2-6*u1^2*u2^2+u2^3-4*u1*u2^3+3*u1^2*u2^3))
}
-setMethod("dduCopula", signature("numeric","cqsCopula"), dduCQSec)
+setMethod("dduCopula", signature("numeric","cqsCopula"),
+ function(u, copula, ...) {
+ dduCQSec(matrix(u,ncol=copula at dimension), copula)
+ })
+setMethod("dduCopula", signature("matrix","cqsCopula"), dduCQSec)
## inverse partial derivative ddu
@@ -147,7 +157,7 @@
return(apply(v,1,filter))
}
-setMethod("invdduCopula", signature("numeric","cqsCopula"), invdduCQSec)
+setMethod("invdduCopula", signature("numeric","cqsCopula","numeric"), invdduCQSec)
## partial derivative ddv
@@ -162,7 +172,11 @@
return(u1-b*(u1-2*u1*u2-u1^2+2*u1^2*u2)+(b-a)*(u1-2*u1^2+u1^3-4*u1*u2+8*u1^2*u2-4*u1^3*u2+3*u1*u2^2-6*u1^2*u2^2+3*u1^3*u2^2))
}
-setMethod("ddvCopula", signature("numeric","cqsCopula"), ddvCQSec)
+setMethod("ddvCopula", signature("numeric","cqsCopula"),
+ function(u, copula, ...) {
+ ddvQSec(matrix(u,ncol=copula at dimension), copula)
+ })
+setMethod("ddvCopula", signature("matrix","cqsCopula"), ddvCQSec)
## inverse partial derivative ddv
# seems to be accurate (1e-05 is the max out of 5000 random CQSec-copulas for 1000 random pairs (u,v) each. Very most are below 10*.Machine$double.eps)
@@ -190,7 +204,7 @@
return(apply(u,1,filter))
}
-setMethod("invddvCopula", signature("numeric","cqsCopula"), invddvCQSec)
+setMethod("invddvCopula", signature("numeric","cqsCopula","numeric"), invddvCQSec)
## random number generator
Modified: pkg/R/partialDerivatives.R
===================================================================
--- pkg/R/partialDerivatives.R 2012-09-12 11:37:40 UTC (rev 62)
+++ pkg/R/partialDerivatives.R 2012-09-12 11:54:46 UTC (rev 63)
@@ -22,8 +22,8 @@
# partial derivatives and their inverse of some copulas from the copula package
# new defined copulas store their partial derivative separately
-setGeneric("dduCopula", function(u, copula, pair) standardGeneric("dduCopula"))
-setGeneric("ddvCopula", function(u, copula, pair) standardGeneric("ddvCopula"))
+setGeneric("dduCopula", function(u, copula, ...) standardGeneric("dduCopula"))
+setGeneric("ddvCopula", function(u, copula, ...) standardGeneric("ddvCopula"))
## inverse partial derivatives
# numerical standard function
Modified: pkg/R/returnPeriods.R
===================================================================
--- pkg/R/returnPeriods.R 2012-09-12 11:37:40 UTC (rev 62)
+++ pkg/R/returnPeriods.R 2012-09-12 11:54:46 UTC (rev 63)
@@ -78,7 +78,7 @@
}
-setGeneric("qCopula_u",function(copula,p,u,...) {standardGeneric("qcopula_u")})
+setGeneric("qCopula_u",function(copula,p,u,...) {standardGeneric("qCopula_u")})
qCopula_u.def <- function(copula,p,u,sample=NULL) {
dim <- copula at dimension
More information about the spcopula-commits
mailing list