[spcopula-commits] r158 - in pkg: . R demo man tests tests/Examples

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Mon Sep 12 16:07:37 CEST 2016


Author: ben_graeler
Date: 2016-09-12 16:07:37 +0200 (Mon, 12 Sep 2016)
New Revision: 158

Modified:
   pkg/DESCRIPTION
   pkg/NAMESPACE
   pkg/R/Classes.R
   pkg/R/cqsCopula.R
   pkg/R/empiricalCopula.R
   pkg/R/partialDerivatives.R
   pkg/R/spVineCopula.R
   pkg/demo/spCopula.R
   pkg/man/tawn3pCopula-class.Rd
   pkg/tests/Examples/spcopula-Ex.Rout.save
   pkg/tests/spCopulaTest.Rout.save
   pkg/tests/stCopulaTest.Rout.save
Log:
adds documentation for mixtureCopula; fixes error induced by copula:::isFree

Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION	2016-09-01 18:17:13 UTC (rev 157)
+++ pkg/DESCRIPTION	2016-09-12 14:07:37 UTC (rev 158)
@@ -2,7 +2,7 @@
 Type: Package
 Title: Copula Driven Spatio-Temporal Analysis
 Version: 0.2-1
-Date: 2016-09-01
+Date: 2016-09-12
 Authors at R: c(person("Benedikt", "Graeler", role = c("aut", "cre"),
                     email = "ben.graeler at uni-muenster.de"),
              person("Marius", "Appel",role = "ctb"))
@@ -10,8 +10,8 @@
 Description: We provide a framework to analyse spatial and spatio-temporal data via copulas and vine copulas. The data needs to be provided in the form of the sp and spacetime package respectively. Additionally, support for calculating different multivariate return periods based on copulas and vine copulas is implemented.
 License: GPL-3
 LazyLoad: yes
-Depends: copula (>= 0.999-15), R (>= 3.1.0)
-Imports: methods, sp, spacetime (>= 1.0-9), VineCopula (>= 1.4)
+Depends: copula (>= 0.999-15), R (>= 3.1.0), VineCopula (>= 2.0.4)
+Imports: methods, sp, spacetime (>= 1.0-9)
 Suggests: evd
 URL: http://r-forge.r-project.org/projects/spcopula/
 Collate:

Modified: pkg/NAMESPACE
===================================================================
--- pkg/NAMESPACE	2016-09-01 18:17:13 UTC (rev 157)
+++ pkg/NAMESPACE	2016-09-12 14:07:37 UTC (rev 158)
@@ -1,4 +1,5 @@
 import(copula)
+import(VineCopula)
 import(sp, spacetime)
 import(methods)
 
@@ -6,7 +7,7 @@
   importFrom("stats", "D", "approxfun", "cor", "ecdf", "integrate", "lm",
              "optim", "optimise", "optimize", "pnorm", "predict", "pt",
              "qnorm", "qt", "quantile", "runif", "uniroot", "var")
-  importFrom("utils", "setTxtProgressBar", "txtProgressBar")
+  importFrom("utils", "setTxtProgressBar", "txtProgressBar", "tail")
 
 importMethodsFrom(VineCopula, fitCopula)
 importMethodsFrom(VineCopula, dduCopula,ddvCopula)
@@ -44,6 +45,7 @@
 export(stCoVarVineCopula)
 export(neighbourhood, stNeighbourhood)
 export(empiricalCopula, genEmpCop)
+export(mixtureCopula)
 
 # general functions
 export(rankTransform, dependencePlot, unitScatter, univScatter)
@@ -79,4 +81,5 @@
 ## classes
 exportClasses(asCopula, cqsCopula, tawn3pCopula, neighbourhood, stNeighbourhood, empiricalCopula)
 exportClasses(spCopula, stCopula, spVineCopula, stVineCopula)
-exportClasses(stCoVarVineCopula)
\ No newline at end of file
+exportClasses(stCoVarVineCopula)
+exportClasses(mixtureCopula)
\ No newline at end of file

Modified: pkg/R/Classes.R
===================================================================
--- pkg/R/Classes.R	2016-09-01 18:17:13 UTC (rev 157)
+++ pkg/R/Classes.R	2016-09-12 14:07:37 UTC (rev 158)
@@ -173,31 +173,6 @@
                                                      tres="character"),
          validity = validStCopula, contains = list("copula"))
 
-###############################################
-##  vine copulas, happens now in VineCopula  ##
-###############################################
-
-# validVineCopula = function(object) {
-#   dim <- object at dimension
-#   if( dim <= 2)
-#     return("Number of dimension too small (>2).")
-#   if(length(object at copulas)!=(dim*(dim-1)/2))
-#     return("Number of provided copulas does not match given dimension.")
-#   if(!any(unlist(lapply(object at copulas,function(x) is(x,"copula")))))
-#     return("Not all provided copulas in your list are indeed copulas.")
-#   return (TRUE)
-# }
-# 
-# setOldClass("RVineMatrix")
-# 
-# setClass("vineCopula",
-#          representation = representation(copulas="list", dimension="integer", 
-#                                          RVM="RVineMatrix"),
-#          prototype = prototype(RVM=structure(list(),class="RVineMatrix")),
-#          validity = validVineCopula,
-#          contains = list("copula")
-# )
-
 #########################
 ## Spatial Vine Copula ##
 #########################

