[spcopula-commits] r89 - / pkg/R

[noreply at r-forge.r-project.org]

Author: ben_graeler
Date: 2013-03-27 20:13:09 +0100 (Wed, 27 Mar 2013)
New Revision: 89

Modified:
   pkg/R/leafCopula.R
   pkg/R/utilities.R
   pkg/R/vineCopulas.R
   spcopula_0.1-1.tar.gz
   spcopula_0.1-1.zip
Log:
- improved utilities.R and vineCopulas.R, some optimization for the leafCopula.R

Modified: pkg/R/leafCopula.R
===================================================================
--- pkg/R/leafCopula.R	2013-03-05 13:22:41 UTC (rev 88)
+++ pkg/R/leafCopula.R	2013-03-27 19:13:09 UTC (rev 89)
@@ -74,7 +74,7 @@
 
 ddxsolveXb <- function(u, par) {
   wBor <- weakBorderPoly(u, par)
-  -(sqrt(2)*(u-wBor)*(ddxweakBorderPoly(u, par)-1))/sqrt((u-wBor)^2)+ddxsolveQ(u)
+  sqrt(2)*(1-ddxweakBorderPoly(u, par))+ddxsolveQ(u)
 }
 
 # ## double check

Modified: pkg/R/utilities.R
===================================================================
--- pkg/R/utilities.R	2013-03-05 13:22:41 UTC (rev 88)
+++ pkg/R/utilities.R	2013-03-27 19:13:09 UTC (rev 89)
@@ -11,7 +11,7 @@
   }
 
   bool <- apply(u,1,function(row) !any(is.na(row)))
-  res <- apply(u[bool,],2,rank,ties.method)/(sum(bool)+1)
+  res <- apply(u[bool,],2,rank,ties.method=ties.method)/(sum(bool)+1)
   if(is.data.frame(u))
     return(as.data.frame(res))
   return(res)

Modified: pkg/R/vineCopulas.R
===================================================================
--- pkg/R/vineCopulas.R	2013-03-05 13:22:41 UTC (rev 88)
+++ pkg/R/vineCopulas.R	2013-03-27 19:13:09 UTC (rev 89)
@@ -5,13 +5,13 @@
 ####################
 
 # constructor
-vineCopula <- function (RVM) { # RVM <- 4L
-  if (is.integer(RVM)) {# assuming dimension; i <- 1
-    Matrix <- NULL
-    for (i in 1:RVM) {
-      Matrix <- cbind(Matrix,c(rep(0,i-1),(RVM-i+1):1))
-    }
-    RVM <- RVineMatrix(Matrix)
+vineCopula <- function (RVM, type="CVine") { # RVM <- 4L
+  if (is.integer(RVM)) {# assuming a dimension
+    stopifnot(type %in% c("CVine","DVine"))
+    if (type=="CVine")
+      RVM <- C2RVine(1:RVM,rep(0,RVM*(RVM-1)/2),rep(0,RVM*(RVM-1)/2))
+    if (type=="DVine")
+      RVM <- D2RVine(1:RVM,rep(0,RVM*(RVM-1)/2),rep(0,RVM*(RVM-1)/2))
   }
   
   # handling non S4-class as sub-element in a S4-class
@@ -20,7 +20,7 @@
   
   ltr <- lower.tri(RVM$Matrix)
   copDef <- cbind(RVM$family[ltr], RVM$par[ltr], RVM$par2[ltr])
-  copulas <- apply(copDef,1, function(x) copulaFromFamilyIndex(x[1],x[2],x[3]))
+  copulas <- rev(apply(copDef,1, function(x) copulaFromFamilyIndex(x[1],x[2],x[3])))
   
   new("vineCopula", copulas=copulas, dimension = as.integer(nrow(RVM$Matrix)),
       RVM=RVM, parameters = numeric(),
@@ -202,6 +202,7 @@
 
 # fitting using RVine
 fitVineCop <- function(copula, data, method) {
+  stopifnot(copula at dimension==ncol(data))
   if("StructureSelect" %in% method)
     vineCopula(RVineStructureSelect(data, indeptest="indeptest" %in% method))
   else

Modified: spcopula_0.1-1.tar.gz
===================================================================
(Binary files differ)

Modified: spcopula_0.1-1.zip
===================================================================
(Binary files differ)