From noreply at r-forge.r-project.org  Thu Apr  4 19:50:25 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Thu,  4 Apr 2013 19:50:25 +0200 (CEST)
Subject: [spcopula-commits] r90 - / pkg pkg/R
Message-ID: <20130404175025.53EC5184FF4@r-forge.r-project.org>

Author: ben_graeler
Date: 2013-04-04 19:50:25 +0200 (Thu, 04 Apr 2013)
New Revision: 90

Modified:
   pkg/DESCRIPTION
   pkg/NAMESPACE
   pkg/R/Classes.R
   pkg/R/spVineCopula.R
   pkg/R/spatialPreparation.R
   pkg/R/vineCopulas.R
   spcopula_0.1-1.tar.gz
Log:
- added spCopPredict functions
- cleaning
- getNeighbours can be used for prediction as well, twice as fast as before
- all fitCopula retun now a fitCopula object

Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION	2013-03-27 19:13:09 UTC (rev 89)
+++ pkg/DESCRIPTION	2013-04-04 17:50:25 UTC (rev 90)
@@ -2,7 +2,7 @@
 Type: Package
 Title: copula driven spatial analysis
 Version: 0.1-1
-Date: 2013-02-20
+Date: 2013-04-04
 Author: Benedikt Graeler
 Maintainer: Benedikt Graeler <ben.graeler at uni-muenster.de>
 Description: This package provides a framework to analyse via copulas spatial and spatio-temporal data provided in the format of the spacetime package. Additionally, support for calculating different multivariate return periods is implemented.

Modified: pkg/NAMESPACE
===================================================================
--- pkg/NAMESPACE	2013-03-27 19:13:09 UTC (rev 89)
+++ pkg/NAMESPACE	2013-04-04 17:50:25 UTC (rev 90)
@@ -19,6 +19,7 @@
 export(dduCopula,ddvCopula)
 export(invdduCopula, invddvCopula)
 export(qCopula_u)
+export(condSpVine,spCopPredict)
 
 # tweaks
 # export(setSizeLim)

Modified: pkg/R/Classes.R
===================================================================
--- pkg/R/Classes.R	2013-03-27 19:13:09 UTC (rev 89)
+++ pkg/R/Classes.R	2013-04-04 17:50:25 UTC (rev 90)
@@ -147,9 +147,12 @@
   else return (TRUE)
 }
 
+setOldClass("RVineMatrix")
+
 setClass("vineCopula",
          representation = representation(copulas="list", dimension="integer", 
-                                         RVM="list"),
+                                         RVM="RVineMatrix"),
+         prototype = prototype(RVM=structure(list(),class="RVineMatrix")),
          validity = validVineCopula,
          contains = list("copula")
 )
@@ -188,18 +191,20 @@
 validNeighbourhood <- function(object) {
   sizeN <- ncol(object at distances)+1
   nVars <- length(object at varNames)
-  if (sizeN > sizeLim) return("The limting size of the neighbourhood is exceeded. Increase the constant sizeLim if needed.")
   if (nrow(object at data) != nrow(object at distances)) return("Data and distances have unequal number of rows.")
-  if (ncol(object at data) %% sizeN != 0) return("Data and distances have non matching number of columns.")
-#   if (nrow(object at data) != nrow(object at coords) ) return("Data and sp at coordinates have unequal number of rows.")
+  if (ncol(object at data) %% (sizeN-object at prediction) != 0) return("Data and distances have non matching number of columns.")
   if (nrow(object at data) != nrow(object at index)) return("Data and index have unequal number of rows.")
-  if (sizeN != ncol(object at index)) return("Data and index have unequal number of columns.")
-  if (ncol(object at data) != sizeN * nVars) return(paste("Number of columns in data does not equal the product of the neighbourhood's size (",sizeN,") with number of variables (",nVars,").",sep=""))
+  if (ncol(object at distances) != ncol(object at index)) return("Data and index have unequal number of columns.")
+  if (ncol(object at data) != (sizeN-object at prediction) * nVars) return(paste("Number of columns in data does not equal the product of the neighbourhood's size (",sizeN,") with number of variables (",nVars,").",sep=""))
   else return(TRUE)
 }
 
 setClass("neighbourhood",
-  representation = representation(data = "data.frame", distances="matrix", "SpatialPoints", index="matrix", varNames="character"),
-  validity = validNeighbourhood,
-  contains = list("SpatialPoints"))
+         representation = representation(data = "data.frame", 
+                                         distances="matrix", 
+                                         index="matrix",
+                                         locations="Spatial", 
+                                         varNames="character", 
+                                         prediction="logical"),
+         validity = validNeighbourhood, contains = list("Spatial"))
 

Modified: pkg/R/spVineCopula.R
===================================================================
--- pkg/R/spVineCopula.R	2013-03-27 19:13:09 UTC (rev 89)
+++ pkg/R/spVineCopula.R	2013-04-04 17:50:25 UTC (rev 90)
@@ -47,9 +47,14 @@
             dspVine(matrix(u,ncol=copula at dimension), copula at spCop, copula at vineCop, log=log, ...)
           })
 
+setMethod("dCopula",signature=signature("data.frame","spVineCopula"),
+          function(u, copula, log, ...) {
+            dspVine(as.matrix(u), copula at spCop, copula at vineCop, log=log, ...)
+          })
+
 # fiiting the spatial vine for a given spatial copula
 
-fitSpVine <- function(copula, data) {
+fitSpVine <- function(copula, data, method) {
   stopifnot(class(data)=="neighbourhood")
   stopifnot(copula at dimension == ncol(data at data))
   
@@ -60,9 +65,83 @@
                                 copula=copula at spCop, h=data at distances[,i]))
   }
   
-  vineCop <- fitCopula(copula at vineCop, secLevel) 
+  vineCopFit <- fitCopula(copula at vineCop, secLevel, method) 
   
-  return(spVineCopula(copula at spCop, vineCop))
+  spVineCop <- spVineCopula(copula at spCop, vineCopFit at copula)
+    
+  return(new("fitCopula", estimate = spVineCop at parameters, var.est = matrix(NA), 
+             method = method, 
+             loglik = sum(dCopula(data at data, spVineCop, h=data at distances, log=T)),
+             fitting.stats=list(convergence = as.integer(NA)),
+             nsample = nrow(data at data), copula=spVineCop))
 }
 
-setMethod("fitCopula",signature=signature("spVineCopula"),fitSpVine)
\ No newline at end of file
+setMethod("fitCopula",signature=signature("spVineCopula"),fitSpVine)
+
+# conditional spatial vine
+condSpVine <- function(condVar, dists, spVine, n=100) {
+  rat <- 0.2/(1:(n/2))-(0.1/((n+1)/2))
+  xVals <- unique(sort(c(rat,1-rat,1:(n-1)/(n))))
+  xLength <- length(xVals)
+  repCondVar <- matrix(condVar, ncol=length(condVar), nrow=xLength, byrow=T)
+  density <- dCopula(cbind(xVals, repCondVar), spVine, h=dists)
+  
+  linAppr <- approxfun(c(0,xVals,1), density[c(1,1:xLength,xLength)] ,yleft=0, yright=0)
+  int <- integrate(linAppr,lower=0, upper=1)$value
+  
+  return(function(u) linAppr(u)/int)
+}
+
+# interpolation
+
+spCopPredict.expectation <- function(predNeigh, spVine, margin) {
+  stopifnot(is.function(margin$d))
+  stopifnot(is.function(margin$p))
+  
+  predMean <- NULL
+  for(i in 1:nrow(predNeigh at data)) { # i <-1
+    condSecVine <- condSpVine(as.numeric(predNeigh at data[i,]), predNeigh at distances[i,], spVine)
+    
+    condExp <-  function(x) {
+      condSecVine(margin$p(x))*margin$d(x)*x
+    }
+    
+    predMean <- c(predMean, integrate(condExp,0,3000,subdivisions=1e6)$value)
+  }
+  if ("data" %in% slotNames(predNeigh at locations)) {
+    res <- predNeigh at locations
+    res at data[["expect"]] <- predMean
+    return(res)
+  } else {
+    predMean <- data.frame(predMean)
+    colnames(predMean) <- "expect"
+    return(addAttrToGeom(predNeigh at locations, predMean, match.ID=FALSE))
+  }
+}
+
+spCopPredict.quantile <- function(predNeigh, spVine, margin, p=0.5) {
+  stopifnot(is.function(margin$q))
+  
+  predQuantile <- NULL
+  for(i in 1:nrow(predNeigh at data)) { # i <-1
+    condSecVine <- condSpVine(as.numeric(predNeigh at data[i,]), predNeigh at distances[i,], spVine)  
+    pPred <- optimise(function(x) abs(integrate(condSecVine,0,x)$value-p),
+                      c(0,1))$minimum
+    predQuantile <- c(predQuantile, margin$q(pPred))
+  }
+  if ("data" %in% slotNames(predNeigh at locations)) {
+    res <- predNeigh at locations
+    res at data[[paste("quantile.",p,sep="")]] <- predQuantile
+    return(res)
+  } else {
+    predQuantile <- data.frame(predQuantile)
+    colnames(predQuantile) <- paste("quantile.",p,sep="")
+    return(addAttrToGeom(predNeigh at locations, predQuantile, match.ID=FALSE))
+  }
+}
+
+spCopPredict <- function(predNeigh, spVine, margin, method="quantile", p=0.5) {
+  switch(method,
+         quantile=spCopPredict.quantile(predNeigh, spVine, margin, p),
+         expectation=spCopPredict.expectation(predNeigh, spVine, margin))
+}
\ No newline at end of file

Modified: pkg/R/spatialPreparation.R
===================================================================
--- pkg/R/spatialPreparation.R	2013-03-27 19:13:09 UTC (rev 89)
+++ pkg/R/spatialPreparation.R	2013-04-04 17:50:25 UTC (rev 90)
@@ -11,12 +11,14 @@
 # sp="SpatialPoints"	SpatialPoints object providing the coordinates
 # index="matrix"	linking the obs. in data to the coordinates
 