Modified: pkg/R/cqsCopula.R
===================================================================
--- pkg/R/cqsCopula.R	2016-09-01 18:17:13 UTC (rev 157)
+++ pkg/R/cqsCopula.R	2016-09-12 14:07:37 UTC (rev 158)
@@ -1,6 +1,3 @@
-## make fitCopula generic
-setGeneric("fitCopula",fitCopula)
-
 ######################################################
 ##                                                  ##
 ## a symmetric copula with cubic quadratic sections ##

Modified: pkg/R/empiricalCopula.R
===================================================================
--- pkg/R/empiricalCopula.R	2016-09-01 18:17:13 UTC (rev 157)
+++ pkg/R/empiricalCopula.R	2016-09-12 14:07:37 UTC (rev 158)
@@ -35,7 +35,7 @@
 ## jcdf ##
 # from package copula
 pempCop.C <- function(u, copula) {
-    return(Cn(copula at sample,u))
+  F.n(u, copula at sample)
 }
 
 setMethod("pCopula", signature("numeric", "empiricalCopula"),

Modified: pkg/R/partialDerivatives.R
===================================================================
--- pkg/R/partialDerivatives.R	2016-09-01 18:17:13 UTC (rev 157)
+++ pkg/R/partialDerivatives.R	2016-09-12 14:07:37 UTC (rev 158)
@@ -1,9 +1,3 @@
-# partial derivatives and their inverse of some copulas from the copula package
-# new defined copulas store their partial derivative separately
-# 
-# setGeneric("dduCopula", function(u, copula, ...) standardGeneric("dduCopula"))
-# setGeneric("ddvCopula", function(u, copula, ...) standardGeneric("ddvCopula"))
-
 ## inverse partial derivatives 
 # numerical standard function
 invdduCopula <- function(u, copula, y, ..., tol=.Machine$double.eps^0.5) {

Modified: pkg/R/spVineCopula.R
===================================================================
--- pkg/R/spVineCopula.R	2016-09-01 18:17:13 UTC (rev 157)
+++ pkg/R/spVineCopula.R	2016-09-12 14:07:37 UTC (rev 158)
@@ -87,7 +87,8 @@
           })
 
 # fitting the spatial vine for a given list of spatial copulas
