[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