[spcopula-commits] r70 - / pkg pkg/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Dec 18 08:44:37 CET 2012
Author: ben_graeler
Date: 2012-12-18 08:44:36 +0100 (Tue, 18 Dec 2012)
New Revision: 70
Added:
spcopula_1.0.70.tar.gz
spcopula_1.0.70.zip
Removed:
spcopula_1.0.69.tar.gz
spcopula_1.0.69.zip
Modified:
pkg/DESCRIPTION
pkg/R/BB1copula.R
pkg/R/BB6copula.R
pkg/R/BB7copula.R
pkg/R/BB8copula.R
pkg/R/asCopula.R
pkg/R/linkingCDVine.R
pkg/R/vineCopulas.R
Log:
- added "log" parameter for dCopula
- removed a bug in fitCopula for asCopula
Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION 2012-11-30 20:47:31 UTC (rev 69)
+++ pkg/DESCRIPTION 2012-12-18 07:44:36 UTC (rev 70)
@@ -1,8 +1,8 @@
Package: spcopula
Type: Package
Title: copula driven spatial analysis
-Version: 1.0.69
-Date: 2012-11-30
+Version: 1.0.70
+Date: 2012-12-18
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/BB1copula.R
===================================================================
--- pkg/R/BB1copula.R 2012-11-30 20:47:31 UTC (rev 69)
+++ pkg/R/BB1copula.R 2012-12-18 07:44:36 UTC (rev 70)
@@ -105,8 +105,8 @@
## density ##
setMethod("dCopula", signature("numeric","surBB1Copula"),
- function(u, copula, ...) {
- linkCDVine.PDF(matrix(u,ncol=copula at dimension),copula)
+ function(u, copula, log) {
+ linkCDVine.PDF(matrix(u,ncol=copula at dimension),copula, log)
})
setMethod("dCopula", signature("matrix","surBB1Copula"), linkCDVine.PDF)
@@ -132,7 +132,7 @@
})
setMethod("ddvCopula", signature("matrix","surBB1Copula"), linkCDVine.ddv)
-## random number generater ??
+## random number generator
setMethod("rCopula", signature("numeric","surBB1Copula"), linkCDVine.r)
setMethod("tau",signature("surBB1Copula"),linkCDVine.tau)
@@ -172,8 +172,8 @@
BiCopCDF
## density ##
setMethod("dCopula", signature("numeric","r90BB1Copula"),
- function(u, copula, ...) {
- linkCDVine.PDF(matrix(u,ncol=copula at dimension),copula)
+ function(u, copula, log) {
+ linkCDVine.PDF(matrix(u,ncol=copula at dimension),copula, log)
})
setMethod("dCopula", signature("matrix","r90BB1Copula"), linkCDVine.PDF)
@@ -226,8 +226,8 @@
## density ##
setMethod("dCopula", signature("numeric","r270BB1Copula"),
- function(u, copula, ...) {
- linkCDVine.PDF(matrix(u,ncol=copula at dimension),copula)
+ function(u, copula, log) {
+ linkCDVine.PDF(matrix(u,ncol=copula at dimension),copula, log)
})
setMethod("dCopula", signature("matrix","r270BB1Copula"), linkCDVine.PDF)
Modified: pkg/R/BB6copula.R
===================================================================
--- pkg/R/BB6copula.R 2012-11-30 20:47:31 UTC (rev 69)
+++ pkg/R/BB6copula.R 2012-12-18 07:44:36 UTC (rev 70)
@@ -108,8 +108,8 @@
## density ##
setMethod("dCopula", signature("numeric","surBB6Copula"),
- function(u, copula, ...) {
- linkCDVine.PDF(matrix(u,ncol=copula at dimension),copula)
+ function(u, copula, log) {
+ linkCDVine.PDF(matrix(u,ncol=copula at dimension),copula, log)
})
setMethod("dCopula", signature("matrix","surBB6Copula"), linkCDVine.PDF)
@@ -175,8 +175,8 @@
## density ##
setMethod("dCopula", signature("numeric","r90BB6Copula"),
- function(u, copula, ...) {
- linkCDVine.PDF(matrix(u,ncol=copula at dimension),copula)
+ function(u, copula, log) {
+ linkCDVine.PDF(matrix(u,ncol=copula at dimension),copula,log)
})
setMethod("dCopula", signature("matrix","r90BB6Copula"), linkCDVine.PDF)
@@ -229,8 +229,8 @@
## density ##
setMethod("dCopula", signature("numeric","r270BB6Copula"),
- function(u, copula, ...) {
- linkCDVine.PDF(matrix(u,ncol=copula at dimension),copula)
+ function(u, copula, log) {
+ linkCDVine.PDF(matrix(u,ncol=copula at dimension, log),copula)
})
setMethod("dCopula", signature("matrix","r270BB6Copula"), linkCDVine.PDF)
Modified: pkg/R/BB7copula.R
===================================================================
--- pkg/R/BB7copula.R 2012-11-30 20:47:31 UTC (rev 69)
+++ pkg/R/BB7copula.R 2012-12-18 07:44:36 UTC (rev 70)
@@ -108,8 +108,8 @@
## density ##
setMethod("dCopula", signature("numeric","surBB7Copula"),
- function(u, copula, ...) {
- linkCDVine.PDF(matrix(u,ncol=copula at dimension),copula)
+ function(u, copula, log) {
+ linkCDVine.PDF(matrix(u,ncol=copula at dimension,),copula,log=log)
})
setMethod("dCopula", signature("matrix","surBB7Copula"), linkCDVine.PDF)
@@ -177,8 +177,8 @@
## density ##
setMethod("dCopula", signature("numeric","r90BB7Copula"),
- function(u, copula, ...) {
- linkCDVine.PDF(matrix(u,ncol=copula at dimension),copula)
+ function(u, copula, log) {
+ linkCDVine.PDF(matrix(u,ncol=copula at dimension),copula, log)
})
setMethod("dCopula", signature("matrix","r90BB7Copula"), linkCDVine.PDF)
@@ -231,8 +231,8 @@
## density ##
setMethod("dCopula", signature("numeric","r270BB7Copula"),
- function(u, copula, ...) {
- linkCDVine.PDF(matrix(u,ncol=copula at dimension),copula)
+ function(u, copula, log) {
+ linkCDVine.PDF(matrix(u,ncol=copula at dimension),copula, log)
})
setMethod("dCopula", signature("matrix","r270BB7Copula"), linkCDVine.PDF)
Modified: pkg/R/BB8copula.R
===================================================================
--- pkg/R/BB8copula.R 2012-11-30 20:47:31 UTC (rev 69)
+++ pkg/R/BB8copula.R 2012-12-18 07:44:36 UTC (rev 70)
@@ -108,8 +108,8 @@
## density ##
setMethod("dCopula", signature("numeric","surBB8Copula"),
- function(u, copula, ...) {
- linkCDVine.PDF(matrix(u,ncol=copula at dimension),copula)
+ function(u, copula, log) {
+ linkCDVine.PDF(matrix(u,ncol=copula at dimension),copula, log)
})
setMethod("dCopula", signature("matrix","surBB8Copula"), linkCDVine.PDF)
@@ -175,8 +175,8 @@
## density ##
setMethod("dCopula", signature("numeric","r90BB8Copula"),
- function(u, copula, ...) {
- linkCDVine.PDF(matrix(u,ncol=copula at dimension),copula)
+ function(u, copula, log) {
+ linkCDVine.PDF(matrix(u,ncol=copula at dimension),copula, log)
})
setMethod("dCopula", signature("matrix","r90BB8Copula"), linkCDVine.PDF)
@@ -226,8 +226,8 @@
## density ##
setMethod("dCopula", signature("numeric","r270BB8Copula"),
- function(u, copula, ...) {
- linkCDVine.PDF(matrix(u,ncol=copula at dimension),copula)
+ function(u, copula, log) {
+ linkCDVine.PDF(matrix(u,ncol=copula at dimension),copula, log)
})
setMethod("dCopula", signature("matrix","r270BB8Copula"), linkCDVine.PDF)
Modified: pkg/R/asCopula.R
===================================================================
--- pkg/R/asCopula.R 2012-11-30 20:47:31 UTC (rev 69)
+++ pkg/R/asCopula.R 2012-12-18 07:44:36 UTC (rev 70)
@@ -243,7 +243,7 @@
optFun <- function(param=c(0,0)) {
if(any(param > 1) | param[2] < -1 | param[1] < limA(param[2])) return(1)
- return(-sum(log( dASC2(asCopula(param),u=data))))
+ return(-sum(log( dASC2(data, asCopula(param)))))
}
optimized <- optim(par=start, fn=optFun, method = optim.method,
Modified: pkg/R/linkingCDVine.R
===================================================================
--- pkg/R/linkingCDVine.R 2012-11-30 20:47:31 UTC (rev 69)
+++ pkg/R/linkingCDVine.R 2012-12-18 07:44:36 UTC (rev 70)
@@ -4,7 +4,7 @@
# density from BiCopPDF
-linkCDVine.PDF <- function (u, copula, log) {
+linkCDVine.PDF <- function (u, copula, log=FALSE) {
param <- copula at parameters
if(length(param)==1) param <- c(param,0)
n <- nrow(u)
Modified: pkg/R/vineCopulas.R
===================================================================
--- pkg/R/vineCopulas.R 2012-11-30 20:47:31 UTC (rev 69)
+++ pkg/R/vineCopulas.R 2012-12-18 07:44:36 UTC (rev 70)
@@ -50,7 +50,13 @@
## d-vine structure
-dDvine <- function(copula, u){
+# copula <- vineFit
+# u <- empVine
+# empCopVine
+
+# dDvine(vineFit, empVine,log=T)
+
+dDvine <- function(copula, u, log=FALSE){
dim <- copula at dimension
tmp <- u
u <- NULL
@@ -62,7 +68,10 @@
for (i in 1:(dim-1)) {
tmpCop <- copula at copulas[[i]]
tmpU <- u[[1]][,i:(i+1)]
- den <- den*dCopula(tmpU,tmpCop)
+ if(log)
+ den <- den + dCopula(tmpU, tmpCop,log=T)
+ else
+ den <- den*dCopula(tmpU,tmpCop,log=F)
if (i == 1) {
newU <- cbind(newU, ddvCopula(tmpU, tmpCop))
} else {
@@ -75,14 +84,16 @@
u[[2]] <- newU
used <- dim-1
-
for (l in 2:(dim-1)) {
newU <- NULL
for (i in 1:(dim-l)) {
# cat(used+i,"\n")
tmpCop <- copula at copulas[[used+i]]
tmpU <- u[[l]][,(i*2-1):(i*2)]
- den <- den*dCopula(tmpU, tmpCop)
+ if(log)
+ den <- den + dCopula(tmpU, tmpCop,log=T)
+ else
+ den <- den*dCopula(tmpU, tmpCop, log=F)
if (l < dim-1) {
if (i == 1) {
newU <- cbind(newU,ddvCopula(tmpU, tmpCop))
@@ -134,11 +145,13 @@
##
-dvineCopula <- function(u, copula) {
+dvineCopula <- function(u, copula, log=F) {
den <- switch(getNumType(copula),dCvine ,dDvine)
- return(den(copula, u))
+ return(den(copula, u, log))
}
+
+
setMethod("dCopula", signature("numeric","vineCopula"), dvineCopula)
setMethod("dCopula", signature("matrix","vineCopula"), dvineCopula)
@@ -176,7 +189,7 @@
## random numbers
linkCDVineSim <- function(n, copula) {
- numType <- getNumType
+ numType <- getNumType(copula)
getFamily <- function(copula) {
if("family" %in% slotNames(copula)) numFam <- copula at family
Deleted: spcopula_1.0.69.tar.gz
===================================================================
(Binary files differ)
Deleted: spcopula_1.0.69.zip
===================================================================
(Binary files differ)
Added: spcopula_1.0.70.tar.gz
===================================================================
(Binary files differ)
Property changes on: spcopula_1.0.70.tar.gz
___________________________________________________________________
Added: svn:mime-type
+ application/octet-stream
Added: spcopula_1.0.70.zip
===================================================================
(Binary files differ)
Property changes on: spcopula_1.0.70.zip
___________________________________________________________________
Added: svn:mime-type
+ application/octet-stream
More information about the spcopula-commits
mailing list