-fitSpVine <- function(copula, data, method, estimate.variance=FALSE) {
+fitSpVine <- function(copula, data, method="ml", estimate.variance=FALSE) {
+  cat("fitSpVine \n")
   stopifnot(is.list(data))
   stopifnot(length(data)==2)
   neigh <- data[[1]]

Modified: pkg/demo/spCopula.R
===================================================================
--- pkg/demo/spCopula.R	2016-09-01 18:17:13 UTC (rev 157)
+++ pkg/demo/spCopula.R	2016-09-12 14:07:37 UTC (rev 158)
@@ -1,7 +1,5 @@
 ## librarys ##
-library("spcopula")
 library("sp")
-# library("evd")
 
 ## meuse - spatial poionts data.frame ##
 data("meuse")
@@ -83,9 +81,11 @@
 vineDim <- 5L
 meuseNeigh <- getNeighbours(meuse,var="marZinc",size=vineDim)
 
-meuseSpVine <- fitCopula(spVineCopula(spCop, vineCopula(as.integer(vineDim-1))),
-                         list(meuseNeigh, meuse))
+vineCop <- vineCopula(4L)
 
+meuseSpVine <- fitCopula(spVineCopula(spCop, vineCop),
+                         list(meuseNeigh, meuse), method="none")
+
 # log-likelihood:
 meuseSpVine at loglik
 

Modified: pkg/man/tawn3pCopula-class.Rd
===================================================================
--- pkg/man/tawn3pCopula-class.Rd	2016-09-01 18:17:13 UTC (rev 157)
+++ pkg/man/tawn3pCopula-class.Rd	2016-09-12 14:07:37 UTC (rev 158)
@@ -10,6 +10,8 @@
 \alias{pCopula,matrix,tawn3pCopula-method}
 \alias{pCopula,numeric,tawn3pCopula-method}
 \alias{rCopula,numeric,tawn3pCopula-method}
+\alias{dduCopula,ANY,tawn3pCopula-method}
+\alias{ddvCopula,ANY,tawn3pCopula-method}
 
 \title{Class \code{"tawn3pCopula"}}
 \description{

Modified: pkg/tests/Examples/spcopula-Ex.Rout.save
===================================================================
--- pkg/tests/Examples/spcopula-Ex.Rout.save	2016-09-01 18:17:13 UTC (rev 157)
+++ pkg/tests/Examples/spcopula-Ex.Rout.save	2016-09-12 14:07:37 UTC (rev 158)
@@ -1,806 +1,873 @@
-
-R version 3.2.2 (2015-08-14) -- "Fire Safety"
-Copyright (C) 2015 The R Foundation for Statistical Computing
-Platform: x86_64-pc-linux-gnu (64-bit)
-
-R is free software and comes with ABSOLUTELY NO WARRANTY.
-You are welcome to redistribute it under certain conditions.
-Type 'license()' or 'licence()' for distribution details.
-
-  Natural language support but running in an English locale
-
-R is a collaborative project with many contributors.
-Type 'contributors()' for more information and
-'citation()' on how to cite R or R packages in publications.
-
-Type 'demo()' for some demos, 'help()' for on-line help, or
-'help.start()' for an HTML browser interface to help.
-Type 'q()' to quit R.
-
-> pkgname <- "spcopula"
-> source(file.path(R.home("share"), "R", "examples-header.R"))
-> options(warn = 1)
-> library('spcopula')
-Loading required package: copula
-> 
-> base::assign(".oldSearch", base::search(), pos = 'CheckExEnv')
-> cleanEx()
-> nameEx("EU_RB")
-> ### * EU_RB
-> 
-> flush(stderr()); flush(stdout())
-> 
-> ### Name: EU_RB
-> ### Title: Daily mean PM10 concentrations over Europe in June and July 2005
-> ### Aliases: EU_RB
-> ### Keywords: datasets
-> 
-> ### ** Examples
-> 
-> data("EU_RB")
-> str(EU_RB)
-Formal class 'STFDF' [package "spacetime"] with 4 slots
-  ..@ data   :'data.frame':	11834 obs. of  2 variables:
-  .. ..$ PM10: num [1:11834] 14 9.7 7.8 21.9 11.2 9 11 6.1 7.4 7.4 ...
-  .. ..$ EMEP: num [1:11834] 11.62 5.02 3.94 3.82 7.01 ...
-  ..@ sp     :Formal class 'SpatialPointsDataFrame' [package "sp"] with 5 slots
-  .. .. ..@ data       :'data.frame':	194 obs. of  1 variable:
-  .. .. .. ..$ station_altitude: int [1:194] 525 581 918 560 172 117 665 1137 330 330 ...
-  .. .. ..@ coords.nrs : num(0) 
-  .. .. ..@ coords     : num [1:194, 1:2] 4592866 4761515 4658756 4690954 4799839 ...
-  .. .. .. ..- attr(*, "dimnames")=List of 2
-  .. .. .. .. ..$ : NULL
-  .. .. .. .. ..$ : chr [1:2] "coords.x1" "coords.x2"
-  .. .. ..@ bbox       : num [1:2, 1:2] 2749697 1647732 6412269 4604814
-  .. .. .. ..- attr(*, "dimnames")=List of 2
-  .. .. .. .. ..$ : chr [1:2] "coords.x1" "coords.x2"
-  .. .. .. .. ..$ : chr [1:2] "min" "max"
-  .. .. ..@ proj4string:Formal class 'CRS' [package "sp"] with 1 slot
-  .. .. .. .. ..@ projargs: chr " +proj=laea +lat_0=52 +lon_0=10 +x_0=4321000 +y_0=3210000 +ellps=GRS80 +units=m +no_defs"
-  ..@ time   :An ‘xts’ object on 2005-06-01/2005-07-31 containing:
-  Data: int [1:61, 1] 5266 5267 5268 5269 5270 5271 5272 5273 5274 5275 ...
- - attr(*, "dimnames")=List of 2
-  ..$ : NULL
-  ..$ : chr "..1"
-  Indexed by objects of class: [POSIXct,POSIXt] TZ: GMT
-  xts Attributes:  
- NULL
-  ..@ endTime: POSIXct[1:61], format: "2005-06-02 02:00:00" "2005-06-03 02:00:00" ...
-> 
-> 
-> 
-> cleanEx()
-> nameEx("EU_RB_2005")
-> ### * EU_RB_2005
-> 
-> flush(stderr()); flush(stdout())
-> 
-> ### Name: EU_RB_2005
-> ### Title: Daily mean PM10 concentrations over Europe in 2005 as used in
-> ###   the JSS manuscript
-> ### Aliases: EU_RB_2005
-> ### Keywords: datasets
-> 
-> ### ** Examples
-> 
-> data("EU_RB_2005")
-> str(EU_RB_2005)
-Formal class 'STFDF' [package "spacetime"] with 4 slots
-  ..@ data   :'data.frame':	70810 obs. of  3 variables:
-  .. ..$ PM10         : num [1:70810] 28 7 11.9 12.9 14.6 30 31.1 8.4 37.8 37.8 ...
-  .. ..$ EMEP         : num [1:70810] 6.36 4.13 5.84 4.93 5.86 ...
-  .. ..$ logResidKrige: num [1:70810] 12.8 12.4 10.6 11.6 17.1 ...
-  ..@ sp     :Formal class 'SpatialPointsDataFrame' [package "sp"] with 5 slots
-  .. .. ..@ data       :'data.frame':	194 obs. of  8 variables:
-  .. .. .. ..$ station_altitude     : int [1:194] 525 581 918 560 172 117 665 1137 330 330 ...
-  .. .. .. ..$ station_european_code: Factor w/ 7734 levels "AD0942A","AD0944A",..: 12 61 112 69 73 14 194 184 23 25 ...
-  .. .. .. ..$ country_iso_code     : Factor w/ 39 levels "AD","AL","AT",..: 3 3 3 3 3 3 3 3 3 3 ...
-  .. .. .. ..$ station_start_date   : Factor w/ 2344 levels "1900-01-01","1951-04-01",..: 1117 377 296 411 649 134 658 429 672 684 ...
-  .. .. .. ..$ station_end_date     : Factor w/ 811 levels "","1900-01-01",..: 1 1 1 1 1 1 1 1 1 736 ...
-  .. .. .. ..$ type_of_station      : Factor w/ 5 levels "","Background",..: 2 2 2 2 2 2 2 2 2 2 ...
-  .. .. .. ..$ station_type_of_area : Factor w/ 5 levels "","rural","suburban",..: 2 2 2 2 2 2 2 2 2 2 ...
-  .. .. .. ..$ street_type          : Factor w/ 5 levels "","Canyon street: L/H < 1.5",..: 1 1 5 4 4 1 4 1 2 1 ...
-  .. .. ..@ coords.nrs : num(0) 
-  .. .. ..@ coords     : num [1:194, 1:2] 4592866 4761515 4658756 4690954 4799839 ...
-  .. .. .. ..- attr(*, "dimnames")=List of 2
-  .. .. .. .. ..$ : NULL
-  .. .. .. .. ..$ : chr [1:2] "coords.x1" "coords.x2"
-  .. .. ..@ bbox       : num [1:2, 1:2] 2749697 1647732 6412269 4604814
-  .. .. .. ..- attr(*, "dimnames")=List of 2
-  .. .. .. .. ..$ : chr [1:2] "coords.x1" "coords.x2"
-  .. .. .. .. ..$ : chr [1:2] "min" "max"
-  .. .. ..@ proj4string:Formal class 'CRS' [package "sp"] with 1 slot
-  .. .. .. .. ..@ projargs: chr " +proj=laea +lat_0=52 +lon_0=10 +x_0=4321000 +y_0=3210000 +ellps=GRS80 +units=m +no_defs"
-  ..@ time   :An ‘xts’ object on 2005-01-01/2005-12-31 containing:
-  Data: int [1:365, 1] 5115 5116 5117 5118 5119 5120 5121 5122 5123 5124 ...
- - attr(*, "dimnames")=List of 2
-  ..$ : NULL
-  ..$ : chr "..1"
-  Indexed by objects of class: [POSIXct,POSIXt] TZ: GMT
-  xts Attributes:  
- NULL
-  ..@ endTime: POSIXct[1:365], format: "2005-01-02 01:00:00" "2005-01-03 01:00:00" ...
-> 
-> 
-> 
-> cleanEx()
-> nameEx("asCopula-class")
-> ### * asCopula-class
-> 
-> flush(stderr()); flush(stdout())
-> 
-> ### Name: asCopula-class
-> ### Title: Class '"asCopula"'
-> ### Aliases: asCopula-class dduCopula,matrix,asCopula-method
-> ###   dduCopula,numeric,asCopula-method ddvCopula,matrix,asCopula-method
-> ###   ddvCopula,numeric,asCopula-method fitCopula,asCopula-method
-> ###   invdduCopula,numeric,asCopula,numeric-method
-> ###   invddvCopula,numeric,asCopula,numeric-method
-> ### Keywords: classes asymmetric copula copula
-> 
-> ### ** Examples
-> 
-> showClass("asCopula")
-Class "asCopula" [package "spcopula"]
-
-Slots:
-                                                                       
-Name:     dimension   parameters  param.names param.lowbnd  param.upbnd
-Class:      integer      numeric    character      numeric      numeric
-                   
-Name:      fullname
-Class:    character
-
-Extends: 
-Class "copula", directly
-Class "Copula", by class "copula", distance 2
-> 
-> 
-> 
-> cleanEx()
-> nameEx("asCopula")
-> ### * asCopula
-> 
-> flush(stderr()); flush(stdout())
-> 
-> ### Name: asCopula
-> ### Title: Constructor of an asymmetric copula with cubic and quadratic
-> ###   sections (Nelsen 2006).
-> ### Aliases: asCopula
-> ### Keywords: asymmetric copula cubic quadratic sections
-> 
-> ### ** Examples
-> 
-> persp(asCopula(c(-2,1)),dCopula)
-> 
-> 
-> 
-> cleanEx()
-> nameEx("bivTailDepFun")
-> ### * bivTailDepFun
-> 
-> flush(stderr()); flush(stdout())
-> 
-> ### Name: bivJointDepFun
-> ### Title: Bivariate joint dependence functions
-> ### Aliases: bivJointDepFun lowerBivJointDepFun upperBivJointDepFun
-> ###   empBivJointDepFun lowerEmpBivJointDepFun upperEmpBivJointDepFun
-> 
-> ### ** Examples
-> 
-> library("VineCopula")
-> data("simulatedTriples")
-> X <- rankTransform(triples[,c(1,3)])
->   
-> tdfEmp <- empBivJointDepFun(X)
-> plot(tdfEmp,ylim=c(0,1),
-+      ylab="tail dependence index")  
-> abline(v=0.5, col="grey")
-> 
-> smplTau <- cor(X,method="kendall")[1,2]
-> 
-> # Gauss
-> tdfGauss <- bivJointDepFun(normalCopula(sin(smplTau*pi/2)))
-> curve(tdfGauss,add=TRUE,col="blue")
-> 
-> # survival Gumbel
-> tdfGumbel <- bivJointDepFun(surGumbelCopula(1/(1-smplTau)))
-> curve(tdfGumbel,add=TRUE,col="darkgreen")
-> 
-> # survival BB6 copula
-> tdfBB6 <- bivJointDepFun(surBB6Copula(c(4.65,2.28)))
-> curve(tdfBB6,add=TRUE,col="red")
-> 
-> legend("bottomleft",c("empircal","Gauss","surv. Gumbel","surv. BB6"),
-+        col=c("black","blue","darkgreen","red"),lty=1)
-> 
-> 
-> 
-> cleanEx()
-
-detaching ‘package:VineCopula’
-
-> nameEx("calcBins")
-> ### * calcBins
-> 
-> flush(stderr()); flush(stdout())
-> 
-> ### Name: calcBins
-> ### Title: A function calculating the spatial/spatio-temporal bins
-> ### Aliases: calcBins calcBins-methods calcBins,Spatial-method
-> ###   calcBins,STFDF-method
-> ### Keywords: spatial preparation spatio-temporal preparation
-> 
-> ### ** Examples
-> 
-> library("sp")
-> data("meuse")
-> coordinates(meuse) = ~x+y
-> meuse$rtZinc <- rank(meuse$zinc)/(length(meuse)+1)
-> 
-> ## lag classes ##
-> bins <- calcBins(meuse, var="rtZinc", nbins=10, cutoff=800)
-> 
-> 
-> 
-> cleanEx()
-
-detaching ‘package:sp’
-
-> nameEx("composeSpCopula")
-> ### * composeSpCopula
-> 
-> flush(stderr()); flush(stdout())
-> 
-> ### Name: composeSpCopula
-> ### Title: Composing a bivariate Spatial Copula
-> ### Aliases: composeSpCopula
-> ### Keywords: spatial multivariate distribution
-> 
-> ### ** Examples
-> 
-> composeSpCopula(c(1,1,2,3),families=list(frankCopula(.4), gumbelCopula(1.6),gumbelCopula(1.4)),
-+                 bins=data.frame(meanDists=c(500,1000,1500,2000,2500)),range=2250)
-Spatial Copula: distance dependent convex combination of bivariate copulas 
-Dimension:  2 
-Copulas:
-   Frank copula family; Archimedean copula at 500 [m] 
-   Frank copula family; Archimedean copula at 1000 [m] 
-   Gumbel copula family; Archimedean copula; Extreme value copula at 1500 [m] 
-   Gumbel copula family; Archimedean copula; Extreme value copula at 2000 [m] 
-> 
-> 
-> 
-> cleanEx()
-> nameEx("condCovariate")
-> ### * condCovariate
-> 
-> flush(stderr()); flush(stdout())
-> 
-> ### Name: condCovariate
-> ### Title: Conditioning of a Covariate
-> ### Aliases: condCovariate
-> 
-> ### ** Examples
-> 
-> library("sp")
-> library("spacetime")
-> 
-> sp <- SpatialPoints(matrix(c(181000,181100,333500,333600),2))
-> time <- as.POSIXct("2014-03-18")+60*60*24*c(0,1,2)
-> data <- data.frame(var=runif(6))
-> data$coVar <- invdduCopula(data$var, gumbelCopula(7), runif(6)) 
-Numerical evaluation of invddu takes place.
-> 
-> stData <- STFDF(sp, time, data)
-> stQuerry <- STF(SpatialPoints(matrix(c(181000,181200,333600,333600),2)),
-+                 time[2:3])
-> 
-> stNeigh <- getStNeighbours(stData=stData, ST=stQuerry, 
-+                            spSize=3, tlags=-(0:1),
-+                            var="var", coVar="coVar", prediction=TRUE)
-> 
-> condCovariate(stNeigh, function(x) gumbelCopula(7))
-[1] 2.558620e-05 5.677942e-09 6.178627e-02 1.765568e-01
-> 
-> 
-> 
-> cleanEx()
-
-detaching ‘package:spacetime’, ‘package:sp’
-
-> nameEx("condSpVine")
-> ### * condSpVine
-> 
-> flush(stderr()); flush(stdout())
-> 
-> ### Name: condSpVine
-> ### Title: Conditions a spatial vine copula for conditional prediction
-> ### Aliases: condSpVine
-> ### Keywords: distribution
-> 
-> ### ** Examples
-> 
-> library("VineCopula")
-> data("spCopDemo")
-> 
-> calcKTauPol <- fitCorFun(bins, degree=3)
-
-Call:
-lm(formula = lagCor ~ poly(meanDists, degree), data = bins)
-
-Coefficients:
-             (Intercept)  poly(meanDists, degree)1  poly(meanDists, degree)2  
-                 0.20756                  -0.58268                   0.16262  
-poly(meanDists, degree)3  
-                -0.02181  
-
-Sum of squared residuals: 0.006621988 
-> 
-> 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")
-The parameters of the components will be recalculated according to the provided spDepFun where possible. 
-In case no 1-1 relation is known, the copula as in components is used. 
-parameter at boundary ==> returning indepCopula()
-parameter at boundary ==> returning indepCopula()
-parameter at boundary ==> returning indepCopula()
-parameter at boundary ==> returning indepCopula()
-parameter at boundary ==> returning indepCopula()
-> 
-> spVineCop <- spVineCopula(spCop, vineCopula(4L))
-> 
-> dists <- list(c(473, 124, 116, 649))
-> condVar <- c(0.29, 0.55, 0.05, 0.41)
-> condDensity <- condSpVine(condVar,dists,spVineCop)
-> 
-> curve(condDensity)
-> mtext(paste("Dists:",paste(round(dists[[1]],0),collapse=", ")),line=0)
-> mtext(paste("Cond.:",paste(round(condVar,2),collapse=", ")),line=1)
-> 
-> 
-> 
-> cleanEx()
-
-detaching ‘package:VineCopula’
-
-> nameEx("condStCoVarVine")
-> ### * condStCoVarVine
-> 
-> flush(stderr()); flush(stdout())
-> 
-> ### Name: condStCoVarVine
-> ### Title: conditional distribution function of spatio-temporal covariate
-> ###   vine copula
-> ### Aliases: condStCoVarVine
-> 
-> ### ** Examples
-> 
-> library("VineCopula")
-> 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),
-+                   tlags=-(0:2))
-> 
-> # only a constant copula ius used for the covariate
-> stCVVC <- stCoVarVineCopula(function(x) gumbelCopula(7), stCop, vineCopula(5L))
-> 
-> dists <- array(c(150, 250, 150, 250,0,0,-1,-1),dim=c(1,4,2))
-> condVar <- c(0.95, 0.29, 0.55, 0.05, 0.41)
-> 
-> condDensity <- condStCoVarVine(condVar, dists, stCVVC, c(1,1))
-> curve(condDensity)
-> 
-> 
-> 
-> cleanEx()
-
-detaching ‘package:VineCopula’
-
-> nameEx("condStVine")
-> ### * condStVine
-> 
-> flush(stderr()); flush(stdout())
-> 
-> ### Name: condStVine
-> ### Title: Conditions a spatio-temporal vine copula for conditional
-> ###   prediction
-> ### Aliases: condStVine
-> ### Keywords: distribution
-> 
-> ### ** Examples
-> 
-> # a spatio-temporal C-vine copula (with independent copulas in the upper vine)
-> library("VineCopula")
-> 
-> 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")
-> 
-> stCop <- stCopula(components=list(spCopT0, spCopT1),
-+                   tlags=-(0:1))
-> 
-> stVineCop <- stVineCopula(stCop, vineCopula(4L))
-> 
-> dists <- array(c(150, 250, 150, 250,0,0,-1,-1),dim=c(1,4,2))
-> condVar <- c(0.29, 0.55, 0.05, 0.41)
-> 
-> condDensity <- condStVine(condVar,dists,stVineCop)
-> curve(condDensity)
-> 
-> 
-> 
-> cleanEx()
-
-detaching ‘package:VineCopula’
-
-> nameEx("cqsCopula-class")
-> ### * cqsCopula-class
-> 
-> flush(stderr()); flush(stdout())
-> 
-> ### Name: cqsCopula-class
-> ### Title: Class '"cqsCopula"'
-> ### Aliases: cqsCopula-class dduCopula,matrix,cqsCopula-method
-> ###   dduCopula,numeric,cqsCopula-method ddvCopula,matrix,cqsCopula-method
-> ###   ddvCopula,numeric,cqsCopula-method fitCopula,cqsCopula-method
-> ###   invdduCopula,numeric,cqsCopula,numeric-method
-> ###   invddvCopula,numeric,cqsCopula,numeric-method
-> ### Keywords: classes copula
-> 
-> ### ** Examples
-> 
-> showClass("cqsCopula")
-Class "cqsCopula" [package "spcopula"]
-
-Slots:
-                                                                       
-Name:         fixed    dimension   parameters  param.names param.lowbnd
-Class:    character      integer      numeric    character      numeric
-                                
-Name:   param.upbnd     fullname
-Class:      numeric    character
-
-Extends: 
-Class "copula", directly
-Class "Copula", by class "copula", distance 2
-> 
-> 
-> 
-> cleanEx()
-> nameEx("cqsCopula")
-> ### * cqsCopula
-> 
-> flush(stderr()); flush(stdout())
-> 
-> ### Name: cqsCopula
-> ### Title: Constructor of a symmetric copula with cubic quadratic sections.
-> ### Aliases: cqsCopula
-> ### Keywords: copula cubic quadratic sections
-> 
-> ### ** Examples
-> 
-> persp(cqsCopula(c(-2,1)),dCopula)
-> 
-> 
-> 
-> cleanEx()
-> nameEx("criticalLevel")
-> ### * criticalLevel
-> 
-> flush(stderr()); flush(stdout())
-> 
-> ### Name: criticalLevel
-> ### Title: Calculating the critical level for a given Kendall Return Period
-> ### Aliases: criticalLevel
-> ### Keywords: survival multivariate
-> 
-> ### ** Examples
-> 
-> criticalLevel(getKendallDistr(frankCopula(.7)), KRP=c(10,100,1000))
-[1] 0.6244540 0.8801567 0.9620758
-> 
-> 
-> 
-> cleanEx()
-> nameEx("criticalPair")
-> ### * criticalPair
-> 
-> flush(stderr()); flush(stdout())
-> 
-> ### Name: criticalPair
-> ### Title: Calculate Critical Pairs
-> ### Aliases: criticalPair
-> ### Keywords: ~kwd1 ~kwd2
-> 
-> ### ** Examples
-> 
-> v <- criticalPair(frankCopula(0.7), 0.9, u=.97, 1)
-> pCopula(c(0.97, v),frankCopula(0.7))
-[1] 0.9
-> 
-> 
-> 
-> cleanEx()
-> nameEx("criticalTriple")
-> ### * criticalTriple
-> 
-> flush(stderr()); flush(stdout())
-> 
-> ### Name: criticalTriple
-> ### Title: calculate critical triples
-> ### Aliases: criticalTriple
-> ### Keywords: multivariate distribution
-> 
-> ### ** Examples
-> 
-> w <- criticalTriple(frankCopula(0.7,dim=3), 0.9, c(.97,.97), c(1,2))
-> 
-> # check the triple
-> pCopula(c(0.97, 0.97, w), frankCopula(0.7, dim=3))
-[1] 0.9
-> 
-> 
-> 
-> 
-> cleanEx()
-> nameEx("dduCopula")
-> ### * dduCopula
-> 
-> flush(stderr()); flush(stdout())
-> 
-> ### Name: dduCopula
-> ### Title: partial derivatives of copulas
-> ### Aliases: dduCopula ddvCopula
-> ### Keywords: partial derivative conditional probabilities
-> 
-> ### ** Examples
-> 
-> ####################################
-> ## Asymmetric vs. Gaussian copula ##
-> ####################################
-> 
-> asCop <- asCopula(c(-2,1))
-> asCopSmpl <- rCopula(100,asCop)
-> 
-> unitScatter(smpl=asCopSmpl)
-> 
-> # conditional probabilities of an asymmetric copula given u
-> asGivenU <- dduCopula(asCopSmpl,asCop)
-> 
-> # vs. conditional probabilities of an asymmetric copula given v
-> asGivenV <- ddvCopula(asCopSmpl[,c(2,1)],asCop)
-> unitScatter(smpl=cbind(asGivenU, asGivenV))
-> 
-> normalCop <- normalCopula(.6)
-> normCopSmpl <- rCopula(100,normalCop)
-> 
-> unitScatter(smpl=normCopSmpl)
-> 
-> # conditional probabilities of a Gaussian copula given u
-> normGivenU <- dduCopula(normCopSmpl,normalCop)
-> 
-> # vs. conditional probabilities of a Gaussian copula given v
-> normGivenV <- ddvCopula(normCopSmpl[,c(2,1)],normalCop)
-> unitScatter(smpl=cbind(normGivenU, normGivenV))
-> 
-> 
-> 
-> cleanEx()
-> nameEx("dependencePlot")
-> ### * dependencePlot
-> 
-> flush(stderr()); flush(stdout())
-> 
-> ### Name: dependencePlot
-> ### Title: Kernel smoothed scatter plot
-> ### Aliases: dependencePlot
-> ### Keywords: plot
-> 
-> ### ** Examples
-> 
-> ## Not run: dependencePlot(smpl=rCopula(500,asCopula(c(-1,1))))
-> 
-> 
-> 
-> cleanEx()
-> nameEx("empiricalCopula-class")
-> ### * empiricalCopula-class
-> 
-> flush(stderr()); flush(stdout())
-> 
-> ### Name: empiricalCopula-class
-> ### Title: Class '"empiricalCopula"'
-> ### Aliases: empiricalCopula-class
-> ### Keywords: classes
-> 
-> ### ** Examples
-> 
-> showClass("empiricalCopula")
-Class "empiricalCopula" [package "spcopula"]
-
-Slots:
-                                                                       
-Name:        sample    dimension   parameters  param.names param.lowbnd
-Class:       matrix      integer      numeric    character      numeric
-                                
-Name:   param.upbnd     fullname
-Class:      numeric    character
-
-Extends: 
-Class "copula", directly
-Class "Copula", by class "copula", distance 2
-> 
-> 
-> 
-> cleanEx()
-> nameEx("empiricalCopula")
-> ### * empiricalCopula
-> 
-> flush(stderr()); flush(stdout())
-> 
-> ### Name: empiricalCopula
-> ### Title: Constructor of an empirical copula class
-> ### Aliases: empiricalCopula
-> ### Keywords: multivariate
-> 
-> ### ** Examples
-> 
-> empCop <- empiricalCopula(rCopula(500,frankCopula(0.7)))
-> str(empCop)
-Formal class 'empiricalCopula' [package "spcopula"] with 7 slots
-  ..@ sample      : num [1:500, 1:2] 0.266 0.372 0.573 0.908 0.202 ...
-  ..@ dimension   : int 2
-  ..@ parameters  : num NA
-  ..@ param.names : chr "unknown"
-  ..@ param.lowbnd: num NA
-  ..@ param.upbnd : num NA
-  ..@ fullname    : chr "Unkown empirical copula based on a sample."
-> 
-> empCop <- empiricalCopula(copula=frankCopula(0.7))
-Note: the copula will be empirically represented by a sample of size: 1e+05 
-> str(empCop)
-Formal class 'empiricalCopula' [package "spcopula"] with 7 slots
-  ..@ sample      : num [1:100000, 1:2] 0.531 0.685 0.383 0.955 0.118 ...
-  ..@ dimension   : int 2
-  ..@ parameters  : num 0.7
-  ..@ param.names : chr "param"
-  ..@ param.lowbnd: num -Inf
-  ..@ param.upbnd : num Inf
-  ..@ fullname    : chr "Empirical copula derived from Frank copula family; Archimedean copula"
-> 
-> empCop <- empiricalCopula(rCopula(500,frankCopula(0.7)), frankCopula(0.7))
-> str(empCop)
-Formal class 'empiricalCopula' [package "spcopula"] with 7 slots
-  ..@ sample      : num [1:500, 1:2] 0.8219 0.2413 0.0371 0.2891 0.7464 ...
-  ..@ dimension   : int 2
-  ..@ parameters  : num 0.7
-  ..@ param.names : chr "param"
-  ..@ param.lowbnd: num -Inf
-  ..@ param.upbnd : num Inf
-  ..@ fullname    : chr "Empirical copula derived from Frank copula family; Archimedean copula"
-> 
-> # the empirical value
-> pCopula(c(0.3, 0.5), empCop)
-[1] 0.156
-> 
-> # the theoretical value
-> pCopula(c(0.3, 0.5), frankCopula(0.7))
-[1] 0.1682671
-> 
-> 
-> 
-> cleanEx()
-> nameEx("fitCorFun")
-> ### * fitCorFun
-> 
-> flush(stderr()); flush(stdout())
-> 
-> ### Name: fitCorFun
-> ### Title: Automated fitting of a correlation function to the correlogram
-> ### Aliases: fitCorFun
-> ### Keywords: correlogram spcopula
-> 
-> ### ** Examples
-> 
-> # a simplified bins object (from demo(spcopula))
-> bins <- list(meanDists=c(64, 128, 203, 281, 361, 442, 522, 602, 681, 760), 
-+              lagCor=c(0.57,  0.49, 0.32, 0.29, 0.15, 0.14, 0.10, -0.00, 0.03, -0.01))
-> attr(bins,"cor.method") <- "kendall"
-> 
-> # plot the correlogram
-> plot(lagCor~meanDists,bins)
-> 
-> # fit and plot a linear model
-> calcKTauLin <- fitCorFun(bins, degree=1, cutoff=600)
-
-Call:
-lm(formula = lagCor ~ poly(meanDists, degree), data = bins)
-
-Coefficients:
-            (Intercept)  poly(meanDists, degree)  
-                 0.2943                  -0.4284  
-
-Sum of squared residuals: 0.01381904 
-> curve(calcKTauLin,0, 1000, col="red",add=TRUE)
-> 
-> # fit and plot a polynomial model
-> calcKTauPol <- fitCorFun(bins, degree=5)
-
-Call:
-lm(formula = lagCor ~ poly(meanDists, degree), data = bins)
-
-Coefficients:
-             (Intercept)  poly(meanDists, degree)1  poly(meanDists, degree)2  
-                0.208000                 -0.581940                  0.161524  
-poly(meanDists, degree)3  poly(meanDists, degree)4  poly(meanDists, degree)5  
-               -0.023774                  0.004097                  0.011434  
-
-Sum of squared residuals: 0.006503102 
-> curve(calcKTauPol,0, 1000, col="purple",add=TRUE)
-> 
-> 
-> 
-> cleanEx()
-> nameEx("fitSpCopula")
-> ### * fitSpCopula
-> 
-> flush(stderr()); flush(stdout())
-> 
-> ### Name: fitSpCopula
-> ### Title: Spatial Copula Fitting
-> ### Aliases: fitSpCopula
-> ### Keywords: spatial multivariate distribution
-> 
-> ### ** Examples
-> 
-> # reload some spatial data
-> library("sp")
-> data("meuse")
-> coordinates(meuse) <- ~x+y
-> 
-> # drop margins
-> meuse$marZinc <- plnorm(meuse$zinc, mean(log(meuse$zinc)), sd(log(meuse$zinc)))
-> 
-> # load data from a provided binning
-> data("spCopDemo")
-> 
-> fitSpCopula(bins, meuse, 600)
-
-Call:
-lm(formula = lagCor ~ poly(meanDists, degree), data = bins)
-
-Coefficients:
-             (Intercept)  poly(meanDists, degree)1  poly(meanDists, degree)2  
-                0.294212                 -0.428150                  0.100339  
-poly(meanDists, degree)3  
-                0.007255  
-
-Sum of squared residuals: 0.003770511 
-Normal copula family 
+
+R version 3.3.1 (2016-06-21) -- "Bug in Your Hair"
+Copyright (C) 2016 The R Foundation for Statistical Computing
+Platform: x86_64-w64-mingw32/x64 (64-bit)
+
+R is free software and comes with ABSOLUTELY NO WARRANTY.
+You are welcome to redistribute it under certain conditions.
+Type 'license()' or 'licence()' for distribution details.
+
+R is a collaborative project with many contributors.
+Type 'contributors()' for more information and
+'citation()' on how to cite R or R packages in publications.
+
+Type 'demo()' for some demos, 'help()' for on-line help, or
+'help.start()' for an HTML browser interface to help.
+Type 'q()' to quit R.
+
+> pkgname <- "spcopula"
+> source(file.path(R.home("share"), "R", "examples-header.R"))
+> options(warn = 1)
+> options(pager = "console")
[TRUNCATED]

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


More information about the spcopula-commits mailing list