-neighbourhood <- function(data, distances, sp, index){
-  varNames <- names(data)[[1]]
+neighbourhood <- function(data, distances, sp, index, prediction, varNames){
   sizeN <- ncol(distances)+1
   data <- as.data.frame(data)
-  colnames(data) <- paste(paste("N",rep(0:(sizeN-1),each=length(varNames)),sep=""),rep(varNames,sizeN),sep=".")
-  new("neighbourhood", data=data, distances=distances, coords=sp at coords, bbox=sp at bbox, proj4string=sp at proj4string, index=index, varNames=varNames)
+  colnames(data) <- paste(paste("N", rep((0+prediction):(sizeN-1), each=length(varNames)), sep=""),
+                          rep(varNames,(sizeN-prediction)),sep=".")
+  new("neighbourhood", data=data, distances=distances, locations=sp, 
+      bbox=sp at bbox, proj4string=sp at proj4string, index=index, varNames=varNames, 
+      prediction=prediction)
 }
 
 ## show
@@ -45,60 +47,58 @@
 ## calculate neighbourhood from SpatialPointsDataFrame
 
 # returns an neighbourhood object
-# spData	spatialPointsDataFrame
-# var 		one or multiple variable names, all is the default
-# size		the size of the neighbourhood, default of 5
-# dep		denoting a subset of dependent locations (default NULL: all locations will be used)
-# indep		denoting a subset of independent locations (default NULL: all locations will be used)
-#		no location will be paired with itself
-getNeighbours <- function(spData,var=names(spData),size=4,dep=NULL,indep=NULL,min.dist=10){
-nLocs <- length(spData)
-distMat <- spDists(spData)
-if(min.dist>0) distMat[distMat<min.dist] <- Inf
-if ( any(is.na( match(var,names(spData)) )) ) 
-  stop("At least one of the variables is unkown or is not part of the data.")
-if(is.null(dep) & !is.null(indep))   dep <- 1:nLocs[-indep]
-if(!is.null(dep) & is.null(indep)) indep <- 1:nLocs[-dep]
-if(!is.null(dep) & !is.null(indep)) {
-  cat("Reduced distance matrix is used: (",paste(dep,collapse=", "),") x (",paste(indep,collapse=", "),")",sep="")
-} else {
-  dep <- 1:nLocs
-  indep <- 1:nLocs
-}
+# spData	    spatialPointsDataFrame
+# locations   the prediction locations, for fitting, locations=spData
+# var 		    one or multiple variable names, all is the default
+# size		    the size of the neighbourhood, note that for prediction the size 
+#             is one less than for the copula estimation (default of 5)
+# min.dist    the minimum distance between neighbours, must be positive
 
-size <- min(size,length(indep)-1)
-if (size > sizeLim) {
-  stop(paste("Evaluation of copulas might take a long time for more than",
-         sizeLim," neighbours. Increase sizeLim if you want to evaluate neighbourhoods with",
-	 size,"locations."))
-}
+getNeighbours <- function(spData, locations, var=names(spData), size=5, 
+                          prediction=FALSE, min.dist=0.01) {
+  
+  stopifnot((!prediction && missing(locations)) || (prediction && !missing(locations)))
+  stopifnot(min.dist>0 || prediction)
+  
+  if(missing(locations) && !prediction)
+    locations=spData
+  
+  stopifnot(is(locations,"Spatial"))
+  
+  nLocs <- length(locations)
+  
+  if(any(is.na(match(var,names(spData)))))
+    stop("At least one of the variables is unkown or is not part of the data.")
 
-lData <- vector("list",size)
-index <- NULL
-dists <- NULL
+  size <- min(size,length(spData))
 
-for (i in dep) {
-  nbrs <- matrix(Inf,ncol=2,nrow=size-1)
-  ind <- logical(nLocs)
-  ind[indep] <- TRUE
-  ind[i] <- FALSE
-  for (j in (1:nLocs)[ind]) {
-    tmpDist <- distMat[i,j]
-    if (any(tmpDist < nbrs[,1])) {
-      nbrs[size-1,] <- c(tmpDist,j)
-      nbrs <- nbrs[order(nbrs[,1]),]
-    }
+  allDists <- NULL
+  allLocs <- NULL
+  allData <- NULL
+  
+  for(i in 1:length(locations)) { # i <- 1
+    tempDists <- spDistsN1(spData,locations[i,])
+    tempDists[tempDists < min.dist] <- Inf
+    spLocs <- order(tempDists)[1:(size-1)]
+    allLocs <- rbind(allLocs, spLocs)
+    allDists <- rbind(allDists, tempDists[spLocs])
+    
+    if(!prediction)
+      spLocs <- c(i,spLocs)
+    allData <- rbind(allData, as.vector(spData[spLocs, var, drop=F]@data[[1]]))
   }
-  lData[[1]] <- rbind(lData[[1]],spData at data[i,var,drop=FALSE])
-  for (nbr in 2:size) {
-    lData[[nbr]] <- rbind(lData[[nbr]],spData at data[nbrs[nbr-1,2],var,drop=FALSE])
-  }
-  index <- rbind(index, c(i,nbrs[,2]))
-  dists <- rbind(dists, c(nbrs[,1]))
+  
+  return(neighbourhood(allData, allDists, locations, 
+                       allLocs, prediction, var))
 }
 
-return(neighbourhood(as.data.frame(lData), dists, SpatialPoints(spData), index))
-}
+# data(meuse)
+# coordinates(meuse) <- ~x+y
+# meuseNeigh <- getNeighbours(meuse,var="zinc",size=5)
+# str(meuseNeigh)
+# 
+# meuseNeigh <- addAttrToGeom(meuseNeigh at locations,data.frame(rnd=runif(155)),match.ID=F)
+# str(meuseNeigh)
 
 #############
 ## BINNING ##

Modified: pkg/R/vineCopulas.R
===================================================================
--- pkg/R/vineCopulas.R	2013-03-27 19:13:09 UTC (rev 89)
+++ pkg/R/vineCopulas.R	2013-04-04 17:50:25 UTC (rev 90)
@@ -14,13 +14,13 @@
       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
   stopifnot(class(RVM)=="RVineMatrix") 
-    class(RVM) <- "list"
   
   ltr <- lower.tri(RVM$Matrix)
   copDef <- cbind(RVM$family[ltr], RVM$par[ltr], RVM$par2[ltr])
-  copulas <- rev(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(),
@@ -45,7 +45,7 @@
 
 dRVine <- function(u, copula, log=F) {
   RVM <- copula at RVM
-  class(RVM) <- "RVineMatrix"
+#   class(RVM) <- "RVineMatrix"
   vineLoglik <- RVineLogLik(u, RVM, separate=T)$loglik
   if(log)
     return(vineLoglik)
@@ -54,111 +54,15 @@
 }
 
 setMethod("dCopula", signature("numeric","vineCopula"), 
-          function(u, copula, log, ...) dRVine(matrix(u, ncol=copula at dimension), copula, log, ...))
+          function(u, copula, log, ...) {
+            dRVine(matrix(u, ncol=copula at dimension), copula, log, ...)
+          })
 setMethod("dCopula", signature("matrix","vineCopula"), dRVine)
+setMethod("dCopula", signature("data.frame","vineCopula"), 
+          function(u, copula, log, ...) {
+            dRVine(as.matrix(u), copula, log, ...)
+          })
 
-# ## d-vine structure
-# 
-# # copula <- vineFit
-# # u <- empVine
-# #   empCopVine
-# 
-# # dDvine(vineFit, empVine,log=T)
-# 
-# dDvine <- function(copula, u, log=FALSE){
-#   dim <- copula at dimension
-#   tmp <- u
-#   u <- NULL
-#   u[[1]] <- matrix(tmp,ncol=dim)
-#   
-#   den <- rep(1,nrow(u[[1]]))
-#   
-#   newU <- NULL
-#   for (i in 1:(dim-1)) {
-#     tmpCop <- copula at copulas[[i]]
-#     tmpU <- u[[1]][,i:(i+1)]
-#     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 {
-#       newU <- cbind(newU, dduCopula(tmpU, tmpCop))
-#     }
-#     if (1<i & i<(dim-1)) { 
-#       newU <- cbind(newU, ddvCopula(tmpU, tmpCop))
-#     }
-#   }
-#   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)]
-#       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))
-#         } else {
-#           newU <- cbind(newU,dduCopula(tmpU, tmpCop))
-#         }
-#         if (1<i & i<(dim-1)) { 
-#           newU <- cbind(newU,ddvCopula(tmpU, tmpCop))
-#         }
-#       } 
-#     }
-#     u[[l+1]] <- newU
-#     used <- used + dim - l
-#   }
-#   
-#   return(den)
-# }
-# 
-# ## c-vine structure
-# 
-# dCvine <- function(copula, u) {
-# #   cat("c-vine \n")
-#   dim <- copula at dimension
-#   tmp <- u
-#   u <- NULL
-#   u[[1]] <- matrix(tmp,ncol=dim)
-#   
-#   den <- rep(1,nrow(u[[1]]))
-# 
-#   used <- 0 # already used copulas
-#   
-#   for (l in 1:(dim-1)) {
-#     newU <- NULL
-#     for (i in 1:(dim-l)) {
-# #       cat(used+i,"\n")
-#       tmpCop <- copula at copulas[[used+i]]
-#       tmpU <- u[[l]][,c(1,(i+1))]
-#       den <- den*dCopula(tmpU, tmpCop)
-#       if(l < (dim-1)) newU <- cbind(newU,dduCopula(tmpU, tmpCop))
-#     }
-#     if(l < (dim-1)) {
-#       u[[l+1]] <- newU
-#       used <- used + dim - l
-#     }
-#   }
-#   
-#   return(den)
-# }
-# 
-# ##
-# 
-# dvineCopula <- function(u, copula, log=F) { 
-#   den <- switch(getNumType(copula),dCvine ,dDvine)
-#   return(den(copula, u, log))
-# } 
-
 ## jcdf ##
 pvineCopula <- function(u, copula) {
   empCop <- genEmpCop(copula, 1e5)
@@ -166,35 +70,17 @@
   return(pCopula(u, empCop))
 }
 
-setMethod("pCopula", signature("numeric","vineCopula"), pvineCopula)
+setMethod("pCopula", signature("numeric","vineCopula"), 
+          function(u,copula) {
+            pvineCopula(matrix(u, ncol=copula at dimension),copula)
+          })
+setMethod("pCopula", signature("data.frame","vineCopula"), 
+          function(u,copula) pvineCopula(as.matrix(u),copula))
 setMethod("pCopula", signature("matrix","vineCopula"), pvineCopula)
 
-
-## random numbers
-# linkVineCopSim <- function(n, copula) {
-#   numType <- getNumType(copula)
-# 
-#   getFamily <- function(copula) {
-#     if("family" %in% slotNames(copula)) numFam <- copula at family
-#     else {
-#       numFam <- switch(class(copula)[1], normalCopula=1, tCopula=2, claytonCopula=3, gumbelCopula=4, frankCopula=5)
-#     }
-#   }
-# 
-#   par1 <- unlist(lapply(copula at copulas,function(x) x at parameters[1]))
-#   par2 <- unlist(lapply(copula at copulas,function(x) x at parameters[2]))
-#   par2[is.na(par2)] <- 0
-#   numFam <- unlist(lapply(copula at copulas,getFamily))
-#   tcops <- which(numFam==2) #? length(which(5==3))
-#   if(length(tcops)>0) 
-#     par2[tcops] <- unlist(lapply(copula at copulas[tcops], function(x) x at df))
-#   
-#   return(RVineSim(n, C2RVine(1:copula at dimension, numFam, par1, par2)))
-# }
-
 rRVine <- function(n, copula) {
   RVM <- copula at RVM
-  class(RVM) <- "RVineMatrix"
+#   class(RVM) <- "RVineMatrix"
   RVineSim(n, RVM)
 }
 
@@ -204,9 +90,16 @@
 fitVineCop <- function(copula, data, method) {
   stopifnot(copula at dimension==ncol(data))
   if("StructureSelect" %in% method)
-    vineCopula(RVineStructureSelect(data, indeptest="indeptest" %in% method))
+    vineCop <- vineCopula(RVineStructureSelect(data, indeptest="indeptest" %in% method))
   else
-    vineCopula(RVineCopSelect(data, Matrix=copula at RVM$Matrix, indeptest="indeptest" %in% method))
+    vineCop <- vineCopula(RVineCopSelect(data, Matrix=copula at RVM$Matrix, 
+                                         indeptest="indeptest" %in% method))
+  
+  return(new("fitCopula", estimate = vineCop at parameters, var.est = matrix(NA), 
+             method = method, 
+             loglik = RVineLogLik(data, vineCop at RVM)$loglik,
+             fitting.stats=list(convergence = as.integer(NA)),
+             nsample = nrow(data), copula=vineCop))
 }
 
 setMethod("fitCopula", signature=signature("vineCopula"), fitVineCop) 
\ No newline at end of file

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


From noreply at r-forge.r-project.org  Fri Apr  5 12:53:11 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Fri,  5 Apr 2013 12:53:11 +0200 (CEST)
Subject: [spcopula-commits] r91 - / pkg pkg/R pkg/man
Message-ID: <20130405105311.3CA9D181130@r-forge.r-project.org>

Author: ben_graeler
Date: 2013-04-05 12:53:10 +0200 (Fri, 05 Apr 2013)
New Revision: 91

Added:
   pkg/man/condSpVine.Rd
   pkg/man/spCopPredict.Rd
Modified:
   pkg/DESCRIPTION
   pkg/R/Classes.R
   pkg/R/spatialPreparation.R
   pkg/man/BB1Copula-class.Rd
   pkg/man/BB1Copula.Rd
   pkg/man/BB6Copula-class.Rd
   pkg/man/BB6Copula.Rd
   pkg/man/BB7Copula-class.Rd
   pkg/man/BB7Copula.Rd
   pkg/man/BB8Copula-class.Rd
   pkg/man/BB8Copula.Rd
   pkg/man/asCopula.Rd
   pkg/man/calcBins.Rd
   pkg/man/composeSpCopula.Rd
   pkg/man/copulaFromFamilyIndex.Rd
   pkg/man/criticalLevel.Rd
   pkg/man/criticalPair.Rd
   pkg/man/criticalTriple.Rd
   pkg/man/dduCopula.Rd
   pkg/man/dependencePlot.Rd
   pkg/man/empiricalCopula-class.Rd
   pkg/man/empiricalCopula.Rd
   pkg/man/fitCorFun.Rd
   pkg/man/fitSpCopula.Rd
   pkg/man/genEmpCop.Rd
   pkg/man/genEmpKenFun.Rd
   pkg/man/getKendallDistr.Rd
   pkg/man/getNeighbours.Rd
   pkg/man/joeBiCopula-class.Rd
   pkg/man/kendallDistribution.Rd
   pkg/man/kendallRP.Rd
   pkg/man/loglikByCopulasLags.Rd
   pkg/man/neighbourhood-class.Rd
   pkg/man/neighbourhood.Rd
   pkg/man/qCopula_u.Rd
   pkg/man/rankTransform.Rd
   pkg/man/simulatedTriples.Rd
   pkg/man/spCopula-class.Rd
   pkg/man/spCopula.Rd
   pkg/man/spVineCopula-class.Rd
   pkg/man/spcopula-package.Rd
   pkg/man/surClaytonCopula-class.Rd
   pkg/man/surClaytonCopula.Rd
   pkg/man/surGumbelCopula-class.Rd
   pkg/man/surGumbelCopula.Rd
   pkg/man/unitScatter.Rd
   pkg/man/vineCopula-class.Rd
   pkg/man/vineCopula.Rd
   spcopula_0.1-1.tar.gz
   spcopula_0.1-1.zip
Log:
- spell check
- documentation spCopPredict.Rd, condSpVine.Rd

Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION	2013-04-04 17:50:25 UTC (rev 90)
+++ pkg/DESCRIPTION	2013-04-05 10:53:10 UTC (rev 91)
@@ -2,7 +2,7 @@
 Type: Package
 Title: copula driven spatial analysis
 Version: 0.1-1
-Date: 2013-04-04
+Date: 2013-04-05
 Author: Benedikt Graeler
 Maintainer: Benedikt Graeler <ben.graeler at uni-muenster.de>
 Description: This package provides a framework to analyse via copulas spatial and spatio-temporal data provided in the format of the spacetime package. Additionally, support for calculating different multivariate return periods is implemented.

Modified: pkg/R/Classes.R
===================================================================
--- pkg/R/Classes.R	2013-04-04 17:50:25 UTC (rev 90)
+++ pkg/R/Classes.R	2013-04-05 10:53:10 UTC (rev 91)
@@ -190,7 +190,7 @@
 # index: a matrix linking the data entries with the coordinates of the locations
 validNeighbourhood <- function(object) {
   sizeN <- ncol(object at distances)+1
-  nVars <- length(object at varNames)
+  nVars <- length(object at var)
   if (nrow(object at data) != nrow(object at distances)) return("Data and distances have unequal number of rows.")
   if (ncol(object at data) %% (sizeN-object at prediction) != 0) return("Data and distances have non matching number of columns.")
   if (nrow(object at data) != nrow(object at index)) return("Data and index have unequal number of rows.")
@@ -204,7 +204,7 @@
                                          distances="matrix", 
                                          index="matrix",
                                          locations="Spatial", 
-                                         varNames="character", 
+                                         var="character", 
                                          prediction="logical"),
          validity = validNeighbourhood, contains = list("Spatial"))
 

Modified: pkg/R/spatialPreparation.R
===================================================================
--- pkg/R/spatialPreparation.R	2013-04-04 17:50:25 UTC (rev 90)
+++ pkg/R/spatialPreparation.R	2013-04-05 10:53:10 UTC (rev 91)
@@ -11,13 +11,13 @@
 # sp="SpatialPoints"	SpatialPoints object providing the coordinates
 # index="matrix"	linking the obs. in data to the coordinates
 
-neighbourhood <- function(data, distances, sp, index, prediction, varNames){
+neighbourhood <- function(data, distances, sp, index, prediction, var){
   sizeN <- ncol(distances)+1
   data <- as.data.frame(data)
-  colnames(data) <- paste(paste("N", rep((0+prediction):(sizeN-1), each=length(varNames)), sep=""),
-                          rep(varNames,(sizeN-prediction)),sep=".")
+  colnames(data) <- paste(paste("N", rep((0+prediction):(sizeN-1), each=length(var)), sep=""),
+                          rep(var,(sizeN-prediction)),sep=".")
   new("neighbourhood", data=data, distances=distances, locations=sp, 
-      bbox=sp at bbox, proj4string=sp at proj4string, index=index, varNames=varNames, 
+      bbox=sp at bbox, proj4string=sp at proj4string, index=index, var=var, 
       prediction=prediction)
 }
 
@@ -25,20 +25,22 @@
 showNeighbourhood <- function(object){
   cat("A set of neighbourhoods consisting of", ncol(object at distances)+1, "locations each \n")
   cat("with",nrow(object at data),"rows of observations for:\n")
-  cat(object at varNames,"\n")
+  cat(object at var,"\n")
 }
 
 setMethod(show,signature("neighbourhood"),showNeighbourhood)
 
 ## names (from sp)
 
-setMethod(names, signature("neighbourhood"), namesNeighbourhood <- function(x) x at varNames)
+setMethod(names, signature("neighbourhood"), namesNeighbourhood <- function(x) x at var)
 
 ## spplot ##
-
 spplotNeighbourhood <- function(obj, zcol=names(obj), ..., column=0) {
-  pattern <- paste(paste("N",column,".",sep=""),zcol,sep="")
-  spdf <- SpatialPointsDataFrame(coords=obj at coords, data=obj at data[,pattern,drop=FALSE], proj4string=obj at proj4string, bbox=obj at bbox)
+  stopifnot(all(column<ncol(obj at data)))
+  pattern <- paste(paste("N", column, ".", sep=""), zcol, sep="")
+  spdf <- SpatialPointsDataFrame(coords=obj at locations, 
+                                 data=obj at data[,pattern,drop=FALSE], 
+                                 proj4string=obj at proj4string, bbox=obj at bbox)
   spplot(spdf, ...)
 }
 
@@ -54,7 +56,7 @@
 #             is one less than for the copula estimation (default of 5)
 # min.dist    the minimum distance between neighbours, must be positive
 
-getNeighbours <- function(spData, locations, var=names(spData), size=5, 
+getNeighbours <- function(spData, locations, var=names(spData)[1], size=5, 
                           prediction=FALSE, min.dist=0.01) {
   
   stopifnot((!prediction && missing(locations)) || (prediction && !missing(locations)))
@@ -70,7 +72,7 @@
   if(any(is.na(match(var,names(spData)))))
     stop("At least one of the variables is unkown or is not part of the data.")
 
-  size <- min(size,length(spData))
+  size <- min(size,length(spData)+prediction)
 
   allDists <- NULL
   allLocs <- NULL

Modified: pkg/man/BB1Copula-class.Rd
===================================================================
--- pkg/man/BB1Copula-class.Rd	2013-04-04 17:50:25 UTC (rev 90)
+++ pkg/man/BB1Copula-class.Rd	2013-04-05 10:53:10 UTC (rev 91)
@@ -30,7 +30,7 @@
 
 \title{Classes \code{"BB1Copula"}, \code{"surBB1Copula"}, \code{"r90BB1Copula"} and \code{"r270BB1Copula"}}
 \description{
-Wrapper classes representing the BB1, survial BB1, 90 degree and 270 degree rotated BB1 copula families (Joe 1997) from \code{\link{VineCopula-package}}.
+Wrapper classes representing the BB1, survival BB1, 90 degree and 270 degree rotated BB1 copula families (Joe 1997) from \code{\link{VineCopula-package}}.
 }
 \section{Objects from the Classes}{
 Objects can be created by calls of the form \code{new("BB1Copula", ...)}, \code{new("surBB1Copula", ...)}, \code{new("r90BB1Copula", ...)} and \code{new("r270BB1Copula", ...)} or by the functions \code{\link{BB1Copula}}, \code{\link{surBB1Copula}}, \code{\link{r90BB1Copula}} and \code{\link{r270BB1Copula}}.

Modified: pkg/man/BB1Copula.Rd
===================================================================
--- pkg/man/BB1Copula.Rd	2013-04-04 17:50:25 UTC (rev 90)
+++ pkg/man/BB1Copula.Rd	2013-04-05 10:53:10 UTC (rev 91)
@@ -5,7 +5,7 @@
 \alias{r270BB1Copula}
 
 \title{
-Constructor of the BB1 family and its derivates
+Constructor of the BB1 family and its derivatives
 }
 \description{
 Constructs an object of the \code{\linkS4class{BB1Copula}} (survival \code{sur}, 90 degree rotated \code{r90} and 270 degree rotated \code{r270}) family for a given parameter.

Modified: pkg/man/BB6Copula-class.Rd
===================================================================
--- pkg/man/BB6Copula-class.Rd	2013-04-04 17:50:25 UTC (rev 90)
+++ pkg/man/BB6Copula-class.Rd	2013-04-05 10:53:10 UTC (rev 91)
@@ -30,7 +30,7 @@
 
 \title{Classes \code{"BB6Copula"}, \code{"surBB6Copula"}, \code{"r90BB6Copula"} and \code{"r270BB6Copula"}}
 \description{
-Wrapper classes representing the BB6, survial BB6, 90 degree and 270 degree rotated BB6 copula families (Joe 1997) from the \code{\link{VineCopula-package}}.
+Wrapper classes representing the BB6, survival BB6, 90 degree and 270 degree rotated BB6 copula families (Joe 1997) from the \code{\link{VineCopula-package}}.
 }
 \section{Objects from the Classes}{
 Objects can be created by calls of the form \code{new("BB6Copula", ...)}, \code{new("surBB6Copula", ...)}, \code{new("r90BB6Copula", ...)} and \code{new("r270BB6Copula", ...)} or by the functions \code{\link{BB6Copula}}, \code{\link{surBB6Copula}}, \code{\link{r90BB6Copula}} and \code{\link{r270BB6Copula}}.

Modified: pkg/man/BB6Copula.Rd
===================================================================
--- pkg/man/BB6Copula.Rd	2013-04-04 17:50:25 UTC (rev 90)
+++ pkg/man/BB6Copula.Rd	2013-04-05 10:53:10 UTC (rev 91)
@@ -5,7 +5,7 @@
 \alias{r270BB6Copula}
 
 \title{
-Constructor of the BB6 family and its derivates
+Constructor of the BB6 family and its derivatives
 }
 \description{
 Constructs an object of the \code{\linkS4class{BB6Copula}} (survival \code{sur}, 90 degree rotated \code{r90} and 270 degree rotated \code{r270}) family for a given parameter.

Modified: pkg/man/BB7Copula-class.Rd
===================================================================
--- pkg/man/BB7Copula-class.Rd	2013-04-04 17:50:25 UTC (rev 90)
+++ pkg/man/BB7Copula-class.Rd	2013-04-05 10:53:10 UTC (rev 91)
@@ -30,7 +30,7 @@
 
 \title{Classes \code{"BB7Copula"}, \code{"surBB7Copula"}, \code{"r90BB7Copula"} and \code{"r270BB7Copula"}}
 \description{
-Wrapper classes representing the BB7, survial BB7, 90 degree and 270 degree rotated BB7 copula families (Joe 1997) from the \code{\link{VineCopula-package}} package.
+Wrapper classes representing the BB7, survival BB7, 90 degree and 270 degree rotated BB7 copula families (Joe 1997) from the \code{\link{VineCopula-package}} package.
 }
 \section{Objects from the Classes}{
 Objects can be created by calls of the form \code{new("BB7Copula", ...)}, \code{new("surBB7Copula", ...)}, \code{new("r90BB7Copula", ...)} and \code{new("r270BB7Copula", ...)} or by the functions \code{\link{BB7Copula}}, \code{\link{surBB7Copula}}, \code{\link{r90BB7Copula}} and \code{\link{r270BB7Copula}}.

Modified: pkg/man/BB7Copula.Rd
===================================================================
--- pkg/man/BB7Copula.Rd	2013-04-04 17:50:25 UTC (rev 90)
+++ pkg/man/BB7Copula.Rd	2013-04-05 10:53:10 UTC (rev 91)
@@ -5,7 +5,7 @@
 \alias{r270BB7Copula}
 
 \title{
-Constructor of the BB7 family and its derivates
+Constructor of the BB7 family and its derivatives
 }
 \description{
 Constructs an object of the \code{\linkS4class{BB7Copula}} (survival \code{sur}, 90 degree rotated \code{r90} and 270 degree rotated \code{r270}) family for a given parameter.

Modified: pkg/man/BB8Copula-class.Rd
===================================================================
--- pkg/man/BB8Copula-class.Rd	2013-04-04 17:50:25 UTC (rev 90)
+++ pkg/man/BB8Copula-class.Rd	2013-04-05 10:53:10 UTC (rev 91)
@@ -30,7 +30,7 @@
 
 \title{Classes \code{"BB8Copula"}, \code{"surBB8Copula"}, \code{"r90BB8Copula"} and \code{"r270BB8Copula"}}
 \description{
-Wrapper classes representing the BB8, survial BB8, 90 degree and 270 degree rotated BB8 copula families (Joe 1997) from the \code{\link{VineCopula-package}} package.
+Wrapper classes representing the BB8, survival BB8, 90 degree and 270 degree rotated BB8 copula families (Joe 1997) from the \code{\link{VineCopula-package}} package.
 }
 \section{Objects from the Classes}{
 Objects can be created by calls of the form \code{new("BB8Copula", ...)}, \code{new("surBB8Copula", ...)}, \code{new("r90BB8Copula", ...)} and \code{new("r270BB8Copula", ...)} or by the functions \code{\link{BB8Copula}}, \code{\link{surBB8Copula}}, \code{\link{r90BB8Copula}} and \code{\link{r270BB8Copula}}.

Modified: pkg/man/BB8Copula.Rd
===================================================================
--- pkg/man/BB8Copula.Rd	2013-04-04 17:50:25 UTC (rev 90)
+++ pkg/man/BB8Copula.Rd	2013-04-05 10:53:10 UTC (rev 91)
@@ -5,7 +5,7 @@
 \alias{r270BB8Copula}
 
 \title{
-Constructor of the BB8 family and its derivates
+Constructor of the BB8 family and its derivatives
 }
 \description{
 Constructs an object of the \code{\linkS4class{BB8Copula}} (survival \code{sur}, 90 degree rotated \code{r90} and 270 degree rotated \code{r270}) family for a given parameter.

Modified: pkg/man/asCopula.Rd
===================================================================
--- pkg/man/asCopula.Rd	2013-04-04 17:50:25 UTC (rev 90)
+++ pkg/man/asCopula.Rd	2013-04-05 10:53:10 UTC (rev 91)
@@ -19,7 +19,7 @@
 Example 3.16 in: Nelsen, Roger B. (2006): An Introduction to Copulas, second edition, Springer
 }
 \author{
-Benedikt Gr{\'a}ler
+Benedikt Graeler
 }
 
 \seealso{ 

Modified: pkg/man/calcBins.Rd
===================================================================
--- pkg/man/calcBins.Rd	2013-04-04 17:50:25 UTC (rev 90)
+++ pkg/man/calcBins.Rd	2013-04-05 10:53:10 UTC (rev 91)
@@ -9,7 +9,7 @@
 A function calculating the spatial/spatio-temporal bins
 }
 \description{
-The (spatio-temporal) space is subdivided into pairs of observations that belkopng to certain spatial/spatio-temporal distanxce classes. For each distance class, the mean separating distance of all pairs involved is calcualted alongside a correaltion measure. The spatial/spatio-temporal correlogram is plotted by default.
+The (spatio-temporal) space is subdivided into pairs of observations that belong to certain spatial/spatio-temporal distance classes. For each distance class, the mean separating distance of all pairs involved is calculated alongside a correlation measure. The spatial/spatio-temporal correlogram is plotted by default.
 }
 \usage{
 calcBins(data, var, nbins = 15, boundaries = NA, cutoff = NA, cor.method="kendall", plot=T, ...)
@@ -20,7 +20,7 @@
 Either some spatial \code{data.frame} extending \code{\link[sp:Spatial-class]{Spatial}} or a spatio-temporal \code{data.frame} extending \code{\linkS4class{ST}}.
 }
   \item{var}{
-A vector containing the variable names of interset to select a subset of the variables present in the data slot.
+A vector containing the variable names of interest to select a subset of the variables present in the data slot.
 }
   \item{nbins}{
 the number of spatial bins.
@@ -29,24 +29,24 @@
 The left hand-side limits of the lag classes to be investigated, if set to \code{NA}, the \code{cutoff} will be split in equal parts according to \code{nbins}.
 }
   \item{cutoff}{
-The largest spatial distance to be investiagted, if set to \code{NA}, one third of the boundingbox's diagonal will be used.
+The largest spatial distance to be investigated, if set to \code{NA}, one third of the bounding box's diagonal will be used.
 }
   \item{cor.method}{
   defining the correlation method that should be used. Possible choices are \code{kendall} (default), \code{pearson}, \code{spearman} and \code{fasttau} that re-uses a very fast implementation of Kendall's tau from \code{\link{VineCopula-package}}.
   }
   \item{plot}{Whether the correlogram should be plotted.}
-  \item{\dots}{Additioanl arguments for the spatio-temporal case:
+  \item{\dots}{Additional arguments for the spatio-temporal case:
   \describe{
-    \item{instances}{To reduce the data size or circumvent unwanted autocorrelation effects, one might provide a number of randomly selected time instances from the spatio-temporal \code{data.frame}. If this parameter is set to \code{NA}, th complete time series will be used, if different from a signle number, \code{instances} will be passed on as to index time.}
+    \item{instances}{To reduce the data size or circumvent unwanted autocorrelation effects, one might provide a number of randomly selected time instances from the spatio-temporal \code{data.frame}. If this parameter is set to \code{NA}, the complete time series will be used, if different from a single number, \code{instances} will be passed on as to index time.}
     \item{t.lags}{a vector indicating the time lags to be investigated}
 }
 }
 }
-\value{A list containg the following entries
+\value{A list containing the following entries
 \item{meanDists}{A vector holding the mean separating distance for each lag.}
 \item{lagCor}{A vector holding the calculated correlation measure for each lag.}
 \item{lagData}{the data pairs for each lag}
-\item{lags}{In the spatial case, a vector holding the indicies of loactions used for each lag. In the spatio-temporal case, a list with a vector of spatail and temporal indicies used in the lag classes each.}
+\item{lags}{In the spatial case, a vector holding the indices of locations used for each lag. In the spatio-temporal case, a list with a vector of spatial and temporal indices used in the lag classes each.}
 
 }
 \author{

Modified: pkg/man/composeSpCopula.Rd
===================================================================
--- pkg/man/composeSpCopula.Rd	2013-04-04 17:50:25 UTC (rev 90)
+++ pkg/man/composeSpCopula.Rd	2013-04-05 10:53:10 UTC (rev 91)
@@ -4,14 +4,14 @@
 Composing a bivariate Spatial Copula
 }
 \description{
-A bivaraite spatial copula is composed out of a set of bivariate copulas. These are combined uisng a convex linear combination with weights based on distances where for copulas with a 1-1 correspondence of Kendall's tau or Spearman's rho a dependence function providing measures of association based on distances might be used.
+A bivariate spatial copula is composed out of a set of bivariate copulas. These are combined using a convex linear combination with weights based on distances where for copulas with a 1-1 correspondence of Kendall's tau or Spearman's rho a dependence function providing measures of association based on distances might be used.
 }
 \usage{
 composeSpCopula(bestFit, families, bins, calcCor, range=max(bins$meanDists))
 }
 \arguments{
   \item{bestFit}{
-A vector indicating the best fitting copula family index (as in \code{families}) per lag-class. If this vector is shorter than the sactula number of bins, only these first bins will be used. It is an alternative way of setting a range.
+A vector indicating the best fitting copula family index (as in \code{families}) per lag-class. If this vector is shorter than the actual number of bins, only these first bins will be used. It is an alternative way of setting a range.
 }
   \item{families}{
 The list of investigated families.

Added: pkg/man/condSpVine.Rd
===================================================================
--- pkg/man/condSpVine.Rd	                        (rev 0)
+++ pkg/man/condSpVine.Rd	2013-04-05 10:53:10 UTC (rev 91)
@@ -0,0 +1,60 @@
+\name{condSpVine}
+\alias{condSpVine}
+
+\title{
+Conditions a spatial vine copula for conditional prediction
+}
+\description{
+A spatial vine copula is conditioned under the observations of all but one neighbour generating a conditional uivariate distribution used ofr prediction.
+}
+\usage{
+condSpVine(condVar, dists, spVine, n = 100)
+}
+\arguments{
+  \item{condVar}{
+the conditional variables
+}
+  \item{dists}{
+the distances between the neighbours to adjust the spatial vine copula parameters.
+}
+  \item{spVine}{
+the spatial vine copula
+}
+  \item{n}{
+a proxy to the number of intervals to be used in the numerical integration. The intervals will not be split uniform with a shorter intervals at the corners of the copula.
+}
+}
+\value{
+A function describing the conditional density.
+}
+\author{
+Benedikt Graeler
+}
+
+\seealso{
+\code{\linkS4class{spVineCopula}}
+}
+\examples{
+data(spCopDemo)
+
+calcKTauPol <- fitCorFun(bins, degree=3)
+
+spCop <- spCopula(components=list(normalCopula(0), tCopula(0, dispstr = "un"),
+                                  frankCopula(1), normalCopula(0), claytonCopula(0),
+                                  claytonCopula(0), claytonCopula(0), claytonCopula(0),
+                                  claytonCopula(0), indepCopula()),
+                  distances=bins$meanDists,
+                  spDepFun=calcKTauPol, unit="m")
+
+spVineCop <- spVineCopula(spCop, vineCopula(4L))
+
+dists <- runif(4,0,800)
+condVar <- runif(4)
+condDensity <- condSpVine(condVar,dists,spVineCop)
+
+curve(condDensity)
+mtext(paste("Dists:",paste(round(dists,0),collapse=", ")),line=0)
+mtext(paste("Cond.:",paste(round(condVar,2),collapse=", ")),line=1)
+}
+
+\keyword{ distribution }

Modified: pkg/man/copulaFromFamilyIndex.Rd
===================================================================
--- pkg/man/copulaFromFamilyIndex.Rd	2013-04-04 17:50:25 UTC (rev 90)
+++ pkg/man/copulaFromFamilyIndex.Rd	2013-04-05 10:53:10 UTC (rev 91)
@@ -1,7 +1,7 @@
 \name{copulaFromFamilyIndex}
 \alias{copulaFromFamilyIndex}
 \title{
-Construct a copual object from a VineCopula family index
+Construct a copula object from a \code{\link{VineCopula-package}} family index
 }
 \description{
 A \code{\linkS4class{copula}} object is constructed from the family index used in the package \code{\link{VineCopula-package}} for the provided parameters.

Modified: pkg/man/criticalLevel.Rd
===================================================================
--- pkg/man/criticalLevel.Rd	2013-04-04 17:50:25 UTC (rev 90)
+++ pkg/man/criticalLevel.Rd	2013-04-05 10:53:10 UTC (rev 91)
@@ -5,20 +5,20 @@
 }
 \description{
 The critical level corresponding to a given Kendall Return Period and a given 
-kendall distribution or its underlying copula.
+Kendall distribution or its underlying copula.
 }
 \usage{
 criticalLevel(kendallFun = NULL, KRP = c(100, 1000), mu = 1, copula = NULL)
 }
 \arguments{
   \item{kendallFun}{
-The kendall distribution function.
+The Kendall distribution function.
 }
   \item{KRP}{
-The desired Kendall Return Period(s); the feault are 100 and 1000.
+The desired Kendall Return Period(s); the default are 100 and 1000.
 }
   \item{mu}{
-The reoccurence of an event per time unit; the default is 1.
+The recurrence of an event per time unit; the default is 1.
 }
   \item{copula}{
 The copula describing the dependencies between the investigated variables. Only necessary if \code{kendallFun} is not provided.

Modified: pkg/man/criticalPair.Rd
===================================================================
--- pkg/man/criticalPair.Rd	2013-04-04 17:50:25 UTC (rev 90)
+++ pkg/man/criticalPair.Rd	2013-04-05 10:53:10 UTC (rev 91)
@@ -1,7 +1,7 @@
 \name{criticalPair}
 \alias{criticalPair}
 \title{
-Calculate Crtitical Pairs
+Calculate Critical Pairs
 }
 \description{
 For a given argument, the second argument is calculated for a given critical level (cumulated probability level) and copula.
@@ -11,7 +11,7 @@
 }
 \arguments{
   \item{copula}{
-The three-dimesnional copula.
+The three-dimensional copula.
 }
   \item{cl}{
 The critical level (cumulative probability level).
@@ -27,7 +27,7 @@
 }
 }
 \value{
-The second argument for which the geiven critical level (cumulative probability level) is achieved.
+The second argument for which the given critical level (cumulative probability level) is achieved.
 }
 \author{
 Benedikt Graeler

Modified: pkg/man/criticalTriple.Rd
===================================================================
--- pkg/man/criticalTriple.Rd	2013-04-04 17:50:25 UTC (rev 90)
+++ pkg/man/criticalTriple.Rd	2013-04-05 10:53:10 UTC (rev 91)
@@ -11,7 +11,7 @@
 }
 \arguments{
   \item{copula}{
-The three-dimesnional copula.
+The three-dimensional copula.
 }
   \item{cl}{
 The critical level (cumulative probability level).
@@ -27,7 +27,7 @@
 }
 }
 \value{
-The third argument for which the geiven critical level (cumulative probability level) is achieved.
+The third argument for which the given critical level (cumulative probability level) is achieved.
 }
 \author{
 Benedikt Graeler

Modified: pkg/man/dduCopula.Rd
===================================================================
--- pkg/man/dduCopula.Rd	2013-04-04 17:50:25 UTC (rev 90)
+++ pkg/man/dduCopula.Rd	2013-04-05 10:53:10 UTC (rev 91)
@@ -6,7 +6,7 @@
 partial derivatives of copulas
 }
 \description{
-Similair to the \code{\link{dCopula}} and \code{\link{pCopula}} the function \code{dduCopula} evaluates the partial derivative \eqn{\frac{\partial}{\partial u} C(u,v)} and the function \code{ddvCopula} evaluates the partial derivative \eqn{\frac{\partial}{\partial v} C(u,v)} of the provided copula. 
+Similar to the \code{\link{dCopula}} and \code{\link{pCopula}} the function \code{dduCopula} evaluates the partial derivative \eqn{\frac{\partial}{\partial u} C(u,v)} and the function \code{ddvCopula} evaluates the partial derivative \eqn{\frac{\partial}{\partial v} C(u,v)} of the provided copula. 
 }
 \usage{
 dduCopula(u, copula, ...)
@@ -20,10 +20,10 @@
   \item{copula}{
 The copula object representing the family member of interest.
 }
-  \item{\dots}{additioanl arguments can be passed on to the underlying functions.}
+  \item{\dots}{additional arguments can be passed on to the underlying functions.}
 }
 \value{
-A vector of the evaluated partial derivaitves of the same length as rows in \code{u}.
+A vector of the evaluated partial derivatives of the same length as rows in \code{u}.
 }
 \author{
 Benedikt Graeler

Modified: pkg/man/dependencePlot.Rd
===================================================================
--- pkg/man/dependencePlot.Rd	2013-04-04 17:50:25 UTC (rev 90)
+++ pkg/man/dependencePlot.Rd	2013-04-05 10:53:10 UTC (rev 91)
@@ -1,10 +1,10 @@
 \name{dependencePlot}
 \alias{dependencePlot}
 \title{
-Kernel smoothed scatterplot
+Kernel smoothed scatter plot
 }
 \description{
-Plots a kernel smoothed scatterplot of the provided rank-transformed sample. The work is done by the function \code{\link{panel.smoothScatter}}.
+Plots a kernel smoothed scatter plot of the provided rank-transformed sample. The work is done by the function \code{\link{panel.smoothScatter}}.
 }
 \usage{
 dependencePlot(var = NULL, smpl, bandwidth = 0.075,  main="Stength of dependece", transformation = function(x) x, ...)
@@ -21,7 +21,7 @@
 the bandwidth passed to the smoothing kernel
 }
 \item{main}{
-the tilte of the plot
+the title of the plot
 }
   \item{transformation}{
 a transformation passed to the kernel

Modified: pkg/man/empiricalCopula-class.Rd
===================================================================
--- pkg/man/empiricalCopula-class.Rd	2013-04-04 17:50:25 UTC (rev 90)
+++ pkg/man/empiricalCopula-class.Rd	2013-04-05 10:53:10 UTC (rev 91)
@@ -28,7 +28,7 @@
 Class \code{"\linkS4class{Copula}"}, by class "copula", distance 2.
 }
 \section{Methods}{
-No additional methods defined with class "empiricalCopula" in the signature, but \code{\link{pCopula}} works as expected.
+No additional methods defined with class \code{empiricalCopula} in the signature, but \code{\link{pCopula}} works as expected.
 }
 \author{
 Benedikt Graeler}

Modified: pkg/man/empiricalCopula.Rd
===================================================================
--- pkg/man/empiricalCopula.Rd	2013-04-04 17:50:25 UTC (rev 90)
+++ pkg/man/empiricalCopula.Rd	2013-04-05 10:53:10 UTC (rev 91)
@@ -1,7 +1,7 @@
 \name{empiricalCopula}
 \alias{empiricalCopula}
 \title{
-Constructor of an empircal copula class
+Constructor of an empirical copula class
 }
 \description{
 Constructs an object of the empirical copula class \code{\linkS4class{empiricalCopula}}, see \code{\link{genEmpCop}} for a simplified version.
@@ -14,7 +14,7 @@
 A sample from a provided or unknown copula family.
 }
   \item{copula}{
-The underlying theoretical copula, in case it is known or a sample should be gnerated.
+The underlying theoretical copula, in case it is known or a sample should be generated.
 }
 }
 \value{
@@ -28,7 +28,7 @@
 }
 
 \seealso{
-\code{\link{genEmpCop}} for a simplified constructor with sample length controle.
+\code{\link{genEmpCop}} for a simplified constructor with sample length control.
 }
 \examples{
 empCop <- empiricalCopula(rCopula(500,frankCopula(0.7)))

Modified: pkg/man/fitCorFun.Rd
===================================================================
--- pkg/man/fitCorFun.Rd	2013-04-04 17:50:25 UTC (rev 90)
+++ pkg/man/fitCorFun.Rd	2013-04-05 10:53:10 UTC (rev 91)
@@ -5,7 +5,7 @@
 Automated fitting of a correlation function to the correlogram
 }
 \description{
-Polynomials of different degrees can be fitteds to the correlogram calculated using \code{\link{calcBins}}. This function will be used to adjust the copula parameter in the spatial/spatio-temporal copula.
+Polynomials of different degrees can be fitted to the correlogram calculated using \code{\link{calcBins}}. This function will be used to adjust the copula parameter in the spatial/spatio-temporal copula.
 }
 \usage{
 fitCorFun(bins, degree = 3, cutoff = NA, bounds = c(0, 1), cor.method = NULL)
@@ -15,10 +15,10 @@
 Typically the output of \code{\link{calcBins}}. Any \code{data.frame} with a columns \code{lagCor} and \code{meanDists} in the first two columns will do.
 }
   \item{degree}{
-The degree of polynominal to be fitted.
+The degree of polynomial to be fitted.
 }
   \item{cutoff}{
-Maximal distance to which lags should be included in the polynominal fit.
+Maximal distance to which lags should be included in the polynomial fit.
 }
   \item{bounds}{
 Bounds of the correlation values. The default is set [0,1] not allowing any negative relationship but perfect positive dependence.
@@ -28,7 +28,7 @@
 }
 }
 \value{
-Returns a function that provides correlation estimate for every seperating distance.
+Returns a function that provides correlation estimate for every separating distance.
 }
 \author{
 Benedikt Graeler

Modified: pkg/man/fitSpCopula.Rd
===================================================================
--- pkg/man/fitSpCopula.Rd	2013-04-04 17:50:25 UTC (rev 90)
+++ pkg/man/fitSpCopula.Rd	2013-04-05 10:53:10 UTC (rev 91)
@@ -5,17 +5,17 @@
 Spatial Copula Fitting
 }
 \description{
-A bivaraite spatial copula is composed out of a set of bivariate copulas. These are combined uisng a convex linear combination with weights based on distances where for copulas with a 1-1 correspondence of Kendall's tau or Spearman's rho a dependence function providing measures of association based on distances might be used. This function estimates a spatial dependence function, evaluates the loglikelihood per family and lag class, selects the bist fits and composes a spatial bivariate copula.
+A bivariate spatial copula is composed out of a set of bivariate copulas. These are combined using a convex linear combination with weights based on distances where for copulas with a 1-1 correspondence of Kendall's tau or Spearman's rho a dependence function providing measures of association based on distances might be used. This function estimates a spatial dependence function, evaluates the log-likelihood per family and lag class, selects the best fits and composes a spatial bivariate copula.
 }
 \usage{
 fitSpCopula(bins, cutoff = NA, families = c(normalCopula(0), tCopula(0, dispstr = "un"), claytonCopula(0), frankCopula(1), gumbelCopula(1)), ...)
 }
 \arguments{
   \item{bins}{
-the bins to be used, typically outpout from \"calcBins\".
+the bins to be used, typically output from \code{\link{calcBins}}.
 }
   \item{cutoff}{
-The maximal distance to be used in the fitment.
+The maximal distance to be used in the fit.
 }
   \item{families}{
 The set of families to be investigated.

Modified: pkg/man/genEmpCop.Rd
===================================================================
--- pkg/man/genEmpCop.Rd	2013-04-04 17:50:25 UTC (rev 90)
+++ pkg/man/genEmpCop.Rd	2013-04-05 10:53:10 UTC (rev 91)
@@ -11,7 +11,7 @@
 }
 \arguments{
   \item{copula}{
-The theoretical copula to be represnted numerically.
+The theoretical copula to be represented numerically.
 }
 \item{sample.size}{
 The length of the sample to be used. The default is 1e5.

Modified: pkg/man/genEmpKenFun.Rd
===================================================================
--- pkg/man/genEmpKenFun.Rd	2013-04-04 17:50:25 UTC (rev 90)
+++ pkg/man/genEmpKenFun.Rd	2013-04-05 10:53:10 UTC (rev 91)
@@ -1,10 +1,10 @@
 \name{genEmpKenFun}
 \alias{genEmpKenFun}
 \title{
-Generates an emprical Kendall distribution function
+Generates an empirical Kendall distribution function
 }
 \description{
-Generates an emprical Kendall distribution function in cases where no closed form exists. When a sample is provided (\code{smpl}) this exact sample is used to derive the empirical Kendall distribution function. Otherweise, a sample will be generated from the porovided copula.
+Generates an empirical Kendall distribution function in cases where no closed form exists. When a sample is provided (\code{smpl}) this exact sample is used to derive the empirical Kendall distribution function. Otherwise, a sample will be generated from the provided copula.
 }
 \usage{
 genEmpKenFun(copula, sample = NULL)
@@ -14,11 +14,11 @@
 The underlying copula from which 1e6 samples are drawn by default.
 }
   \item{sample}{
-Optional, a specific sample that should be used to generate the emopircal Kendall distribution function.
+Optional, a specific sample that should be used to generate the empirical Kendall distribution function.
 }
 }
 \value{
-A function returning the corresponding empirical  Kendalll distribution value.
+A function returning the corresponding empirical Kendall distribution value.
 }
 \author{
 Benedikt Graeler

Modified: pkg/man/getKendallDistr.Rd
===================================================================
--- pkg/man/getKendallDistr.Rd	2013-04-04 17:50:25 UTC (rev 90)
+++ pkg/man/getKendallDistr.Rd	2013-04-05 10:53:10 UTC (rev 91)
@@ -5,10 +5,10 @@
 \alias{getKendallDistr,gumbelCopula-method}
 
 \title{
-retrieveing the Kendall Distribuiton function for a given copula
+retrieving the Kendall Distribution function for a given copula
 }
 \description{
-Depending on the copula passed, an analytical or empircal Kendall distribution function (\code{\link{kendallDistribution}}) is returned.
+Depending on the copula passed, an analytical or empirical Kendall distribution function (\code{\link{kendallDistribution}}) is returned.
 }
 \usage{
 getKendallDistr(copula, sample = NULL)
@@ -18,7 +18,7 @@
   A copula object.
 }
   \item{sample}{
[TRUNCATED]

To get the complete diff run:
    svnlook diff /svnroot/spcopula -r 91

From noreply at r-forge.r-project.org  Thu Apr 11 17:38:43 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Thu, 11 Apr 2013 17:38:43 +0200 (CEST)
Subject: [spcopula-commits] r92 - / pkg pkg/R pkg/demo pkg/man
Message-ID: <20130411153843.6E685185284@r-forge.r-project.org>

Author: ben_graeler
Date: 2013-04-11 17:38:43 +0200 (Thu, 11 Apr 2013)
New Revision: 92

Modified:
   pkg/DESCRIPTION
   pkg/R/spCopula.R
   pkg/R/vineCopulas.R
   pkg/demo/00Index
   pkg/man/condSpVine.Rd
   pkg/man/spCopDemo.Rd
   spcopula_0.1-1.tar.gz
   spcopula_0.1-1.zip
Log:
- double checking values from dduCopula and ddvCopula for an spCopula

Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION	2013-04-05 10:53:10 UTC (rev 91)
+++ pkg/DESCRIPTION	2013-04-11 15:38:43 UTC (rev 92)
@@ -2,7 +2,7 @@
 Type: Package
 Title: copula driven spatial analysis
 Version: 0.1-1
-Date: 2013-04-05
+Date: 2013-04-11
 Author: Benedikt Graeler
 Maintainer: Benedikt Graeler <ben.graeler at uni-muenster.de>
 Description: This package provides a framework to analyse via copulas spatial and spatio-temporal data provided in the format of the spacetime package. Additionally, support for calculating different multivariate return periods is implemented.

Modified: pkg/R/spCopula.R
===================================================================
--- pkg/R/spCopula.R	2013-04-05 10:53:10 UTC (rev 91)
+++ pkg/R/spCopula.R	2013-04-11 15:38:43 UTC (rev 92)
@@ -381,6 +381,13 @@
     }
   }
   
+  if(any(res < 0) || any(res > 1)) {
+    warning("Partial derivative produced values outside of [0,1], corrections will be applied to:\n",
+            paste(res[res<0],collapse=" "),paste(res[res>1],collapse=" "))
+    res[res<0] <- 0
+    res[res>1] <- 1
+  }
+  
   return(res)
 }
 
@@ -430,6 +437,13 @@
     }
   }
   
+  if(any(res < 0) || any(res > 1)) {
+    warning("Partial derivative produced values outside of [0,1], corrections will be applied to:\n",
+            paste(res[res<0],collapse=" "),paste(res[res>1],collapse=" "))
+    res[res<0] <- 0
+    res[res>1] <- 1
+  }
+  
   return(res)
 }
 

Modified: pkg/R/vineCopulas.R
===================================================================
--- pkg/R/vineCopulas.R	2013-04-05 10:53:10 UTC (rev 91)
+++ pkg/R/vineCopulas.R	2013-04-11 15:38:43 UTC (rev 92)
@@ -45,7 +45,6 @@
 
 dRVine <- function(u, copula, log=F) {
   RVM <- copula at RVM
-#   class(RVM) <- "RVineMatrix"
   vineLoglik <- RVineLogLik(u, RVM, separate=T)$loglik
   if(log)
     return(vineLoglik)

Modified: pkg/demo/00Index
===================================================================
--- pkg/demo/00Index	2013-04-05 10:53:10 UTC (rev 91)
+++ pkg/demo/00Index	2013-04-11 15:38:43 UTC (rev 92)
@@ -1,2 +1,2 @@
-MRP		The MRP demo gives insight in the code used in the paper: Joint return periods in hydrology: a critical and practical review focusing on synthetic design hydrograph estimation, by Vandenberghe et al. (2012).
-spCopula_estimation		A demo illustrating the estiamtion of a spatial copula for a SpatialPointsDataFrame.
+MRP		The MRP demo gives insight in the code used in the paper: Multivariate return periods in hydrology: a critical and practical review focusing on synthetic design hydrograph estimation, by Gr?ler et al. (2013), HESS-17-1281-2013.
+spCopula		A demo illustrating the estiamtion of a spatial copula for a SpatialPointsDataFrame.

Modified: pkg/man/condSpVine.Rd
===================================================================
--- pkg/man/condSpVine.Rd	2013-04-05 10:53:10 UTC (rev 91)
+++ pkg/man/condSpVine.Rd	2013-04-11 15:38:43 UTC (rev 92)
@@ -48,8 +48,8 @@
 
 spVineCop <- spVineCopula(spCop, vineCopula(4L))
 
-dists <- runif(4,0,800)
-condVar <- runif(4)
+dists <- c(473, 124, 116, 649)
+condVar <- c(0.29, 0.55, 0.05, 0.41)
 condDensity <- condSpVine(condVar,dists,spVineCop)
 
 curve(condDensity)

Modified: pkg/man/spCopDemo.Rd
===================================================================
--- pkg/man/spCopDemo.Rd	2013-04-05 10:53:10 UTC (rev 91)
+++ pkg/man/spCopDemo.Rd	2013-04-11 15:38:43 UTC (rev 92)
@@ -15,10 +15,10 @@
 \alias{spCop}
 \docType{data}
 \title{
-workspace produced in \code{demo(spcopula_estimation)}
+workspace produced in \code{demo(spCopula)}
 }
 \description{
-This workspace is produced by the call \code{demo(spcopula_estimation)} and used in a couple of examples throughout the package.
+This workspace is produced by the call \code{demo(spCopula)} and used in a couple of examples throughout the package.
 }
 \usage{data(spCopDemo)}
 \references{

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

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


From noreply at r-forge.r-project.org  Mon Apr 15 13:39:19 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Mon, 15 Apr 2013 13:39:19 +0200 (CEST)
Subject: [spcopula-commits] r93 - / pkg/demo
Message-ID: <20130415113919.3A477185165@r-forge.r-project.org>

Author: ben_graeler
Date: 2013-04-15 13:39:18 +0200 (Mon, 15 Apr 2013)
New Revision: 93

Added:
   pkg/demo/spCopula.R
Removed:
   README
   pkg/demo/spCopula_estimation.R
Modified:
   pkg/demo/
   spcopula_0.1-1.tar.gz
   spcopula_0.1-1.zip
Log:
- updated demos

Deleted: README
===================================================================
--- README	2013-04-11 15:38:43 UTC (rev 92)
+++ README	2013-04-15 11:39:18 UTC (rev 93)
@@ -1,76 +0,0 @@
-			R-Forge SVN README
-
-This file explains the repository structure of your project. A more
-detailed guide to R-Forge is available by 
-Theu?l and Zeileis (2010) [1] and the R-Forge Administration and 
-Development Team (2009) [2].
-
-1. Introduction
------------------------------------------------------------------------
-R is free software distributed under a GNU-style copyleft. R-Forge is
-a central platform for the development of R packages, R-related 
-software and further projects. Among many other web-based features it 
-provides facilities for collaborative source code management via 
-Subversion (SVN) [3].
-
-2. The directory you're in
------------------------------------------------------------------------
-This is the repository of your project. It contains two important
-pre-defined directories namely 'pkg' and 'www'. These directories must 
-not be deleted otherwise R-Forge's core functionality will not be 
-available (i.e., daily checking and building of your package or the 
-project websites).
-'pkg' and 'www' are standardized and therefore are going to be
-described in this README. The rest of your repository can be used as
-you like.
-
-3. 'pkg' directory
------------------------------------------------------------------------
-To make use of the package building and checking feature the package 
-source code has to be put into the 'pkg' directory of your repository 
-(i.e., 'pkg/DESCRIPTION', 'pkg/R', 'pkg/man', etc.) or, alternatively,
-a subdirectory of 'pkg'. The latter structure allows for having more 
-than one package in a single project, e.g., if a project consists of 
-the packages foo and bar then the source code will be located in 
-'pkg/foo' and 'pkg/bar', respectively.
-
-R-Forge automatically examines the 'pkg' directory of every repository 
-and builds the package sources as well as the package binaries on a
-daily basis for Mac OS X and Windows (if applicable). The package builds
-are provided in the 'R Packages' tab for download or can be installed
-directly in R from a CRAN-style repository using 
-'install.packages("foo", repos="http://R-Forge.R-project.org")'. 
-Furthermore, in the 'R Packages' tab developers can examine logs 
-generated on different platforms by the build and check process.
-
-4. 'www' directory
------------------------------------------------------------------------
-Developers may present their project on a subdomain of R-Forge, e.g.,
-'http://foo.R-Forge.R-project.org', or via a link to an external
-website.
-
-This directory contains the project homepage which gets updated hourly
-on R-Forge, so please take into consideration that it will not be 
-available right after you commit your changes or additions. 
-
-5. Help
------------------------------------------------------------------------
-If you need help don't hesitate to submit a support request at 
-https://r-forge.r-project.org/tracker/?func=add&group_id=34&atid=194, 
-search the forum 
-https://r-forge.r-project.org/forum/forum.php?forum_id=78&group_id=34,
-or contact us at R-Forge at R-project.org.
-
-6. References
------------------------------------------------------------------------
-
-[1] Stefan Theu?l and Achim Zeileis. Collaborative software development 
-using R-Forge. The R Journal, 1(1):9-14, May 2009. URL 
-http://journal.r-project.org/2009-1/RJournal_2009-1_Theussl+Zeileis.pdf  
-
-[2] R-Forge Administration and Development Team. RForge User?s Manual, 
-2008. URL http://download.R-Forge.R-project.org/R-Forge.pdf
-
-[3] C. M. Pilato, B. Collins-Sussman, and B. W. Fitzpatrick. Version 
-Control with Subversion. O?Reilly, 2004. Full book available online at 
-http://svnbook.red-bean.com/


Property changes on: pkg/demo
___________________________________________________________________
Added: svn:ignore
   + spCopula_estimation.R


Added: pkg/demo/spCopula.R
===================================================================
--- pkg/demo/spCopula.R	                        (rev 0)
+++ pkg/demo/spCopula.R	2013-04-15 11:39:18 UTC (rev 93)
@@ -0,0 +1,147 @@
+## librarys ##
+library(spcopula)
+library(evd)
+
+## meuse - spatial poionts data.frame ##
+data(meuse)
+coordinates(meuse) = ~x+y
+
+spplot(meuse,"zinc", col.regions=bpy.colors(5))
+
+## margins ##
+hist(meuse[["zinc"]],freq=F,n=30,ylim=c(0,0.0035), 
+     main="Histogram of zinc", xlab="zinc concentration")
+
+gevEsti <- fgev(meuse[["zinc"]])$estimate
+meanLog <- mean(log(meuse[["zinc"]]))
+sdLog <- sd(log(meuse[["zinc"]]))
+curve(dgev(x,gevEsti[1], gevEsti[2], gevEsti[3]),add=T,col="red")
+curve(dlnorm(x,meanLog,sdLog),add=T,col="green")
+
+pMar <- function(q) plnorm(q, meanLog, sdLog)
+qMar <- function(p) qlnorm(p, meanLog, sdLog)
+dMar <- function(x) dlnorm(x, meanLog, sdLog)
+
+# pMar <- function(q) pgev(q, gevEsti[1], gevEsti[2], gevEsti[3])
+# qMar <- function(p) qgev(p, gevEsti[1], gevEsti[2], gevEsti[3])
+# dMar <- function(x) dgev(x, gevEsti[1], gevEsti[2], gevEsti[3])
+
+## lag classes ##
+bins <- calcBins(meuse,var="zinc",nbins=10,cutoff=800)
+
+# transform data to the unit interval
+bins$lagData <- lapply(bins$lagData, rankTransform)
+
+## calculate parameters for Kendall's tau function ##
+# either linear
+calcKTauLin <- fitCorFun(bins, degree=1, cutoff=600)
+curve(calcKTauLin,0, 1000, col="red",add=TRUE)
+
+# or polynomial (used here)
+calcKTauPol <- fitCorFun(bins, degree=3)
+curve(calcKTauPol,0, 1000, col="purple",add=TRUE)
+
+## find best fitting copula per lag class
+loglikTau <- loglikByCopulasLags(bins, calcKTauPol,
+                                 families=c(normalCopula(0), tCopula(0),
+                                            claytonCopula(0), frankCopula(1), 
+                                            gumbelCopula(1), joeBiCopula(1.5),
+                                            indepCopula()))
+bestFitTau <- apply(apply(loglikTau, 1, rank, na.last=T), 2, 
+                    function(x) which(x==7))
+bestFitTau
+
+## set-up a spatial Copula ##
+spCop <- spCopula(components=list(normalCopula(0), tCopula(0),
+                                  frankCopula(1), normalCopula(0), 
+                                  claytonCopula(0), claytonCopula(0), 
+                                  claytonCopula(0), claytonCopula(0),
+                                  claytonCopula(0), indepCopula()),
+                  distances=bins$meanDists,
+                  spDepFun=calcKTauPol, unit="m")
+
+## compare spatial copula loglik by lag:
+spLoglik <- NULL
+for(i in 1:length(bins$lags)) { # i <- 8
+  spLoglik <- c(spLoglik,
+                sum(dCopula(u=bins$lagData[[i]], spCop,log=T,
+                            h=bins$lags[[i]][,3])))
+}
+
+plot(spLoglik, ylab="log-likelihood", xlim=c(1,11)) 
+points(loglikTau[cbind(1:10,bestFitTau)], col="green", pch=16)
+points(loglikTau[,1], col="red", pch=5)
+legend(6, 50,c("Spatial Copula", "best copula per lag", "Gaussian Copula",
+               "number of pairs"), 
+       pch=c(1,16,5,50), col=c("black", "green", "red"))
+text(x=(1:10+0.5),y=spLoglik,lapply(bins$lagData,length))
+
+##
+# spatial vine
+vineDim <- 5L
+meuseNeigh <- getNeighbours(meuse,var="zinc",size=vineDim)
+meuseNeigh at data <- rankTransform(meuseNeigh at data)
+
+meuseSpVine <- fitCopula(spVineCopula(spCop, vineCopula(as.integer(vineDim-1))),
+                         meuseNeigh)
+
+meuseSpVine <- meuseSpVine at copula
+
+##
+# leave-one-out x-validation
+
+condVine <- function(condVar, dists, n=100) {
+  rat <- 0.2/(1:(n/2))-(0.1/((n+1)/2))
+  xVals <- unique(sort(c(rat,1-rat,1:(n-1)/(n))))
+  xLength <- length(xVals)
+  repCondVar <- matrix(condVar, ncol=length(condVar), nrow=xLength, byrow=T)
+  density <- dCopula(cbind(xVals, repCondVar), meuseSpVine, h=dists)
+  
+  linAppr <- approxfun(c(0,xVals,1), density[c(1,1:xLength,xLength)] ,yleft=0, yright=0)
+  int <- integrate(linAppr,lower=0, upper=1)$value
+  
+  return(function(u) linAppr(u)/int)
+}
+
+time <- proc.time()  # ~30 s
+predMedian <- NULL
+predMean <- NULL
+for(loc in 1:nrow(meuseNeigh at data)) { # loc <- 429  predNeigh$data[loc,1]
+  cat("Location:",loc,"\n")
+  condSecVine <- condVine(condVar=as.numeric(meuseNeigh at data[loc,-1]), 
+                          dists=meuseNeigh at distances[loc,,drop=F])
+  
+  predMedian <- c(predMedian, qMar(optimise(function(x) abs(integrate(condSecVine,0,x)$value-0.5),c(0,1))$minimum))
+  
+  condExp <-  function(x) {
+    condSecVine(pMar(x))*dMar(x)*x
+  }
+  
+  predMean <- c(predMean, integrate(condExp,0,3000,subdivisions=1e6)$value)
+}
+proc.time()-time
+
+mean(abs(predMean-meuse$zinc))
+mean(predMean-meuse$zinc)
+sqrt(mean((predMean-meuse$zinc)^2))
+
+mean(abs(predMedian-meuse$zinc))
+mean(predMedian-meuse$zinc)
+sqrt(mean((predMedian-meuse$zinc)^2))
+
+plot(predMean,meuse$zinc)
+abline(0,1)
+
+plot(predMedian,meuse$zinc)
+abline(0,1)
+
+## kriging results:
+# same neighbourhood size 5L:
+# MAE:  158.61
+# BIAS:  -4.24
+# RMSE: 239.85
+#
+# global kriging:
+# MAE:  148.85
+# BIAS:  -3.05
+# RMSE: 226.15
\ No newline at end of file

Deleted: pkg/demo/spCopula_estimation.R
===================================================================
--- pkg/demo/spCopula_estimation.R	2013-04-11 15:38:43 UTC (rev 92)
+++ pkg/demo/spCopula_estimation.R	2013-04-15 11:39:18 UTC (rev 93)
@@ -1,149 +0,0 @@
-## librarys ##
-library(spcopula)
-library(evd)
-
-## meuse - spatial poionts data.frame ##
-data(meuse)
-coordinates(meuse) = ~x+y
-
-spplot(meuse,"zinc", col.regions=bpy.colors(5))
-
-## margins ##
-hist(meuse[["zinc"]],freq=F,n=30,ylim=c(0,0.0035), 
-     main="Histogram of zinc", xlab="zinc concentration")
-gevEsti <- fgev(meuse[["zinc"]])$estimate
-meanLog <- mean(log(meuse[["zinc"]]))
-sdLog <- sd(log(meuse[["zinc"]]))
-curve(dgev(x,gevEsti[1], gevEsti[2], gevEsti[3]),add=T,col="red")
-curve(dlnorm(x,meanLog,sdLog),add=T,col="green")
-
-ks.test(meuse[["zinc"]],pgev,gevEsti[1], gevEsti[2], gevEsti[3]) # p: 0.07
-ks.test(meuse[["zinc"]],plnorm,meanLog,sdLog) # p: 0.03
-
-pMar <- function(q) plnorm(q, meanLog, sdLog)
-qMar <- function(p) qlnorm(p, meanLog, sdLog)
-dMar <- function(x) dlnorm(x, meanLog, sdLog)
-
-# pMar <- function(q) pgev(q, gevEsti[1], gevEsti[2], gevEsti[3])
-# qMar <- function(p) qgev(p, gevEsti[1], gevEsti[2], gevEsti[3])
-# dMar <- function(x) dgev(x, gevEsti[1], gevEsti[2], gevEsti[3])
-
-## lag classes ##
-bins <- calcBins(meuse,var="zinc",nbins=10,cutoff=800)
-
-# transform data to the unit interval
-bins$lagData <- lapply(bins$lagData, rankTransform)
-
-## calculate parameters for Kendall's tau function ##
-# either linear
-calcKTauLin <- fitCorFun(bins, degree=1, cutoff=600)
-curve(calcKTauLin,0, 1000, col="red",add=TRUE)
-
-# or polynomial (used here)
-calcKTauPol <- fitCorFun(bins, degree=3)
-curve(calcKTauPol,0, 1000, col="purple",add=TRUE)
-
-## find best fitting copula per lag class
-loglikTau <- loglikByCopulasLags(bins, calcKTauPol,
-                                 families=c(normalCopula(0), tCopula(0),
-                                            claytonCopula(0), frankCopula(1), 
-                                            gumbelCopula(1), joeBiCopula(1.5),
-                                            indepCopula()))
-bestFitTau <- apply(apply(loglikTau, 1, rank, na.last=T), 2, 
-                    function(x) which(x==7))
-bestFitTau
-
-## set-up a spatial Copula ##
-spCop <- spCopula(components=list(normalCopula(0), tCopula(0),
-                                  frankCopula(1), normalCopula(0), 
-                                  claytonCopula(0), claytonCopula(0), 
-                                  claytonCopula(0), claytonCopula(0),
-                                  claytonCopula(0), indepCopula()),
-                  distances=bins$meanDists,
-                  spDepFun=calcKTauPol, unit="m")
-
-## compare spatial copula loglik by lag:
-spLoglik <- NULL
-for(i in 1:length(bins$lags)) { # i <- 8
-  spLoglik <- c(spLoglik,
-                sum(dCopula(u=bins$lagData[[i]], spCop,log=T,
-                            h=bins$lags[[i]][,3])))
-}
-
-plot(spLoglik, ylab="log-likelihood", xlim=c(1,11)) 
-points(loglikTau[cbind(1:10,bestFitTau)], col="green", pch=16)
-points(loglikTau[,1], col="red", pch=5)
-legend(6, 50,c("Spatial Copula", "best copula per lag", "Gaussian Copula",
-               "number of pairs"), 
-       pch=c(1,16,5,50), col=c("black", "green", "red"))
-text(x=(1:10+0.5),y=spLoglik,lapply(bins$lagData,length))
-
-##
-# spatial vine
-vineDim <- 5L
-meuseNeigh <- getNeighbours(meuse,"zinc",vineDim)
-meuseNeigh at data <- rankTransform(meuseNeigh at data)
-
-meuseSpVine <- fitCopula(spVineCopula(spCop, vineCopula(as.integer(vineDim-1))),
-                         meuseNeigh)
-
-meuseSpVine at vineCop
-
-##
-# leave-one-out x-validation
-
-condVine <- function(condVar, dists, n=100) {
-  rat <- 0.2/(1:(n/2))-(0.1/((n+1)/2))
-  xVals <- unique(sort(c(rat,1-rat,1:(n-1)/(n))))
-  xLength <- length(xVals)
-  repCondVar <- matrix(condVar, ncol=length(condVar), nrow=xLength, byrow=T)
-  density <- dCopula(cbind(xVals, repCondVar), meuseSpVine, h=dists)
-  
-  linAppr <- approxfun(c(0,xVals,1), density[c(1,1:xLength,xLength)] ,yleft=0, yright=0)
-  int <- integrate(linAppr,lower=0, upper=1)$value
-  
-  return(function(u) linAppr(u)/int)
-}
-
-time <- proc.time()  # ~30 s
-predMedian <- NULL
-predMean <- NULL
-for(loc in 1:nrow(meuseNeigh at data)) { # loc <- 429  predNeigh$data[loc,1]
-  cat("Location:",loc,"\n")
-  condSecVine <- condVine(condVar=as.numeric(meuseNeigh at data[loc,-1]), 
-                          dists=meuseNeigh at distances[loc,,drop=F])
-  
-  predMedian <- c(predMedian, qMar(optimise(function(x) abs(integrate(condSecVine,0,x)$value-0.5),c(0,1))$minimum))
-  
-  condExp <-  function(x) {
-    condSecVine(pMar(x))*dMar(x)*x
-  }
-  
-  predMean <- c(predMean, integrate(condExp,0,3000,subdivisions=1e6)$value)
-}
-proc.time()-time
-
-mean(abs(predMean-meuse$zinc))
-mean(predMean-meuse$zinc)
-sqrt(mean((predMean-meuse$zinc)^2))
-
-mean(abs(predMedian-meuse$zinc))
-mean(predMedian-meuse$zinc)
-sqrt(mean((predMedian-meuse$zinc)^2))
-
-plot(predMean,meuse$zinc)
-abline(0,1)
-
-plot(predMedian,meuse$zinc)
-abline(0,1)
-
-## kriging results:
-# same neighbourhood size 5L:
-# MAE:  158.61
-# BIAS:  -4.24
-# RMSE: 239.85
-#
-# global kriging:
-# MAE:  148.85
-# BIAS:  -3.05
-# RMSE: 226.15
\ No newline at end of file

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

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


From noreply at r-forge.r-project.org  Tue Apr 23 16:17:12 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Tue, 23 Apr 2013 16:17:12 +0200 (CEST)
Subject: [spcopula-commits] r94 - / pkg pkg/R pkg/man
Message-ID: <20130423141712.3A51118502F@r-forge.r-project.org>

Author: ben_graeler
Date: 2013-04-23 16:17:11 +0200 (Tue, 23 Apr 2013)
New Revision: 94

Modified:
   pkg/DESCRIPTION
   pkg/R/Classes.R
   pkg/R/partialDerivatives.R
   pkg/R/returnPeriods.R
   pkg/R/spCopula.R
   pkg/R/spVineCopula.R
   pkg/R/spatialPreparation.R
   pkg/man/condSpVine.Rd
   pkg/man/fitCorFun.Rd
   pkg/man/spCopPredict.Rd
   spcopula_0.1-1.tar.gz
   spcopula_0.1-1.zip
Log:
- fine tuning of condSpVine
- weighted estimate in fitCorFun

Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION	2013-04-15 11:39:18 UTC (rev 93)
+++ pkg/DESCRIPTION	2013-04-23 14:17:11 UTC (rev 94)
@@ -2,7 +2,7 @@
 Type: Package
 Title: copula driven spatial analysis
 Version: 0.1-1
-Date: 2013-04-11
+Date: 2013-04-23
 Author: Benedikt Graeler
 Maintainer: Benedikt Graeler <ben.graeler at uni-muenster.de>
 Description: This package provides a framework to analyse via copulas spatial and spatio-temporal data provided in the format of the spacetime package. Additionally, support for calculating different multivariate return periods is implemented.

Modified: pkg/R/Classes.R
===================================================================
--- pkg/R/Classes.R	2013-04-15 11:39:18 UTC (rev 93)
+++ pkg/R/Classes.R	2013-04-23 14:17:11 UTC (rev 94)
@@ -95,8 +95,10 @@
   check.upper <- NULL
   check.lower <- NULL
   
+  nComp <- length(object at components)
   if(!is.null(object at calibMoa(normalCopula(0),0))) {
-    for (i in 1:(length(object at components)-1)) {
+    nonIndep <- sapply(object at components[-nComp], function(x) class(x) != "indepCopula")
+    for (i in (1:(nComp-1))[nonIndep]) {
       check.upper <- c(check.upper, is.na(object at calibMoa(object at components[[i]], object at distances[i+1])))
       check.lower <- c(check.lower, is.na(object at calibMoa(object at components[[i]], c(0,object at distances)[i])))
     }

Modified: pkg/R/partialDerivatives.R
===================================================================
--- pkg/R/partialDerivatives.R	2013-04-15 11:39:18 UTC (rev 93)
+++ pkg/R/partialDerivatives.R	2013-04-23 14:17:11 UTC (rev 94)
@@ -218,7 +218,7 @@
   u1 <- u[,1]
   u2 <- u[,2]
 
-  pcopula(gumbelCopula(rho),u) * ((-log(u1))^rho+(-log(u2))^rho)^(1/rho-1) * (-log(u1))^(rho-1)/u1
+  pCopula(u,gumbelCopula(rho)) * ((-log(u1))^rho+(-log(u2))^rho)^(1/rho-1) * (-log(u1))^(rho-1)/u1
 }
 
 setMethod("dduCopula", signature("numeric","gumbelCopula"),
@@ -237,7 +237,7 @@
   u1 <- u[,1]
   u2 <- u[,2]
 
-  pcopula(gumbelCopula(rho),u) * ((-log(u2))^rho+(-log(u1))^rho)^(1/rho-1) * (-log(u2))^(rho-1)/u2
+  pCopula(u,gumbelCopula(rho)) * ((-log(u2))^rho+(-log(u1))^rho)^(1/rho-1) * (-log(u2))^(rho-1)/u2
 }
 
 setMethod("ddvCopula", signature("numeric","gumbelCopula"),

Modified: pkg/R/returnPeriods.R
===================================================================
--- pkg/R/returnPeriods.R	2013-04-15 11:39:18 UTC (rev 93)
+++ pkg/R/returnPeriods.R	2013-04-23 14:17:11 UTC (rev 94)
@@ -123,4 +123,4 @@
   return(cbind(u,params))
 }
 
-setMethod("qCopula_u",signature("copula"),qCopula_u.def)
\ No newline at end of file
+setMethod("qCopula_u", signature("copula"), qCopula_u.def)

Modified: pkg/R/spCopula.R
===================================================================
--- pkg/R/spCopula.R	2013-04-15 11:39:18 UTC (rev 93)
+++ pkg/R/spCopula.R	2013-04-23 14:17:11 UTC (rev 94)
@@ -28,7 +28,8 @@
                        id=function(copula, h) return(h))
     
     for (i in 1:length(components)) {
-      param <- try(calibMoa(components[[i]], distances[i]),T)
+      if(class(components[[i]]) != "indepCopula")
+        param <- try(calibMoa(components[[i]], distances[i]),T)
       if (class(param) == "numeric")
         components[[i]]@parameters[1] <- param # take care of non single parameter copulas
     }
@@ -36,10 +37,26 @@
 
 #   components <- append(components,indepCopula())
   
-  param       <- unlist(lapply(components, function(x) x at parameters))
-  param.names <- unlist(lapply(components, function(x) x at param.names))
-  param.low   <- unlist(lapply(components, function(x) x at param.lowbnd))
-  param.up    <- unlist(lapply(components, function(x) x at param.upbnd))
+  param       <- unlist(lapply(components, 
+                               function(x) {
+                                 if(class(x)=="indepCopula") 
+                                   return(NA)
+                                 x at parameters}))
+  param.names <- unlist(lapply(components, 
+                               function(x) {
+                                 if(class(x)=="indepCopula") 
+                                   return(NA)
+                                 x at param.names}))
+  param.low   <- unlist(lapply(components, 
+                               function(x) {
+                                 if(class(x)=="indepCopula") 
+                                   return(NA)
+                                 x at param.lowbnd}))
+  param.up    <- unlist(lapply(components, 
+                               function(x) {
+                                 if(class(x)=="indepCopula") 
+                                   return(NA)
+                                 x at param.upbnd}))
      
   new("spCopula", dimension=as.integer(2), parameters=param, param.names=param.names,
       param.lowbnd=param.low, param.upbnd=param.up,
@@ -75,6 +92,7 @@
   n.dists <- length(dists)
   calibPar <- copula at calibMoa
   
+  # data is sorted to be ascending in distance
   res <- numeric(0)
   sel <- which(h < dists[1])
   if(sum(sel)>0) {
@@ -136,7 +154,7 @@
   sel <- which(h >= dists[n.dists])
   if(sum(sel)>0) {
     res <- c(res, fun(pairs[which(h >= dists[n.dists]),],
-                      copula at components[[n.dists]],, ...))
+                      copula at components[[n.dists]], ...))
   }
 
   return(res)
@@ -152,42 +170,39 @@
     tmpCop <- copula at components[[1]]
     if(class(tmpCop) != "indepCopula")
       tmpCop at parameters[1] <- calibPar(tmpCop, h)
-    res <- fun(pairs, tmpCop, ...)
+    return(fun(pairs, tmpCop, ...))
   }
   
-  if (n.dists >= 2) {
-    for ( i in 2:n.dists ) {
-      low  <- dists[i-1]
-      high <- dists[i]
-      if (h >= low & h < high) {
-        lowerCop <- copula at components[[i-1]]
-        upperCop <- copula at components[[i]]
-        if (class(lowerCop) != class(upperCop)) {
-          if(class(lowerCop) != "indepCopula")
-            lowerCop at parameters[1] <- calibPar(lowerCop, h)
-          if(class(upperCop) != "indepCopula")
-            upperCop at parameters[1] <- calibPar(upperCop, h)
+  if(h >= dists[n.dists]) {
+    return(fun(pairs, copula at components[[n.dists]], ...))
+  }
+  
+  for (i in 2:n.dists) {
+    low  <- dists[i-1]
+    high <- dists[i]
+    if(low <= h & h < high) {
+      lowerCop <- copula at components[[i-1]]
+      upperCop <- copula at components[[i]]
+      if (class(lowerCop) != class(upperCop)) {
+        if(class(lowerCop) != "indepCopula")
+          lowerCop at parameters[1] <- calibPar(lowerCop, h)
+        if(class(upperCop) != "indepCopula")
+          upperCop at parameters[1] <- calibPar(upperCop, h)
 
-          lowerVals <- fun(pairs, lowerCop)
-          upperVals <- fun(pairs, upperCop)
+        lowerVals <- fun(pairs, lowerCop)
+        upperVals <- fun(pairs, upperCop)
 
-          res <- (high-h)/(high-low)*lowerVals + (h-low)/(high-low)*upperVals
-          if(do.logs)
-            res <- log(res)
-        } else {
-          if(class(lowerCop) != "indepCopula")
-            lowerCop at parameters <- calibPar(lowerCop, h)
-          res <- fun(pairs, lowerCop, ...)
-        }
+        res <- (high-h)/(high-low)*lowerVals + (h-low)/(high-low)*upperVals
+        if(do.logs)
+          return(log(res))
+        return(res)
+      } else {
+        if(class(lowerCop) != "indepCopula")
+          lowerCop at parameters <- calibPar(lowerCop, h)
+        return(fun(pairs, lowerCop, ...))
       }
     }
   }
-  
-  if(h >= dists[n.dists]) {
-    res <- fun(pairs, copula at components[[n.dists]], ...)
-  }
-  
-  return(res)
 }
 
 
@@ -232,106 +247,63 @@
 }
 
 
-# u 
-#   two column matrix providing the transformed pairs and their respective 
-#   separation distances
-# h providing the separating distance(s)
-# block
-#   block distances, pairs are assumed to be ordered block wise
+## spatial copula CDF
+######################
+
 pSpCopula <- function (u, copula, h, block=1) {
-  if (missing(h)) stop("Point pairs need to be provided with their separating distance \"h\".")
-  
-  n <- nrow(u)
-  
-  if (n%%block != 0) stop("The block size is not a multiple of the data length:",n)
-  
-  if(length(h)>1 && length(h)!=n) {
+  if (missing(h)) 
+    stop("Point pairs need to be provided with their separating distance \"h\".")
+  if(length(h)>1 && length(h)!=nrow(u))
     stop("The distance vector must either be of the same length as rows in the data pairs or a single value.")
-  }
   
+  if(is.null(copula at calibMoa(normalCopula(0),0)))
+    return(spConCop(pCopula, copula, u, rep(h,length.out=nrow(u))))
   
-  if(is.null(copula at calibMoa(normalCopula(0),0))) {
-    res <- spConCop(pCopula, copula, u, rep(h,length.out=nrow(pairs)))
-  } else {
-    if(length(h)>1) {
-      if (block == 1){
-        ordering <- order(h)
+  if(length(h)>1) {
+    ordering <- order(h)
         
-        # ascending sorted pairs allow for easy evaluation
-        u <- u[ordering,,drop=FALSE] 
-        h <- h[ordering]
+    # ascending sorted pairs allow for easy evaluation
+    u <- u[ordering,,drop=FALSE] 
+    h <- h[ordering]
         
-        res <- spDepFunCop(pCopula, copula, u, h)
+    res <- spDepFunCop(pCopula, copula, u, h)
         
-        # reordering the values
-        res <- res[order(ordering)]
-      } else {
-        res <- NULL
-        for(i in 1:(n%/%block)) {
-          res <- c(res, spDepFunCopSnglDist(pCopula, copula, 
-                                            u[((i-1)*block+1):(i*block),], 
-                                            h[i*block]))
-        }
-      }
-    } else {
-      res <- spDepFunCopSnglDist(pCopula, copula, u, h)
-    }
-  }
-  
-  return(res)
+    # reordering the values
+    return(res[order(ordering)])
+  } else
+      return(spDepFunCopSnglDist(pCopula, copula, u, h))
 }
 
 setMethod(pCopula, signature("numeric","spCopula"), 
           function(u, copula, ...) pSpCopula(matrix(u,ncol=2),copula, ...))
 setMethod(pCopula, signature("matrix","spCopula"), pSpCopula)
 
-## spatial Copula density ##
+## spatial Copula density 
+##########################
 
-# u 
-#   three column matrix providing the transformed pairs and their respective 
-#   separation distances
-dSpCopula <- function (u, copula, log, h, block=1) {
-  if (missing(h)) stop("Point pairs need to be provided with their separating distance \"h\".")
-  
-  n <- nrow(u)
-  
-  if (n%%block != 0) stop("The block size is not a multiple of the data length:",n)
-  
-  if(length(h)>1 && length(h)!=n) {
+dSpCopula <- function (u, copula, log, h) {
+  if (missing(h)) 
+    stop("Point pairs need to be provided with their separating distance \"h\".")
+  if(length(h)>1 && length(h)!=nrow(u))
     stop("The distance vector must either be of the same length as rows in the data pairs or a single value.")
-  }
   
-  if(is.null(copula at calibMoa(normalCopula(0),0))){
-    res <- spConCop(dCopula, copula, u, rep(h, length.out=n), 
-                    do.logs=log, log=log)
-  }
-  else {
-    if(length(h)>1) {
-      if (block == 1){
-        ordering <- order(h)
+  if(is.null(copula at calibMoa(normalCopula(0),0)))
+    return(spConCop(dCopula, copula, u, rep(h, length.out=nrow(u)), do.logs=log,
+                    log=log))
+
+  if(length(h)>1) {
+    ordering <- order(h)
+    
+    # ascending sorted pairs allow for easy evaluation
+    u <- u[ordering,,drop=FALSE] 
+    h <- h[ordering]
         
-        # ascending sorted pairs allow for easy evaluation
-        u <- u[ordering,,drop=FALSE] 
-        h <- h[ordering]
+    res <- spDepFunCop(dCopula, copula, u, h, do.logs=log, log=log)
         
-        res <- spDepFunCop(dCopula, copula, u, h, do.logs=log, log=log)
-        
-        # reordering the values
-        res <- res[order(ordering)]
-      } else {
-        res <- NULL
-        for(i in 1:(n%/%block)) {
-          res <- c(res, spDepFunCopSnglDist(dCopula, copula, 
-                                            u[((i-1)*block+1):(i*block),], 
-                                            h[i*block], do.logs=log, log=log))
-        }
-      }
-    } else {
-      res <- spDepFunCopSnglDist(dCopula, copula, u, h, do.logs=log, log=log)
-    }
-  }
-  
-  return(res)
+    # reordering the values
+    return(res[order(ordering)])
+  } else
+      return(spDepFunCopSnglDist(dCopula, copula, u, h, do.logs=log, log=log))
 }
 
 setMethod(dCopula, signature("numeric","spCopula"), 
@@ -339,56 +311,31 @@
 setMethod(dCopula, signature("matrix","spCopula"), dSpCopula)
 
 ## partial derivatives ##
-
 ## dduSpCopula
 ###############
 
-dduSpCopula <- function (u, copula, h, block=1) {
-  if (missing(h)) stop("Point pairs need to be provided with their separating distance h.")
-  
-  n <- nrow(u)
-  
-  if(length(h)>1 && length(h)!=n) {
+dduSpCopula <- function (u, copula, h) {
+  if (missing(h)) 
+    stop("Point pairs need to be provided with their separating distance h.")
+  if(length(h)>1 && length(h)!=nrow(u))
     stop("The distance vector must either be of the same length as rows in the data pairs or a single value.")
-  }
 
   if(is.null(copula at calibMoa(normalCopula(0),0)))
-    res <- spConCop(dduCopula, copula, u, rep(h, length.out=n))
+    return(spConCop(dduCopula, copula, u, rep(h, length.out=nrow(u))))
   
-  else {
-    if(length(h)>1) {
-      if (block == 1){
-        ordering <- order(h)
+  if(length(h)>1) {
+    ordering <- order(h)
         
-        # ascending sorted pairs allow for easy evaluation
-        u <- u[ordering,,drop=FALSE] 
-        h <- h[ordering]
+    # ascending sorted pairs allow for easy evaluation
+    u <- u[ordering, , drop=FALSE] 
+    h <- h[ordering]
         
-        res <- spDepFunCop(dduCopula, copula, u, h)      
+    res <- spDepFunCop(dduCopula, copula, u, h)      
         
-        # reordering the values
-        res <- res[order(ordering)]
-      } else {
-        res <- NULL
-        for(i in 1:(n%/%block)) {
-          res <- c(res, spDepFunCopSnglDist(dduCopula, copula, 
-                                            u[((i-1)*block+1):(i*block),], 
-                                            h[i*block]))
-        }
-      }
-    } else {
-      res <- spDepFunCopSnglDist(dduCopula, copula, u, h)
-    }
-  }
-  
-  if(any(res < 0) || any(res > 1)) {
-    warning("Partial derivative produced values outside of [0,1], corrections will be applied to:\n",
-            paste(res[res<0],collapse=" "),paste(res[res>1],collapse=" "))
-    res[res<0] <- 0
-    res[res>1] <- 1
-  }
-  
-  return(res)
+    # reordering the values
+    return(res[order(ordering)])
+  } else
+    return(spDepFunCopSnglDist(dduCopula, copula, u, h))
 }
 
 setMethod("dduCopula", signature("matrix","spCopula"), dduSpCopula)
@@ -398,53 +345,28 @@
 ## ddvSpCopula
 ###############
 
-
 ddvSpCopula <- function (u, copula, h, block=1) {
-  if (missing(h)) stop("Point pairs need to be provided with their separating distance h.")
-  
-  n <- nrow(u)
-  
-  if(length(h)>1 && length(h)!=n) {
+  if (missing(h)) 
+    stop("Point pairs need to be provided with their separating distance h.")
+  if(length(h)>1 && length(h)!=nrow(u))
     stop("The distance vector must either be of the same length as rows in the data pairs or a single value.")
-  }
-  
+    
   if(is.null(copula at calibMoa(normalCopula(0),0)))
-    res <- spConCop(dduCopula, copula, u, rep(h, length.out=n))
+    return(spConCop(ddvCopula, copula, u, rep(h, length.out=nrow(u))))
   
-  else {
-    if(length(h)>1) {
-      if (block == 1){
-        ordering <- order(h)
+  if(length(h)>1) {
+    ordering <- order(h)
         
-        # ascending sorted pairs allow for easy evaluation
-        u <- u[ordering,,drop=FALSE] 
-        h <- h[ordering]
+    # ascending sorted pairs allow for easy evaluation
+    u <- u[ordering,,drop=FALSE] 
+    h <- h[ordering]
         
-        res <- spDepFunCop(ddvCopula, copula, u, h)      
+    res <- spDepFunCop(ddvCopula, copula, u, h)      
         
-        # reordering the values
-        res <- res[order(ordering)]
-      } else {
-        res <- NULL
-        for(i in 1:(n%/%block)) {
-          res <- c(res, spDepFunCopSnglDist(ddvCopula, copula, 
-                                            u[((i-1)*block+1):(i*block),], 
-                                            h[i*block]))
-        }
-      }
-    } else {
-      res <- spDepFunCopSnglDist(ddvCopula, copula, u, h)
-    }
-  }
-  
-  if(any(res < 0) || any(res > 1)) {
-    warning("Partial derivative produced values outside of [0,1], corrections will be applied to:\n",
-            paste(res[res<0],collapse=" "),paste(res[res>1],collapse=" "))
-    res[res<0] <- 0
-    res[res>1] <- 1
-  }
-  
-  return(res)
+    # reordering the values
+    return(res[order(ordering)])
+  } else
+      return(spDepFunCopSnglDist(ddvCopula, copula, u, h))
 }
 
 setMethod("ddvCopula", signature("matrix","spCopula"), ddvSpCopula)
@@ -485,21 +407,29 @@
 # bounds -> the bounds of the correlation function (typically c(0,1))
 # method -> the measure of association, either "kendall" or "spearman"
 fitCorFun <- function(bins, degree=3, cutoff=NA, bounds=c(0,1), 
-                      cor.method=NULL) {
+                      cor.method=NULL, weighted=FALSE) {
   if(is.null(cor.method)) {
     if(is.null(attr(bins,"cor.method")))
       stop("Neither the bins arguments has an attribute cor.method nor is the parameter cor.method provided.") 
     else 
       cor.method <- attr(bins,"cor.method")
-  } else 
+  } else {
     if(!is.null(attr(bins,"cor.method")) && cor.method != attr(bins,"cor.method"))
       stop("The cor.method attribute of the bins argument and the argument cor.method do not match.")
-    
-  bins <- as.data.frame(bins[1:2])
-  if(!is.na(cutoff)) bins <- bins[which(bins[[1]] <= cutoff),]
+  }
+
+  if (weighted) {
+    bins <- as.data.frame(bins[c("np","meanDists","lagCor")])
+    if(!is.na(cutoff)) 
+      bins <- bins[bins$meanDists <= cutoff,]
+    fitCor <- lm(lagCor ~ poly(meanDists, degree), data = bins, weights=bins$np)
+  } else {
+    bins <- as.data.frame(bins[c("meanDists","lagCor")])
+    if(!is.na(cutoff)) 
+      bins <- bins[bins$meanDists <= cutoff,]
+    fitCor <- lm(lagCor ~ poly(meanDists, degree), data = bins)
+  }
   
-  fitCor <- lm(lagCor ~ poly(meanDists, degree), data = bins)
-  
   print(fitCor)
   cat("Sum of squared residuals:",sum(fitCor$residuals^2),"\n")
   
@@ -564,35 +494,6 @@
   }
 }
 
-# older implementation:
-# composeSpCop <- function(bestFit, families, bins, calcCor) {
-#   nfits <- length(bestFit)
-#   gaps <- which(diff(bestFit)!=0)
-# 
-#   if(missing(calcCor)) noCor <- nfits
-#   else noCor <- min(which(calcCor(bins$meanDists)<=0), nfits)
-#   
-#   breaks <- sort(c(gaps, gaps+1, noCor))
-#   breaks <- breaks[breaks<noCor]
-#   
-#   cops <- as.list(families[bestFit[breaks]])
-#   
-#   breaks <- unique(c(breaks, min(nfits,rev(breaks)[1]+1)))
-#   distances <- bins$meanDists[breaks]
-#   
-#   if(length(breaks)==length(cops)) {
-#     warning("Lags do not cover the entire range with positive correlation. ", 
-#              "An artifical one fading towards the indepCopula has been added.")
-#     distances <- c(distances, 
-#                    rev(distances)[1]+diff(bins$meanDists[nfits+c(-1,0)]))
-#   }
-# 
-#   if(missing(calcCor)) return(spCopula(components=cops, distances=distances, 
-#                                        unit="m"))
-#   else return(spCopula(components=cops, distances=distances, unit="m", 
-#                        spDepFun=calcCor))
-# }
-
 # in once
 
 # bins   -> typically output from calcBins

Modified: pkg/R/spVineCopula.R
===================================================================
--- pkg/R/spVineCopula.R	2013-04-15 11:39:18 UTC (rev 93)
+++ pkg/R/spVineCopula.R	2013-04-23 14:17:11 UTC (rev 94)
@@ -24,13 +24,14 @@
   l0 <- rep(0,nrow(u)) # level 0 (spatial) density
   u0 <- NULL # level 0 conditional data
   
-  if(!is.matrix(h)) h <- matrix(h, ncol=length(h))
+  if(!is.matrix(h)) 
+    h <- matrix(h, ncol=length(h))
   
   for(i in 1:(ncol(u)-1)) { # i <- 1
-    l0 <- l0+dCopula(as.matrix(u[,c(1,i+1)]), spCop, h=h[,i], log=T)
-    u0 <- cbind(u0, dduCopula(as.matrix(u[,c(1,i+1)]), spCop, h=h[,i]))
+    l0 <- l0 + dCopula(u[,c(1,i+1)], spCop, h=h[,i], log=T)
+    u0 <- cbind(u0, dduCopula(u[,c(1,i+1)], spCop, h=h[,i]))
   }
-  
+
   l1 <- dCopula(u0, vine, log=T)
   if(log)
     return(l0+l1)
@@ -65,6 +66,8 @@
                                 copula=copula at spCop, h=data at distances[,i]))
   }
   
+  cat(summary(as.data.frame(secLevel)))
+    
   vineCopFit <- fitCopula(copula at vineCop, secLevel, method) 
   
   spVineCop <- spVineCopula(copula at spCop, vineCopFit at copula)
@@ -79,22 +82,29 @@
 setMethod("fitCopula",signature=signature("spVineCopula"),fitSpVine)
 
 # conditional spatial vine
-condSpVine <- function(condVar, dists, spVine, n=100) {
-  rat <- 0.2/(1:(n/2))-(0.1/((n+1)/2))
-  xVals <- unique(sort(c(rat,1-rat,1:(n-1)/(n))))
-  xLength <- length(xVals)
-  repCondVar <- matrix(condVar, ncol=length(condVar), nrow=xLength, byrow=T)
-  density <- dCopula(cbind(xVals, repCondVar), spVine, h=dists)
+condSpVine <- function (condVar, dists, spVine, n = 1000) {
+  # add some points in the tails
+  rat <- 29:1%x%c(1e-6,1e-5,1e-4,1e-3)
+  xVals <- unique(sort(c(rat, 1 - rat, 1:(n - 1)/(n))))
+  nx <- length(xVals)
   
-  linAppr <- approxfun(c(0,xVals,1), density[c(1,1:xLength,xLength)] ,yleft=0, yright=0)
-  int <- integrate(linAppr,lower=0, upper=1)$value
+  repCondVar <- matrix(condVar, ncol = length(condVar), nrow = nx, byrow = T)
+  density <- dCopula(cbind(xVals, repCondVar), spVine, h = dists)
   
+  # the 1-e7 corners linearily to [0,1], but keep non-negative
+  density <- c(max(0,2*density[1]-density[2]),
+               density, max(0,2*density[nx]-density[nx-1]))
+  linAppr <- approxfun(c(0, xVals, 1), density)
+  
+  # sum up the denstiy to rescale
+  int <- sum(diff(c(0,xVals,1))*(0.5*diff(density)+density[-(nx+2)]))
   return(function(u) linAppr(u)/int)
 }
 
 # interpolation
 
-spCopPredict.expectation <- function(predNeigh, spVine, margin) {
+spCopPredict.expectation <- function(predNeigh, spVine, margin, range) {
+  stopifnot(!is.null(range))
   stopifnot(is.function(margin$d))
   stopifnot(is.function(margin$p))
   
@@ -106,7 +116,7 @@
       condSecVine(margin$p(x))*margin$d(x)*x
     }
     
-    predMean <- c(predMean, integrate(condExp,0,3000,subdivisions=1e6)$value)
+    predMean <- c(predMean, integrate(condExp,range[1],range[2],subdivisions=1e6)$value)
   }
   if ("data" %in% slotNames(predNeigh at locations)) {
     res <- predNeigh at locations
@@ -125,10 +135,16 @@
   predQuantile <- NULL
   for(i in 1:nrow(predNeigh at data)) { # i <-1
     condSecVine <- condSpVine(as.numeric(predNeigh at data[i,]), predNeigh at distances[i,], spVine)  
-    pPred <- optimise(function(x) abs(integrate(condSecVine,0,x)$value-p),
-                      c(0,1))$minimum
-    predQuantile <- c(predQuantile, margin$q(pPred))
+    pPred <- optimise(function(x) abs(integrate(condSecVine, 0, x, 
+                                                subdivisions=10000L, 
+                                                abs.tol=1e-6)$value-p),
+                      c(0,1))
+    if(pPred$objective > 1e-6)
+      warning("Numerical evaluation in predQuantile achieved an obkective of only ",
+              pPred$objective, " where 0 has been sought.")
+    predQuantile <- c(predQuantile, margin$q(pPred$minimum))
   }
+  
   if ("data" %in% slotNames(predNeigh at locations)) {
     res <- predNeigh at locations
     res at data[[paste("quantile.",p,sep="")]] <- predQuantile
@@ -140,8 +156,8 @@
   }
 }
 
-spCopPredict <- function(predNeigh, spVine, margin, method="quantile", p=0.5) {
+spCopPredict <- function(predNeigh, spVine, margin, method="quantile", p=0.5, range=NULL) {
   switch(method,
          quantile=spCopPredict.quantile(predNeigh, spVine, margin, p),
-         expectation=spCopPredict.expectation(predNeigh, spVine, margin))
+         expectation=spCopPredict.expectation(predNeigh, spVine, margin, range))
 }
\ No newline at end of file

Modified: pkg/R/spatialPreparation.R
===================================================================
--- pkg/R/spatialPreparation.R	2013-04-15 11:39:18 UTC (rev 93)
+++ pkg/R/spatialPreparation.R	2013-04-23 14:17:11 UTC (rev 94)
@@ -1,15 +1,11 @@
-##################################################################
-##                                                              ##
-## dedicated functions based on sp preparing the use of copulas ##
-##                                                              ##
-##################################################################
+########################################################
+##                                                    ##
+## functions based on sp preparing the use of copulas ##
+##                                                    ##
+########################################################
 
-## neighbourhood
-# constructor
-# data = "matrix"	a matrix or array providing the data
-# distances="matrix"	a matrix providing the distances
-# sp="SpatialPoints"	SpatialPoints object providing the coordinates
-# index="matrix"	linking the obs. in data to the coordinates
+## neighbourhood constructor
+############################
 
 neighbourhood <- function(data, distances, sp, index, prediction, var){
   sizeN <- ncol(distances)+1
@@ -31,7 +27,6 @@
 setMethod(show,signature("neighbourhood"),showNeighbourhood)
 
 ## names (from sp)
-
 setMethod(names, signature("neighbourhood"), namesNeighbourhood <- function(x) x at var)
 
 ## spplot ##
@@ -49,12 +44,7 @@
 ## calculate neighbourhood from SpatialPointsDataFrame
 
 # returns an neighbourhood object
-# spData	    spatialPointsDataFrame
-# locations   the prediction locations, for fitting, locations=spData
-# var 		    one or multiple variable names, all is the default
-# size		    the size of the neighbourhood, note that for prediction the size 
-#             is one less than for the copula estimation (default of 5)
-# min.dist    the minimum distance between neighbours, must be positive
+##################################
 
 getNeighbours <- function(spData, locations, var=names(spData)[1], size=5, 
                           prediction=FALSE, min.dist=0.01) {
@@ -94,14 +84,6 @@
                        allLocs, prediction, var))
 }
 
-# data(meuse)
-# coordinates(meuse) <- ~x+y
-# meuseNeigh <- getNeighbours(meuse,var="zinc",size=5)
-# str(meuseNeigh)
-# 
-# meuseNeigh <- addAttrToGeom(meuseNeigh at locations,data.frame(rnd=runif(155)),match.ID=F)
-# str(meuseNeigh)
-
 #############
 ## BINNING ##
 #############
@@ -131,40 +113,46 @@
 }
 
 # the generic calcBins, calculates bins for spatial and spatio-temporal data
+setGeneric("calcBins", function(data, var, nbins=15, boundaries=NA, cutoff=NA,
+                                cor.method="kendall", plot=T, ...) {
+                         standardGeneric("calcBins") 
+                         })
 
-setGeneric("calcBins", function(data, var, nbins=15, boundaries=NA, cutoff=NA, cor.method="kendall", plot=T, ...) standardGeneric("calcBins") )
+## calculating the spatial bins
+################################
 
-# calculating the spatial bins
-# 
-# data denotes the spatial data object
-# var denotes the only variable name used
-# cor.method is passed on to cor() (default="kendall")
-# if plot=TRUE (default), the correlation measures are plotted agaisnt the mean lag separation distance
-# 
-calcSpBins <- function(data, var=names(data), nbins=15, boundaries=NA, cutoff=NA, cor.method="kendall", plot=TRUE) {
+calcSpBins <- function(data, var=names(data), nbins=15, boundaries=NA, 
+                       cutoff=NA, cor.method="kendall", plot=TRUE) {
 
+  if(is.na(cutoff)) {
+    cutoff <- spDists(coordinates(t(data at bbox)))[1,2]/3
+  }
   if(is.na(boundaries)) {
-    diagonal <- spDists(coordinates(t(data at bbox)))[1,2]
-    boundaries <- ((1:nbins) * min(cutoff,diagonal/3,na.rm=T) / nbins)
+    boundaries <- ((1:nbins) * cutoff/nbins)
   }
   
   lags <- calcSpLagInd(data, boundaries)
     
-  mDists <- sapply(lags,function(x) mean(x[,3]))
+  mDists <- sapply(lags, function(x) mean(x[,3]))
+  np <- sapply(lags, function(x) length(x[,3]))
   lagData <- lapply(lags, function(x) as.matrix((cbind(data[x[,1],var]@data, data[x[,2],var]@data))))
   
   if(cor.method == "fasttau")
     lagCor <- sapply(lagData, function(x) VineCopula:::fasttau(x[,1], x[,2]))
-  else 
+  if(cor.method %in% c("kendall","spearman","perarson"))
     lagCor <- sapply(lagData, function(x) cor(x,method=cor.method)[1,2])
-  
+  if(cor.method == "normVariogram")  
+    lagCor <- sapply(lagData, function(x) 1-cor(x,method="pearson")[1,2])
+  if(cor.method == "variogram")  
+    lagCor <- sapply(lagData, function(x) 0.5*mean((x[,1]-x[,2])^2,na.rm=T))
+    
   if(plot) { 
     plot(mDists, lagCor, xlab="distance",ylab=paste("correlation [",cor.method,"]",sep=""), 
          ylim=1.05*c(-abs(min(lagCor)),max(lagCor)), xlim=c(0,max(mDists)))
     abline(h=c(-min(lagCor),0,min(lagCor)),col="grey")
   }
   
-  res <- list(meanDists = mDists, lagCor=lagCor, lagData=lagData, lags=lags)
+  res <- list(np=np, meanDists = mDists, lagCor=lagCor, lagData=lagData, lags=lags)
   attr(res,"cor.method") <- cor.method
   return(res)
 }

Modified: pkg/man/condSpVine.Rd
===================================================================
--- pkg/man/condSpVine.Rd	2013-04-15 11:39:18 UTC (rev 93)
+++ pkg/man/condSpVine.Rd	2013-04-23 14:17:11 UTC (rev 94)
@@ -8,7 +8,7 @@
 A spatial vine copula is conditioned under the observations of all but one neighbour generating a conditional uivariate distribution used ofr prediction.
 }
 \usage{
-condSpVine(condVar, dists, spVine, n = 100)
+condSpVine(condVar, dists, spVine, n = 1000)
 }
 \arguments{
   \item{condVar}{

Modified: pkg/man/fitCorFun.Rd
===================================================================
--- pkg/man/fitCorFun.Rd	2013-04-15 11:39:18 UTC (rev 93)
+++ pkg/man/fitCorFun.Rd	2013-04-23 14:17:11 UTC (rev 94)
@@ -8,7 +8,7 @@
 Polynomials of different degrees can be fitted to the correlogram calculated using \code{\link{calcBins}}. This function will be used to adjust the copula parameter in the spatial/spatio-temporal copula.
 }
 \usage{
-fitCorFun(bins, degree = 3, cutoff = NA, bounds = c(0, 1), cor.method = NULL)
+fitCorFun(bins, degree = 3, cutoff = NA, bounds = c(0, 1), cor.method = NULL, weighted = FALSE)
 }
 \arguments{
   \item{bins}{
@@ -26,6 +26,9 @@
   \item{cor.method}{
 The output of \code{\link{calcBins}} has an attribute \code{cor.method}, in case this is not present the parameter \code{cor.method} will be used. In case the parameter \code{cor.method} is not \code{NULL} and the attribute \code{cor.method} is present, they will be compared.
 }
+  \item{weighted}{
+  shall the residulas be weighted by the number of points in the lag class?
+  }
 }
 \value{
 Returns a function that provides correlation estimate for every separating distance.

Modified: pkg/man/spCopPredict.Rd
===================================================================
--- pkg/man/spCopPredict.Rd	2013-04-15 11:39:18 UTC (rev 93)
+++ pkg/man/spCopPredict.Rd	2013-04-23 14:17:11 UTC (rev 94)
@@ -8,7 +8,7 @@
 A spatial vine copula is used to predict values at unobserved locations conditioned on observations of a local neighbourhood.
 }
 \usage{
-spCopPredict(predNeigh, spVine, margin, method = "quantile", p = 0.5)
+spCopPredict(predNeigh, spVine, margin, method = "quantile", p = 0.5, range = NULL)
 }
 \arguments{
   \item{predNeigh}{
@@ -26,6 +26,9 @@
   \item{p}{
 only used for the quantile predictor indicating the desired fraction the quantile should correspond to.
 }
+  \item{range}{
+  the range of integartion to be used in the numerical integration in \code{"expectation"} by \code{\link{integrate}}.
+  }
 }
 \details{
 Predictions are done based on \code{\link{condSpVine}} through numerical integration/optimisation.

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

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