[spcopula-commits] r122 - in pkg: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Feb 12 15:54:12 CET 2014
Author: ben_graeler
Date: 2014-02-12 15:54:12 +0100 (Wed, 12 Feb 2014)
New Revision: 122
Added:
pkg/R/stCoVarVineCopula.R
pkg/man/condStCoVarVine.Rd
pkg/man/dropStTree.Rd
pkg/man/reduceNeighbours.Rd
pkg/man/stCoVarVineCopula-class.Rd
pkg/man/stCoVarVineCopula.Rd
Modified:
pkg/DESCRIPTION
pkg/NAMESPACE
pkg/R/spCopula.R
pkg/R/spatio-temporalPreparation.R
pkg/man/dropSpTree.Rd
pkg/man/fitSpCopula.Rd
pkg/man/getStNeighbours.Rd
pkg/man/stVineCopula.Rd
Log:
- first rudimental spatio-temporal covariate vine copula support
Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION 2014-02-07 15:21:34 UTC (rev 121)
+++ pkg/DESCRIPTION 2014-02-12 14:54:12 UTC (rev 122)
@@ -2,7 +2,7 @@
Type: Package
Title: copula driven spatial analysis
Version: 0.2-0
-Date: 2014-02-07
+Date: 2014-02-12
Authors at R: c(person("Benedikt", "Graeler", role = c("aut", "cre"),
email = "ben.graeler at uni-muenster.de"),
person("Marius", "Appel",role = "ctb"))
@@ -26,6 +26,7 @@
spatio-temporalPreparation.R
spVineCopula.R
stVineCopula.R
+ stCoVarVineCopula.R
utilities.R
returnPeriods.R
spatialGaussianCopula.R
Modified: pkg/NAMESPACE
===================================================================
--- pkg/NAMESPACE 2014-02-07 15:21:34 UTC (rev 121)
+++ pkg/NAMESPACE 2014-02-12 14:54:12 UTC (rev 122)
@@ -7,6 +7,7 @@
export(tawn3pCopula)
export(spCopula, stCopula)
export(spVineCopula, stVineCopula)
+export(stCoVarVineCopula)
export(neighbourhood, stNeighbourhood)
export(empiricalCopula, genEmpCop)
@@ -18,6 +19,7 @@
export(qCopula_u)
export(condSpVine,spCopPredict)
export(condStVine,stCopPredict)
+export(condStCoVarVine)
export(spGaussCopPredict, spGaussLogLik)
# tweaks
@@ -26,7 +28,8 @@
# spatial
export(getNeighbours, getStNeighbours)
export(calcBins)
-export(calcSpTreeDists, dropSpTree)
+export(calcSpTreeDists, dropSpTree, dropStTree)
+export(reduceNeighbours)
# fitting
export(fitCorFun, loglikByCopulasLags, fitSpCopula, composeSpCopula)
@@ -40,4 +43,5 @@
## classes
exportClasses(asCopula, cqsCopula, tawn3pCopula, neighbourhood, stNeighbourhood, empiricalCopula)
-exportClasses(spCopula, stCopula, spVineCopula, stVineCopula)
\ No newline at end of file
+exportClasses(spCopula, stCopula, spVineCopula, stVineCopula)
+exportClasses(stCoVarVineCopula)
\ No newline at end of file
Modified: pkg/R/spCopula.R
===================================================================
--- pkg/R/spCopula.R 2014-02-07 15:21:34 UTC (rev 121)
+++ pkg/R/spCopula.R 2014-02-12 14:54:12 UTC (rev 122)
@@ -627,9 +627,9 @@
# bounds -> the bounds of the correlation function (typically c(0,1))
# method -> the measure of association, either "kendall" or "spearman"
fitSpCopula <- function(bins, cutoff=NA,
- families=c(normalCopula(0),
- tCopula(0,dispstr="un"), claytonCopula(0),
- frankCopula(1), gumbelCopula(1)), ...) {
+ families=c(normalCopula(), tCopula(),
+ claytonCopula(), frankCopula(),
+ gumbelCopula()), ...) {
calcCor <- fitCorFun(bins, cutoff=cutoff, ...)
loglik <- loglikByCopulasLags(bins, families, calcCor)
Modified: pkg/R/spatio-temporalPreparation.R
===================================================================
--- pkg/R/spatio-temporalPreparation.R 2014-02-07 15:21:34 UTC (rev 121)
+++ pkg/R/spatio-temporalPreparation.R 2014-02-12 14:54:12 UTC (rev 122)
@@ -116,6 +116,43 @@
stInd, prediction, var))
}
+
+## reduction of a larger neigbopurhood based on correlation strengths
+reduceNeighbours <- function(stNeigh, stDepFun, n) {
+ stopifnot(n>0)
+
+ # transform distances into correlations to detect the strongest correlated ones
+ dimStNeigh <- dim(stNeigh at distances)
+ corMat <- matrix(NA, dimStNeigh[1], dimStNeigh[2])
+
+ for (i in 1:dimStNeigh[2]) {
+ boolNA <- is.na(stNeigh at data[[1]]) | is.na(stNeigh at data[[1+i]])
+ stNeigh at distances[boolNA,i,] <- c(NA,NA)
+ tLag <- -1*stNeigh at distances[!boolNA,i,2][1]+1
+ corMat[!boolNA,i] <- stDepFun(stNeigh at distances[!boolNA,i,1], tLag)
+ }
+
+ highCorMat <- t(apply(corMat, 1, function(x) order(x, na.last=TRUE, decreasing=TRUE)[1:n]))
+
+ stNeighDataRed <- matrix(NA, nrow=nrow(highCorMat), ncol=n+1)
+ stNeighDistRed <- array(NA, dim=c(nrow(highCorMat), n, 2))
+ stNeighIndeRed <- array(NA, dim=c(nrow(highCorMat), n, 2))
+ for (i in 1:nrow(highCorMat)) {
+ stNeighDataRed[i,] <- as.numeric(stNeigh at data[i,c(1,highCorMat[i,]+1)])
+ stNeighDistRed[i,,] <- stNeigh at distances[i,highCorMat[i,],]
+ stNeighIndeRed[i,,] <- stNeigh at index[i,highCorMat[i,],]
+ }
+
+ stNeighDataRed <- stNeighDataRed[!is.na(stNeigh at data[[1]]),]
+ stNeighDistRed <- stNeighDistRed[!is.na(stNeigh at data[[1]]),,]
+ stNeighIndeRed <- stNeighIndeRed[!is.na(stNeigh at data[[1]]),,]
+
+ return(stNeighbourhood(stNeighDataRed,stNeighDistRed, stNeigh at dataLocs,
+ ST=stNeigh at dataLocs, stNeighIndeRed, prediction=F,
+ var=stNeigh at var))
+}
+
+## to be redone
calcStNeighBins <- function(data, var="uniPM10", nbins=9, t.lags=-(0:2),
boundaries=NA, cutoff=NA, cor.method="fasttau") {
# dists <- data at distances[,,1]
Added: pkg/R/stCoVarVineCopula.R
===================================================================
--- pkg/R/stCoVarVineCopula.R (rev 0)
+++ pkg/R/stCoVarVineCopula.R 2014-02-12 14:54:12 UTC (rev 122)
@@ -0,0 +1,271 @@
+############################################
+## the spatial vine copula with covariate ##
+############################################
+
+validStCoVarVineCopula <- function(object) {
+ return(is.function(object at coVarCop) & validStCopula(object at stCop) & validObject(object at topCop))
+}
+
+setClass("stCoVarVineCopula", representation("copula", coVarCop="function", stCop="stCopula", topCop="copula"),
+ validity = validStCoVarVineCopula, contains=list("copula"))
+
+## constructor ##
+#################
+
+stCoVarVineCopula <- function(coVarCop, stCop, topCop) {
+ stopifnot(is(stCop,"stCopula"))
+
+ new("stCoVarVineCopula", dimension = as.integer(topCop at dimension+1),
+ parameters=numeric(), param.names = character(), param.lowbnd = numeric(),
+ param.upbnd = numeric(),
+ fullname = paste("Spatio-temporal covariate vine copula family with 1 spatio-temporal tree."),
+ coVarCop=coVarCop, stCop=stCop, topCop=topCop)
+}
+
+## show ##
+##########
+
+showStCoVarVineCopula <- function(object) {
+ dim <- object at dimension
+ cat(object at fullname, "\n")
+ cat("Dimension: ", dim, "\n")
+}
+
+setMethod("show", signature("stCoVarVineCopula"), showStCoVarVineCopula)
+
+## density ##
+#############
+
+dstCoVarVine <- function(u, coVarCop, stCop, topCop, log, h, stInd) {
+ stopifnot(nrow(u)==nrow(stInd))
+ stopifnot(ncol(u)==2)
+ stopifnot(dim(h)==3)
+
+ l0 <- rep(0,nrow(u)) # level 0 spatio-temporal density
+ dimDists <- dim(h)
+
+ nrU <- nrow(u)
+
+ u1 <- matrix(NA, nrU, ncol(u)-1)
+ for(i in 2:dimDists[2]) { # i <- 1
+ l0 <- l0 + dCopula(u[,c(1,i+1)], stCop, h=matrix(h[,i,], ncol=2), log=T)
+ u1[,i] <- dduCopula(u[,c(1,i+1)], stCop, h=matrix(h[,i,], ncol=2))
+ }
+
+ uCoVar <- numeric(nrU)
+ for (i in 1:nrU) {
+ uCoVar[i] <- dduCopula(u[i,1:2], coVarCop(stInd[i,]))
+ }
+
+ if(!is.null(topCop))
+ l1 <- dCopula(cbind(uCoVar, u1), topCop, log=T)
+ else
+ l1 <- 0
+
+ if(log)
+ return(l0+l1)
+ else(exp(l0+l1))
+}
+
+setMethod("dCopula", signature=signature("matrix","stCoVarVineCopula"),
+ function(u, copula, log, ...) {
+ if("topCop" %in% slotNames(copula))
+ dstCoVarVine(u, copula at coVarCop, copula at stCop, copula at topCop, log=log, ...)
+ else
+ dstCoVarVine(u, copula at coVarCop, copula at stCop, NULL, log=log, ...)
+ })
+
+setMethod("dCopula",signature=signature("numeric","stCoVarVineCopula"),
+ function(u, copula, log, ...) {
+ if("topCop" %in% slotNames(copula))
+ dstCoVarVine(matrix(u,ncol=copula at dimension), copula at coVarCop, copula at stCop, copula at topCop, log=log, ...)
+ else
+ dstCoVarVine(matrix(u,ncol=copula at dimension), copula at coVarCop, copula at stCop, NULL, log=log, ...)
+ })
+
+setMethod("dCopula",signature=signature("data.frame","stCoVarVineCopula"),
+ function(u, copula, log, ...) {
+ if("topCop" %in% slotNames(copula))
+ dstCoVarVine(as.matrix(u), copula at stCop, copula at coVarCop, copula at stCop, copula at topCop, log=log, ...)
+ else
+ dstCoVarVine(as.matrix(u), copula at coVarCop, copula at stCop, NULL, log=log, ...)
+ })
+#
+# # fitting the spatial vine for a given list of spatial copulas
+# fitStVine <- function(copula, data, method, estimate.variance=F) {
+# stopifnot(class(data)=="stNeighbourhood")
+# stopifnot(copula at dimension == ncol(data at data))
+#
+# u0 <- as.matrix(data at data) # previous level's (conditional) data
+# h0 <- data at distances # previous level's distances
+# l0 <- rep(0,nrow(u0)) # spatial density
+# u1 <- NULL # current level of conditional data
+# cat("[Margin ")
+# for(i in 1:dim(h0)[2]) { # i <- 1
+# l0 <- l0 + dCopula(u0[,c(1,i+1)], copula at stCop, h=h0[,i,], log=T)
+# cat(i,", ", sep="")
+# u1 <- cbind(u1, dduCopula(u0[,c(1,i+1)], copula at stCop, h=h0[,i,]))
+# }
+# u0 <- u1
+# cat("]\n")
+#
+# cat("[Estimating a",ncol(u0),"dimensional copula at the top.]\n")
+# vineCopFit <- fitCopula(copula at topCop, u0, method, estimate.variance)
+#
+# stVineCop <- stVineCopula(copula at stCop, vineCopFit at copula)
+# loglik <- vineCopFit at loglik
+#
+# return(new("fitCopula", estimate = stVineCop at parameters, var.est = matrix(NA),
+# method = method,
+# loglik = sum(l0)+loglik,
+# fitting.stats=list(convergence = as.integer(NA)),
+# nsample = nrow(data at data), copula=stVineCop))
+# }
+
+# setMethod("fitCopula",signature=signature("stVineCopula"),fitStVine)
+
+# conditional spatio-temporal covariate vine
+condStCoVarVine <- function (condVar, dists, stCVVC, stInd, n = 1000) {
+ stopifnot(is.array(dists))
+
+ coVarCop <- stCVVC at coVarCop(stInd)
+ stBiCop <- stCVVC at stCop
+ topCop <- stCVVC at topCop
+
+ # add some points in the tails
+ rat <- 50: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)
+ nbs <- dim(dists)[2]
+
+ repCondVar <- matrix(condVar, ncol = length(condVar), nrow = nx, byrow = T)
+ dCoVar <- dCopula(cbind(xVals, repCondVar[,1]), coVarCop)
+ condCoVar <- dduCopula(cbind(xVals, repCondVar[,1]), coVarCop)
+
+ u0 <- cbind(xVals,repCondVar[,-1]) # previous level's (conditional) data
+ condData <- matrix(NA, nx, nbs) # current level of conditional data
+ dStBiC <- 1 # current likelihood
+
+ for(i in 1:nbs) { # i <- 1
+ condData[,i] <- dduCopula(u0[,c(1,i+1)], stBiCop, h=matrix(dists[,i,],1))
+ dStBiC <- dStBiC*dCopula(u0[,c(1,i+1)], stBiCop, h=matrix(dists[,i,],1))
+ }
+
+ dTopVi <- dCopula(cbind(condCoVar,condData), topCop)
+
+ density <- dCoVar*dStBiC*dTopVi
+ # the 1-e6 corners linearily to [0,1], but ensure 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)]))
+ condVineFun <- function(u) linAppr(u)/int
+ attr(condVineFun,"xVals") <- c(0,xVals,1)
+ return(condVineFun)
+}
+
+## interpolation ##
+###################
+#
+# stCopPredict.expectation <- function(predNeigh, stVine, margin, ..., stop.on.error=F) {
+# stopifnot(is.function(margin$q))
+# dists <- predNeigh at distances
+#
+# predMean <- NULL
+# for(i in 1:nrow(predNeigh at data)) { # i <-1
+# cat("[Predicting location ",i,".]\n", sep="")
+# condSecVine <- condStVine(as.numeric(predNeigh at data[i,]), dists[i,], stVine)
+#
+# condExp <- function(x) {
+# margin$q(x)*condSecVine(x)
+# }
+#
+# ePred <- integrate(condExp,0,1,subdivisions=10000L,stop.on.error=stop.on.error, ...)
+# if(ePred$abs.error > 0.01)
+# warning("Numerical integration in predExpectation performed at a level of absolute error of only ",
+# ePred$abs.error, " for location ",i,".")
+# predMean <- c(predMean, ePred$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))
+# }
+# }
+#
+# stCopPredict.quantile <- function(predNeigh, stVine, margin, p=0.5) {
+# stopifnot(is.function(margin$q))
+# dists <- predNeigh at distances
+#
+# predQuantile <- NULL
+# for(i in 1:nrow(predNeigh at data)) { # i <-1
+# cat("[Predicting location ",i,".]\n", sep="")
+# condSecVine <- condStVine(as.numeric(predNeigh at data[i,]), dists[i,,,drop=F], stVine)
+#
+# xVals <- attr(condSecVine,"xVals")
+# density <- condSecVine(xVals)
+# nx <- length(xVals)
+# int <- cumsum(c(0,diff(xVals)*(0.5*diff(density)+density[-nx])))
+# lower <- max(which(int <= p))
+# m <- (density[lower+1]-density[lower])/(xVals[lower+1]-xVals[lower])
+# b <- density[lower]
+# xRes <- -b/m+sign(m)*sqrt(b^2/m^2+2*(p-int[lower])/m)
+#
+# predQuantile <- c(predQuantile, margin$q(xVals[lower]+xRes))
+# }
+#
+# 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))
+# }
+# }
+#
+# stCopPredict <- function(predNeigh, stVine, margin, method="quantile", p=0.5, ...) {
+# switch(method,
+# quantile=stCopPredict.quantile(predNeigh, stVine, margin, p),
+# expectation=stCopPredict.expectation(predNeigh, stVine, margin, ...))
+# }
+#
+# dropStTree <- function(neigh, stCop) {
+# stopifnot(class(neigh)=="stNeighbourhood")
+#
+# u0 <- as.matrix(neigh at data) # previous level's (conditional) data
+# h0 <- neigh at distances # previous level's distances
+# u1 <- NULL # current level of conditional data
+# h1s <- NULL # upcoming distances
+# h1t <- NULL # upcoming distances
+# cat("[Margin ")
+# for(i in 1:dim(h0)[2]) { # i <- 1
+# cat(i,", ")
+# u1 <- cbind(u1, dduCopula(u0[,c(1,i+1)], stCop, h=h0[,i,]))
+# if (i < ncol(neigh at distances)) {
+# h1s <- cbind(h1s, apply(neigh at index[, c(1, i + 1),1], 1,
+# function(x) spDists(neigh at locations@sp[x, ])[1, 2]))
+# h1t <- cbind(h1t, apply(neigh at index[, c(1, i + 1),2], 1,
+# function(x) diff(x)))
+# }
+# }
+# h1 <- array(dim=c(dim(h1s),2))
+# h1[,,1] <- h1s
+# h1[,,2] <- h1t
+#
+# varSplit <- strsplit(neigh at var, "|", fixed = TRUE)[[1]]
+# cond <- suppressWarnings(as.numeric(varSplit[length(varSplit)]))
+# if (is.na(cond))
+# cond <- paste(neigh at var, "|0", sep = "")
+# else cond <- paste(neigh at var, cond + 1, sep = "")
+# return(stNeighbourhood(data=u1, distances=h1, STxDF=neigh at locations,
+# ST=neigh at dataLocs, index=neigh at index[, -1,],
+# prediction=neigh at prediction, var=cond))
+# }
\ No newline at end of file
Added: pkg/man/condStCoVarVine.Rd
===================================================================
--- pkg/man/condStCoVarVine.Rd (rev 0)
+++ pkg/man/condStCoVarVine.Rd 2014-02-12 14:54:12 UTC (rev 122)
@@ -0,0 +1,72 @@
+\name{condStCoVarVine}
+\alias{condStCoVarVine}
+
+\title{
+conditional distribution function of spatio-temporal covariate vine copula
+}
+\description{
+Returns a conditional distribution function of spatio-temporal covariate vine copula
+}
+\usage{
+condStCoVarVine(condVar, dists, stCVVC, stInd, n = 1000)
+}
+
+\arguments{
+ \item{condVar}{
+the conditioning variables
+}
+ \item{dists}{
+spatio-temporal distances to the conditioning variables
+}
+ \item{stCVVC}{
+the spatio-temporal covariate vine copula of the model
+}
+ \item{stInd}{
+spatio-temporal index pair to be used with covariate copula (which is in first place a function taking a pair of indices and returns a copula object)
+}
+ \item{n}{
+number of approximation points
+}
+}
+\value{
+a univariate distribution function over [0,1]
+}
+\author{
+Benedikt Graeler
+}
+\note{
+The distribution is linearly approximated at a limited number (\code{n}) of points.
+}
+
+\seealso{
+\code{\link{condStVine}}, \code{\link{condSpVine}}
+}
+
+\examples{
+spCopT0 <- spCopula(components=list(claytonCopula(8), claytonCopula(4),
+ claytonCopula(2), claytonCopula(1),
+ claytonCopula(0.5), indepCopula()),
+ distances=c(100,200,300,400,500,600),
+ unit="km")
+spCopT1 <- spCopula(components=list(claytonCopula(4), claytonCopula(2),
+ claytonCopula(1), claytonCopula(0.5),
+ indepCopula()),
+ distances=c(100,200,300,400,500),
+ unit="km")
+spCopT2 <- spCopula(components=list(claytonCopula(2), claytonCopula(1),
+ claytonCopula(0.5), indepCopula()),
+ distances=c(100,200,300,400),
+ unit="km")
+
+stCop <- stCopula(components=list(spCopT0, spCopT1, spCopT2),
+ t.lags=-(0:2))
+
+# only a constant copula ius used for the covariate
+stCVVC <- stCoVarVineCopula(function(x) gumbelCopula(2), stCop, vineCopula(9L))
+
+dists <- array(c(150, 250, 150, 250,0,0,-1,-1),dim=c(1,4,2))
+condVar <- c(0.15, 0.29, 0.55, 0.05, 0.41)
+
+condDensity <- condStCoVarVine(condVar, dists, stCVVC, c(1,1))
+curve(condDensity)
+}
\ No newline at end of file
Modified: pkg/man/dropSpTree.Rd
===================================================================
--- pkg/man/dropSpTree.Rd 2014-02-07 15:21:34 UTC (rev 121)
+++ pkg/man/dropSpTree.Rd 2014-02-12 14:54:12 UTC (rev 122)
@@ -19,7 +19,7 @@
}
\value{
-A conditioned \code{\linkS4class{neighbourhood}} of dimesnion 1 less.
+A conditioned \code{\linkS4class{neighbourhood}} of dimension 1 less.
}
\author{
Added: pkg/man/dropStTree.Rd
===================================================================
--- pkg/man/dropStTree.Rd (rev 0)
+++ pkg/man/dropStTree.Rd 2014-02-12 14:54:12 UTC (rev 122)
@@ -0,0 +1,33 @@
+\name{dropStTree}
+\alias{dropStTree}
+
+\title{
+Drops a spatio-temporal tree
+}
+\description{
+A spatio-temporal tree is dropped in order to fit the following copula.
+}
+\usage{dropStTree(neigh, stCop)}
+
+\arguments{
+ \item{neigh}{
+the current spatio-temporal \code{\linkS4class{stNeighbourhood}}
+}
+ \item{stCop}{
+the current spatio-temporal copula performing the conditioning
+}
+}
+
+\value{
+A conditioned spatio-temporal \code{\linkS4class{stNeighbourhood}} of dimension 1 less.
+}
+
+\author{
+Benedikt Graeler
+}
+
+\seealso{
+\code{\linkS4class{stNeighbourhood}}
+}
+
+\keyword{ spatio-temporal }
\ No newline at end of file
Modified: pkg/man/fitSpCopula.Rd
===================================================================
--- pkg/man/fitSpCopula.Rd 2014-02-07 15:21:34 UTC (rev 121)
+++ pkg/man/fitSpCopula.Rd 2014-02-12 14:54:12 UTC (rev 122)
@@ -8,8 +8,8 @@
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)), ...)
+fitSpCopula(bins, cutoff = NA, families = c(normalCopula(), tCopula(),
+ claytonCopula(), frankCopula(), gumbelCopula()), ...)
}
\arguments{
\item{bins}{
@@ -43,9 +43,7 @@
}
\examples{
data(spCopDemo)
-fitSpCopula(bins=bins,cutoff=600,families=c(normalCopula(0), tCopula(0,dispstr = "un"),
- claytonCopula(0), frankCopula(1),
- gumbelCopula(1), joeBiCopula(1.5)))
+fitSpCopula(bins, 600)
}
\keyword{ spatial }
\keyword{ multivariate }% __ONLY ONE__ keyword per line
Modified: pkg/man/getStNeighbours.Rd
===================================================================
--- pkg/man/getStNeighbours.Rd 2014-02-07 15:21:34 UTC (rev 121)
+++ pkg/man/getStNeighbours.Rd 2014-02-12 14:54:12 UTC (rev 122)
@@ -25,7 +25,7 @@
The spatial size of the neighbourhood including the location of interest (for fitting as well for prediction).
}
\item{t.lags}{The temporal lags to be used in the spatio-temporal neighbourhood.}
-\item{timeSteps}{The number of tiem instances that should randomly be selected from \code{stData}. The defualt, \code{NA}, selects all locations.}
+\item{timeSteps}{The number of time instances that should randomly be selected from \code{stData}. The default, \code{NA}, selects all locations.}
\item{prediction}{whether the neighbourhood should be used for prediction (TRUE) or spatial/Spatio-temporal vine copula fitting.}
\item{min.dist}{
the minimal distance for a location to be included. Must be larger than 0 for fitting purposes and might be 0 for prediction.
Added: pkg/man/reduceNeighbours.Rd
===================================================================
--- pkg/man/reduceNeighbours.Rd (rev 0)
+++ pkg/man/reduceNeighbours.Rd 2014-02-12 14:54:12 UTC (rev 122)
@@ -0,0 +1,49 @@
+\name{reduceNeighbours}
+\alias{reduceNeighbours}
+
+\title{
+Selecting the strongest correlated neighbours
+}
+\description{
+A function selecting the strongest correlated neighbours from a larger set of neighbours
+}
+\usage{
+reduceNeighbours(stNeigh, stDepFun, n)
+}
+
+\arguments{
+ \item{stNeigh}{
+the proxy neighbourhood to be investigated
+}
+ \item{stDepFun}{
+a spatio-temporal dependence function that return correlation estimates based on a spatial and temporal distance
+}
+ \item{n}{
+the number of neighbours to be selected.
+}
+}
+\value{A spatio-temporal neighbourhood \code{\linkS4class{stNeighbourhood}} with fewer neighbours.}
+
+\author{
+Benedikt Graeler
+}
+
+
+\seealso{
+\code{\link{getStNeighbours}}
+}
+
+\examples{
+library(sp)
+library(spacetime)
+
+sp <- SpatialPoints(matrix(c(181000,181100,333500,333600),2))
+time <- Sys.time()+60*60*24*c(0,1,2,3,4)
+data <- data.frame(var1=runif(10))
+
+stData <- STFDF(sp, time, data)
+
+stNeigh <- getStNeighbours(stData, spSize=2, t.lags=-(0:2))
+
+reduceNeighbours(stNeigh, function(h,delta) return(1/h/delta), 2)
+}
\ No newline at end of file
Added: pkg/man/stCoVarVineCopula-class.Rd
===================================================================
--- pkg/man/stCoVarVineCopula-class.Rd (rev 0)
+++ pkg/man/stCoVarVineCopula-class.Rd 2014-02-12 14:54:12 UTC (rev 122)
@@ -0,0 +1,41 @@
+\name{stCoVarVineCopula-class}
+\Rdversion{1.1}
+\docType{class}
+\alias{stCoVarVineCopula-class}
+
+\title{Class \code{"stCoVarVineCopula"}}
+\description{
+A S4-class representing a spatio-temporal covariate vine copula
+}
+\section{Objects from the Class}{
+Objects can be created by calls of the form \code{new("stCoVarVineCopula", ...)} or by calls to the constructor \code{\link{stCoVarVineCopula}}.
+}
+\section{Slots}{
+ \describe{
+ \item{\code{coVarCop}:}{Object of class \code{"function"} returning a bivariate copula object for absolute pairs of spatio-temporal indices.}
+ \item{\code{stCop}:}{Object of class \code{"stCopula"} modelling the spatio-temporal dependence on the first tree.}
+ \item{\code{topCop}:}{Object of class \code{"copula"} joining the spatio-temporal tree with its additional covariate copula to a full vine copula.}
+ \item{\code{dimension}:}{Object of class \code{"integer"} denoting the dimension of the overall copula. }
+ \item{\code{parameters}:}{Object of class \code{"numeric"}, not used.}
+ \item{\code{param.names}:}{Object of class \code{"character"}, not used.}
+ \item{\code{param.lowbnd}:}{Object of class \code{"numeric"}, not used.}
+ \item{\code{param.upbnd}:}{Object of class \code{"numeric"}, not used.}
+ \item{\code{fullname}:}{Object of class \code{"character"} providing a textual short description of this class.}
+ }
+}
+\section{Extends}{
+Class \code{"\linkS4class{copula}"}, directly.
+Class \code{"\linkS4class{Copula}"}, by class "copula", distance 2.
+}
+\section{Methods}{
+No methods defined with class "stCoVarVineCopula" in the signature.
+}
+\author{
+Benedikt Graeler
+}
+
+\seealso{\code{\linkS4class{stVineCopula}}}
+\examples{
+showClass("stCoVarVineCopula")
+}
+\keyword{classes}
Added: pkg/man/stCoVarVineCopula.Rd
===================================================================
--- pkg/man/stCoVarVineCopula.Rd (rev 0)
+++ pkg/man/stCoVarVineCopula.Rd 2014-02-12 14:54:12 UTC (rev 122)
@@ -0,0 +1,65 @@
+\name{stCoVarVineCopula}
+\alias{stCoVarVineCopula}
+
+\title{
+Constructor for \code{\linkS4class{stCoVarVineCopula}}
+}
+\description{
+This function provides a more comfortable way of defining a \code{\linkS4class{stCoVarVineCopula}}.
+}
+\usage{
+stCoVarVineCopula(coVarCop, stCop, topCop)
+}
+
+\arguments{
+ \item{coVarCop}{
+A function returning a returning a bivariate copula object for absolute pairs of spatio-temporal indices
+}
+ \item{stCop}{
+Object of class \code{"stCopula"} modelling the spatio-temporal dependence on the first tree
+}
+ \item{topCop}{
+Object of class \code{"copula"} joining the spatio-temporal tree with its additional covariate copula to a full vine copula.
+}
+}
+\details{
+For a spatio-temporal random field Z with covariate Y a c-vine is assumed with data sorted as (z_0, y_0, z_1, .., z_n).
+}
+
+\value{An object of class \code{\linkS4class{stCoVarVineCopula}}.}
+
+\author{
+Benedikt Graeler
+}
+
+\seealso{
+\code{\link{stVineCopula}}, \code{\linkS4class{stCoVarVineCopula}}
+}
+
+\examples{
+# a spatio-temporal C-vine copula (with independent copulas in the upper vine)
+spCopT0 <- spCopula(components=list(claytonCopula(8), claytonCopula(4),
+ claytonCopula(2), claytonCopula(1),
+ claytonCopula(0.5), indepCopula()),
+ distances=c(100,200,300,400,500,600),
+ unit="km")
+spCopT1 <- spCopula(components=list(claytonCopula(4), claytonCopula(2),
+ claytonCopula(1), claytonCopula(0.5),
+ indepCopula()),
+ distances=c(100,200,300,400,500),
+ unit="km")
+spCopT2 <- spCopula(components=list(claytonCopula(2), claytonCopula(1),
+ claytonCopula(0.5), indepCopula()),
+ distances=c(100,200,300,400),
+ unit="km")
+
+stCop <- stCopula(components=list(spCopT0, spCopT1, spCopT2),
+ t.lags=-(0:2))
+
+# only a constant copula ius used for the covariate
+stCoVarVineCopula(function(x) gumbelCopula(2), stCop, vineCopula(9L))
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
Modified: pkg/man/stVineCopula.Rd
===================================================================
--- pkg/man/stVineCopula.Rd 2014-02-07 15:21:34 UTC (rev 121)
+++ pkg/man/stVineCopula.Rd 2014-02-12 14:54:12 UTC (rev 122)
@@ -21,7 +21,6 @@
}
\examples{
# a spatio-temporal C-vine copula (with independent copulas in the upper vine)
-
spCopT0 <- spCopula(components=list(claytonCopula(8), claytonCopula(4),
claytonCopula(2), claytonCopula(1),
claytonCopula(0.5), indepCopula()),
@@ -40,7 +39,6 @@
stCop <- stCopula(components=list(spCopT0, spCopT1, spCopT2),
t.lags=-(0:2))
-library(VineCopula)
stVineCopula(stCop, vineCopula(9L))
}
\keyword{ mulitvariate }
More information about the spcopula-commits
mailing list