[spcopula-commits] r120 - pkg/R

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

Author: ben_graeler
Date: 2014-02-03 10:05:48 +0100 (Mon, 03 Feb 2014)
New Revision: 120

Modified:
   pkg/R/spCopula.R
   pkg/R/spatialPreparation.R
Log:
- some Na handling in the binning
- added progress bar

Modified: pkg/R/spCopula.R
===================================================================
--- pkg/R/spCopula.R	2013-12-18 09:22:32 UTC (rev 119)
+++ pkg/R/spCopula.R	2014-02-03 09:05:48 UTC (rev 120)
@@ -490,6 +490,8 @@
     cat(cop at fullname,"\n")
     tmploglik <- NULL
     tmpCop <- list()
+    
+    pb <- txtProgressBar(0, length(bins$meanDists), style=3)
     for(i in 1:length(bins$meanDists)) {
       if(class(cop)!="indepCopula") {
         if(class(cop) == "asCopula") {
@@ -522,7 +524,9 @@
       else 
         tmploglik <- c(tmploglik, sum(dCopula(bins$lagData[[i]], cop, log=T)))
       tmpCop <- append(tmpCop, cop)
+      setTxtProgressBar(pb, i)
     }
+    close(pb)
     loglik <- cbind(loglik, tmploglik)
     copulas[[class(cop)]] <- tmpCop
   }
@@ -576,6 +580,12 @@
                                                  claytonCopula(0), frankCopula(1), 
                                                  gumbelCopula(1)),
                                 calcCor) {
+  bins$lagData <- lapply(bins$lagData, 
+                         function(pairs) { 
+                           bool <- !is.na(pairs[,1]) & !is.na(pairs[,2])
+                           pairs[bool,]
+                         })
+  
   if(missing(calcCor))
     return(loglikByCopulasLags.static(bins, families))
   else

Modified: pkg/R/spatialPreparation.R
===================================================================
--- pkg/R/spatialPreparation.R	2013-12-18 09:22:32 UTC (rev 119)
+++ pkg/R/spatialPreparation.R	2014-02-03 09:05:48 UTC (rev 120)
@@ -299,6 +299,7 @@
   else {
     tempIndices <- NULL
     for (t.lag in rev(t.lags)) {
+#       smplInd <- max(1,1-min(t.lags)):min(lengthTime,lengthTime-min(t.lags))
       smplInd <- sample(x=max(1,1-min(t.lags)):min(lengthTime,lengthTime-min(t.lags)),
                         size=min(instances,lengthTime-max(abs(t.lags))))
       tempIndices <- cbind(smplInd+t.lag, tempIndices)
@@ -329,7 +330,9 @@
   calcTau <- function(binnedData) {
     cors <- NULL
     for(i in 1:(ncol(binnedData)/2)) {
-      cors <- c(cors, VineCopula:::fasttau(binnedData[,2*i-1], binnedData[,2*i]))
+      tmpData <- binnedData[,2*i+c(-1,0)]
+      tmpData <- tmpData[!apply(tmpData, 1, function(x) any(is.na(x))),]
+      cors <- c(cors, VineCopula:::fasttau(tmpData[,1], tmpData[,2]))
     }
     return(cors)
   }