[spcopula-commits] r88 - / pkg/R pkg/data pkg/demo pkg/man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Mar 5 14:22:41 CET 2013
Author: ben_graeler
Date: 2013-03-05 14:22:41 +0100 (Tue, 05 Mar 2013)
New Revision: 88
Modified:
pkg/R/leafCopula.R
pkg/R/spVineCopula.R
pkg/data/spCopDemo.RData
pkg/demo/spCopula_estimation.R
pkg/man/loglikByCopulasLags.Rd
pkg/man/spCopula-class.Rd
pkg/man/spCopula.Rd
pkg/man/spVineCopula-class.Rd
pkg/man/spVineCopula.Rd
pkg/man/vineCopula-class.Rd
spcopula_0.1-1.tar.gz
spcopula_0.1-1.zip
Log:
- cleaned data files
- adjusted examples
Modified: pkg/R/leafCopula.R
===================================================================
--- pkg/R/leafCopula.R 2013-02-20 11:22:13 UTC (rev 87)
+++ pkg/R/leafCopula.R 2013-03-05 13:22:41 UTC (rev 88)
@@ -6,6 +6,8 @@
return(val)
}
+# param <- c(1.446923, -1.722742)
+
# weak lower border, two-place parameter
weakBorderPoly <- function(x, par) {
par[1]*x^3+par[2]*x^2+x
@@ -50,12 +52,11 @@
# precalculate ellipse parameters
solveQ <- function(u) {
- sqrt(0.5*(strongBorderPoly(u)-u)^2)
+ sqrt(0.5)*(strongBorderPoly(u)-u)
}
ddxsolveQ <- function(u) {
- sBor <- strongBorderPoly(u)
- 1/(2*sqrt(0.5*(sBor-u)^2))*(sBor-u)*(ddxstrongBorderPoly(u)-1)
+ sqrt(0.5)*(ddxstrongBorderPoly(u)-1)
}
# ## double check
@@ -68,7 +69,7 @@
# ##
solveXb <- function(u, par) {
- sqrt(2*(u-weakBorderPoly(u, par))^2)+solveQ(u)
+ sqrt(2)*(u-weakBorderPoly(u, par))+solveQ(u)
}
ddxsolveXb <- function(u, par) {
@@ -99,7 +100,7 @@
solveA <- function(u, par) {
xb <- solveXb(u, par)
q <- solveQ(u)
- sqrt((-xb^3+2*q*xb^2-q^2*xb)/(-2*xb+2*q+xb))
+ sqrt(xb^2 - q^2*xb/(2*q-xb))
}
ddusolveA <- function(u, par) {
@@ -122,7 +123,7 @@
solveB <- function(u, par) {
a <- solveA(u, par)
xb <- solveXb(u, par)
- a^2*sqrt(1-(xb/a)^2)/xb
+ a*sqrt(a^2-xb^2)/xb
}
ddusolveB <- function(u, par) {
Modified: pkg/R/spVineCopula.R
===================================================================
--- pkg/R/spVineCopula.R 2013-02-20 11:22:13 UTC (rev 87)
+++ pkg/R/spVineCopula.R 2013-03-05 13:22:41 UTC (rev 88)
@@ -62,7 +62,7 @@
vineCop <- fitCopula(copula at vineCop, secLevel)
- return(spVineCopula(spCop, vineCop))
+ return(spVineCopula(copula at spCop, vineCop))
}
setMethod("fitCopula",signature=signature("spVineCopula"),fitSpVine)
\ No newline at end of file
Modified: pkg/data/spCopDemo.RData
===================================================================
(Binary files differ)
Modified: pkg/demo/spCopula_estimation.R
===================================================================
--- pkg/demo/spCopula_estimation.R 2013-02-20 11:22:13 UTC (rev 87)
+++ pkg/demo/spCopula_estimation.R 2013-03-05 13:22:41 UTC (rev 88)
@@ -2,24 +2,23 @@
library(spcopula)
library(evd)
-## dataset - spatial poionts data.frame ##
+## meuse - spatial poionts data.frame ##
data(meuse)
coordinates(meuse) = ~x+y
-dataSet <- meuse
spplot(meuse,"zinc", col.regions=bpy.colors(5))
## margins ##
-hist(dataSet[["zinc"]],freq=F,n=30,ylim=c(0,0.0035),
+hist(meuse[["zinc"]],freq=F,n=30,ylim=c(0,0.0035),
main="Histogram of zinc", xlab="zinc concentration")
-gevEsti <- fgev(dataSet[["zinc"]])$estimate
-meanLog <- mean(log(dataSet[["zinc"]]))
-sdLog <- sd(log(dataSet[["zinc"]]))
+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(dataSet[["zinc"]],pgev,gevEsti[1], gevEsti[2], gevEsti[3]) # p: 0.07
-ks.test(dataSet[["zinc"]],plnorm,meanLog,sdLog) # p: 0.03
+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)
@@ -30,7 +29,7 @@
# dMar <- function(x) dgev(x, gevEsti[1], gevEsti[2], gevEsti[3])
## lag classes ##
-bins <- calcBins(dataSet,var="zinc",nbins=10,cutoff=800)
+bins <- calcBins(meuse,var="zinc",nbins=10,cutoff=800)
# transform data to the unit interval
bins$lagData <- lapply(bins$lagData, rankTransform)
@@ -82,7 +81,7 @@
##
# spatial vine
vineDim <- 5L
-meuseNeigh <- getNeighbours(dataSet,"zinc",vineDim)
+meuseNeigh <- getNeighbours(meuse,"zinc",vineDim)
meuseNeigh at data <- rankTransform(meuseNeigh at data)
meuseSpVine <- fitCopula(spVineCopula(spCop, vineCopula(as.integer(vineDim-1))),
@@ -124,22 +123,22 @@
}
proc.time()-time
-mean(abs(predMean-dataSet$zinc))
-mean(predMean-dataSet$zinc)
-sqrt(mean((predMean-dataSet$zinc)^2))
+mean(abs(predMean-meuse$zinc))
+mean(predMean-meuse$zinc)
+sqrt(mean((predMean-meuse$zinc)^2))
-mean(abs(predMedian-dataSet$zinc))
-mean(predMedian-dataSet$zinc)
-sqrt(mean((predMedian-dataSet$zinc)^2))
+mean(abs(predMedian-meuse$zinc))
+mean(predMedian-meuse$zinc)
+sqrt(mean((predMedian-meuse$zinc)^2))
-plot(predMean,dataSet$zinc)
+plot(predMean,meuse$zinc)
abline(0,1)
-plot(predMedian,dataSet$zinc)
+plot(predMedian,meuse$zinc)
abline(0,1)
## kriging results:
-# same neighbourhood size:
+# same neighbourhood size 5L:
# MAE: 158.61
# BIAS: -4.24
# RMSE: 239.85
Modified: pkg/man/loglikByCopulasLags.Rd
===================================================================
--- pkg/man/loglikByCopulasLags.Rd 2013-02-20 11:22:13 UTC (rev 87)
+++ pkg/man/loglikByCopulasLags.Rd 2013-03-05 13:22:41 UTC (rev 88)
@@ -35,6 +35,8 @@
\examples{
data(spCopDemo) # load the workspace from demo(spcopula_estimation)
+calcKTauPol <- fitCorFun(bins, degree=3)
+
loglikTau <- loglikByCopulasLags(bins, calcKTauPol)
loglikTau
}
Modified: pkg/man/spCopula-class.Rd
===================================================================
--- pkg/man/spCopula-class.Rd 2013-02-20 11:22:13 UTC (rev 87)
+++ pkg/man/spCopula-class.Rd 2013-03-05 13:22:41 UTC (rev 88)
@@ -50,12 +50,15 @@
# data from demo(spcopula_estimation)
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")
+
dCopula(u=matrix(c(.3,.3,.7,.7),ncol=2),spCop,h=c(200,400))
pCopula(u=matrix(c(.3,.3,.7,.7),ncol=2),spCop,h=c(200,400))
}
Modified: pkg/man/spCopula.Rd
===================================================================
--- pkg/man/spCopula.Rd 2013-02-20 11:22:13 UTC (rev 87)
+++ pkg/man/spCopula.Rd 2013-03-05 13:22:41 UTC (rev 88)
@@ -40,6 +40,8 @@
\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),
Modified: pkg/man/spVineCopula-class.Rd
===================================================================
--- pkg/man/spVineCopula-class.Rd 2013-02-20 11:22:13 UTC (rev 87)
+++ pkg/man/spVineCopula-class.Rd 2013-03-05 13:22:41 UTC (rev 88)
@@ -2,6 +2,7 @@
\Rdversion{1.1}
\docType{class}
\alias{spVineCopula-class}
+\alias{fitCopula,spVineCopula-method}
\title{Class \code{"spVineCopula"}}
\description{
Modified: pkg/man/spVineCopula.Rd
===================================================================
--- pkg/man/spVineCopula.Rd 2013-02-20 11:22:13 UTC (rev 87)
+++ pkg/man/spVineCopula.Rd 2013-03-05 13:22:41 UTC (rev 88)
@@ -25,6 +25,9 @@
\examples{
# a spatial C-vine copula (with independent dummy copulas in the upper vine)
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),
Modified: pkg/man/vineCopula-class.Rd
===================================================================
--- pkg/man/vineCopula-class.Rd 2013-02-20 11:22:13 UTC (rev 87)
+++ pkg/man/vineCopula-class.Rd 2013-03-05 13:22:41 UTC (rev 88)
@@ -2,6 +2,7 @@
\Rdversion{1.1}
\docType{class}
\alias{vineCopula-class}
+\alias{fitCopula,vineCopula-method}
\title{Class \code{"vineCopula"}}
\description{
Modified: spcopula_0.1-1.tar.gz
===================================================================
(Binary files differ)
Modified: spcopula_0.1-1.zip
===================================================================
(Binary files differ)
More information about the spcopula-commits
mailing list