[spcopula-commits] r126 - in pkg: . R man

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

Author: ben_graeler
Date: 2014-02-17 16:46:15 +0100 (Mon, 17 Feb 2014)
New Revision: 126

Modified:
   pkg/DESCRIPTION
   pkg/R/spatio-temporalPreparation.R
   pkg/man/reduceNeighbours.Rd
Log:
- improvement of reduceNeighbours for prediction neighbourhoods

Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION	2014-02-14 10:34:29 UTC (rev 125)
+++ pkg/DESCRIPTION	2014-02-17 15:46:15 UTC (rev 126)
@@ -2,7 +2,7 @@
 Type: Package
 Title: copula driven spatial analysis
 Version: 0.2-0
-Date: 2014-02-14
+Date: 2014-02-17
 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/spatio-temporalPreparation.R
===================================================================
--- pkg/R/spatio-temporalPreparation.R	2014-02-14 10:34:29 UTC (rev 125)
+++ pkg/R/spatio-temporalPreparation.R	2014-02-17 15:46:15 UTC (rev 126)
@@ -160,23 +160,31 @@
 
 
 ## reduction of a larger neigbopurhood based on correlation strengths
-reduceNeighbours <- function(stNeigh, stDepFun, n) {
+reduceNeighbours <- function(stNeigh, stDepFun, n, 
+                             prediction=stNeigh at prediction, dropEmpty=!prediction) {
   stopifnot(n>0)
   
   # transform distances into correlations to detect the strongest correlated ones
   dimStNeigh <- dim(stNeigh at distances)
   corMat <- matrix(NA, dimStNeigh[1], dimStNeigh[2])
   
-  pb <- txtProgressBar(0, dimStNeigh[2], style=3)
+  pb <- txtProgressBar(0, 2*dimStNeigh[1], style=3)
   for (i in 1:dimStNeigh[2]) {
-    boolNA <- is.na(stNeigh at data[[1]]) | is.na(stNeigh at data[[1+i]])
+    # whether neighbours are missing: set distance to NA
+    if (prediction) # central location is not part of the data
+      boolNA <- is.na(stNeigh at data[[i]])
+    else {
+      if(dropEmpty) # neighbourrhoods with missing central location are not to be considered
+        boolNA <- is.na(stNeigh at data[[1]]) | is.na(stNeigh at data[[1+i]])
+      else # do not care about NA at the central location (e.g. cross-validation)
+        boolNA <- is.na(stNeigh at data[[1+i]])
+    }
     stNeigh at distances[boolNA,i,] <- c(NA,NA)
     tLag <- -1*stNeigh at distances[!boolNA,i,2][1]+1
     corMat[!boolNA,i] <- stDepFun(stNeigh at distances[!boolNA,i,1], tLag)
-    setTxtProgressBar(pb, i)
+    setTxtProgressBar(pb, i*dimStNeigh[1]/dimStNeigh[2])
   }
-  close(pb)
-  
+    
   highCorMat <- t(apply(corMat, 1, function(x) order(x, na.last=TRUE, decreasing=TRUE)[1:n]))
   nrCM <- nrow(highCorMat)
   
@@ -185,23 +193,36 @@
   stNeighIndeRed <- array(NA, dim=c(nrCM, n+1, 2))
   if (length(stNeigh at coVar) > 0) {
     for (i in 1:nrCM) {
-      selCol <- c(1,highCorMat[i,]+1, ncol(stNeigh at data)-((length(stNeigh at coVar)-1):0))
+      if (prediction)
+        selCol <- c(highCorMat[i,], ncol(stNeigh at data)-((length(stNeigh at coVar)-1):0))
+      else 
+        selCol <- c(1,highCorMat[i,]+1, ncol(stNeigh at data)-((length(stNeigh at coVar)-1):0))
       stNeighDataRed[i,] <- as.numeric(stNeigh at data[i,selCol])
       stNeighDistRed[i,,] <- stNeigh at distances[i,highCorMat[i,],]
       stNeighIndeRed[i,,] <- stNeigh at index[i,c(1,highCorMat[i,]+1),]
+      setTxtProgressBar(pb, dimStNeigh[1]+i)
     }
   } else {
     for (i in 1:nrCM) {
-      stNeighDataRed[i,] <- as.numeric(stNeigh at data[i,c(1,highCorMat[i,]+1)])
+      if (prediction)
+        selCol <- c(highCorMat[i,])
+      else
+        selCol <- c(1,highCorMat[i,]+1)
+      stNeighDataRed[i,] <- as.numeric(stNeigh at data[i, selCol])
       stNeighDistRed[i,,] <- stNeigh at distances[i,highCorMat[i,],]
       stNeighIndeRed[i,,] <- stNeigh at index[i,c(1,highCorMat[i,]+1),]
+      setTxtProgressBar(pb, dimStNeigh[1]+i)
     }
   }
+  close(pb)
   
-  boolNA <- !is.na(stNeigh at data[[1]])
-  stNeighDataRed <- stNeighDataRed[boolNA,]
-  stNeighDistRed <- stNeighDistRed[boolNA,,]
-  stNeighIndeRed <- stNeighIndeRed[boolNA,,]
+  # check whether neighbourhoods with missing central locations need to be dropped
+  if (dropEmpty) {
+    boolNA <- !is.na(stNeigh at data[[1]])
+    stNeighDataRed <- stNeighDataRed[boolNA,]
+    stNeighDistRed <- stNeighDistRed[boolNA,,]
+    stNeighIndeRed <- stNeighIndeRed[boolNA,,]
+  }
   
   return(stNeighbourhood(stNeighDataRed, stNeighDistRed, stNeighIndeRed,
                          var=stNeigh at var, coVar=stNeigh at coVar,

Modified: pkg/man/reduceNeighbours.Rd
===================================================================
--- pkg/man/reduceNeighbours.Rd	2014-02-14 10:34:29 UTC (rev 125)
+++ pkg/man/reduceNeighbours.Rd	2014-02-17 15:46:15 UTC (rev 126)
@@ -8,7 +8,8 @@
 A function selecting the strongest correlated neighbours from a larger set of neighbours
 }
 \usage{
-reduceNeighbours(stNeigh, stDepFun, n)
+reduceNeighbours(stNeigh, stDepFun, n,
+                 prediction=stNeigh at prediction, dropEmpty=!prediction)
 }
 
 \arguments{
@@ -18,10 +19,10 @@
   \item{stDepFun}{
 a spatio-temporal dependence function that return correlation estimates based on a spatial and temporal distance
 }
-  \item{n}{
-the number of neighbours to be selected.
+  \item{n}{the number of neighbours to be selected.}
+  \item{prediction}{whether the neighbourhood is used for prediction (the data slot does not provide the central location's data)}
+  \item{dropEmpty}{whether empty neighbourhoods (i.e. neighbourhoods with \code{NA}'s at the central location) shall be dropped.}
 }
-}
 \value{A spatio-temporal neighbourhood \code{\linkS4class{stNeighbourhood}} with fewer neighbours.}
 
 \author{