├── ChangeLog ├── DESCRIPTION ├── LICENCE ├── MD5 ├── NAMESPACE ├── R ├── AllClass.R ├── AllGeneric.R ├── An.R ├── Auxiliaries.R ├── Classes.R ├── Copula.R ├── K.R ├── acR.R ├── amhCopula.R ├── amhExpr.R ├── archmCopula.R ├── asymCopula.R ├── aux-acopula.R ├── cCopula.R ├── claytonCopula.R ├── claytonExpr.R ├── cop_objects.R ├── dC-dc.R ├── ellipCopula.R ├── empCopula.R ├── empPsi.R ├── estimation.R ├── evCopula.R ├── evTests.R ├── exchTests.R ├── fgmCopula.R ├── fhCopula.R ├── fitCopula.R ├── fitLambda.R ├── fitMvdc.R ├── fixedPar.R ├── frankCopula.R ├── frankExpr.R ├── galambosCopula.R ├── galambosExpr-math.R ├── galambosExpr.R ├── ggraph-tools.R ├── gofCopula.R ├── gofEVTests.R ├── gofTrafos.R ├── graphics.R ├── gumbelCopula.R ├── gumbelExpr.R ├── huslerReissCopula.R ├── huslerReissExpr.R ├── indepCopula.R ├── indepTests.R ├── joeCopula.R ├── logseries.R ├── lowfhCopula.R ├── margCopula.R ├── matrix_tools.R ├── mixCopula.R ├── moCopula.R ├── mvdc.R ├── nacopula.R ├── normalCopula.R ├── obs.R ├── opower.R ├── pairsRosenblatt.R ├── plackettCopula.R ├── plackettExpr.R ├── prob.R ├── rotCopula.R ├── rstable1.R ├── safeUroot.R ├── schlatherCopula.R ├── special-func.R ├── stable.R ├── sysdata.rda ├── tCopula.R ├── tawnCopula.R ├── tawnExpr.R ├── tevCopula.R ├── timing.R ├── upfhCopula.R ├── varianceReduction.R ├── wrapper.R ├── xvCopula.R └── zzz.R ├── TODO ├── build ├── partial.rdb └── vignette.rds ├── data ├── SMI.12.rda ├── gasoil.rda ├── loss.tab.gz ├── rdj.rda └── uranium.tab.gz ├── demo ├── 00Index ├── G_ak.R ├── dDiag-plots-part-2.R ├── dDiag-plots.R ├── estimation.gof.R ├── estimation_via_HAC.R ├── fitting-tests.R ├── gofCopula.R ├── gof_graph.R ├── opC-demo.R ├── polyGJ.R ├── retstable.R ├── tail_compatibility.R └── timings.R ├── inst ├── CITATION ├── NEWS.Rd ├── Rsource │ ├── AC-Liouville.R │ ├── GIG.R │ ├── MO.R │ ├── cops.R │ ├── dnac.R │ ├── estim-gof-fn.R │ ├── fixup-sapply.R │ ├── gof-sim.R │ ├── tstFit-fn.R │ └── utils.R ├── doc │ ├── AC_Liouville.R │ ├── AC_Liouville.Rmd │ ├── AC_Liouville.html │ ├── AR_Clayton.R │ ├── AR_Clayton.Rmd │ ├── AR_Clayton.html │ ├── Frank-Rmpfr.R │ ├── Frank-Rmpfr.Rnw │ ├── Frank-Rmpfr.pdf │ ├── GIG.R │ ├── GIG.Rmd │ ├── GIG.html │ ├── HAXC.R │ ├── HAXC.Rmd │ ├── HAXC.html │ ├── NALC.R │ ├── NALC.Rmd │ ├── NALC.html │ ├── copula_GARCH.R │ ├── copula_GARCH.Rmd │ ├── copula_GARCH.html │ ├── dNAC.R │ ├── dNAC.Rmd │ ├── dNAC.html │ ├── empiricial_copulas.R │ ├── empiricial_copulas.Rmd │ ├── empiricial_copulas.html │ ├── logL_visualization.R │ ├── logL_visualization.Rmd │ ├── logL_visualization.html │ ├── mlogL_mpfr_i686.rds │ ├── mlogL_mpfr_x86_64.rds │ ├── nacopula-pkg.R │ ├── nacopula-pkg.Rnw │ ├── nacopula-pkg.pdf │ ├── qrng.R │ ├── qrng.Rmd │ ├── qrng.html │ ├── rhoAMH-dilog.R │ ├── rhoAMH-dilog.Rnw │ ├── rhoAMH-dilog.pdf │ ├── wild_animals.R │ ├── wild_animals.Rmd │ └── wild_animals.html ├── docs │ ├── mathnb │ │ ├── README │ │ ├── amhCopula.cdf.expr │ │ ├── amhCopula.cdfDerWrtArg.expr │ │ ├── amhCopula.cdfDerWrtPar.expr │ │ ├── amhCopula.genfun.expr │ │ ├── amhCopula.genfunDer.expr │ │ ├── amhCopula.pdf.expr │ │ ├── amhCopula.pdfDerWrtArg.expr │ │ ├── amhCopula.pdfDerWrtPar.expr │ │ ├── archmCPdf.m │ │ ├── archmDer.m │ │ ├── check2Ivan.R │ │ ├── claytonCopula.cdf.expr │ │ ├── claytonCopula.cdfDerWrtArg.expr │ │ ├── claytonCopula.cdfDerWrtPar.expr │ │ ├── claytonCopula.genfun.expr │ │ ├── claytonCopula.genfunDer.expr │ │ ├── claytonCopula.pdf.expr │ │ ├── claytonCopula.pdfDerWrtArg.expr │ │ ├── claytonCopula.pdfDerWrtPar.expr │ │ ├── evcopula.nb │ │ ├── exprPrep.R │ │ ├── frankCopula.cdf.expr │ │ ├── frankCopula.cdfDerWrtArg.expr │ │ ├── frankCopula.cdfDerWrtPar.expr │ │ ├── frankCopula.genfun.expr │ │ ├── frankCopula.genfunDer.expr │ │ ├── frankCopula.pdf.expr │ │ ├── frankCopula.pdfDerWrtArg.expr │ │ ├── frankCopula.pdfDerWrtPar.expr │ │ ├── galambos.expr │ │ ├── getDerExpr.m │ │ ├── gumbelCopula.cdf.expr │ │ ├── gumbelCopula.cdfDerWrtArg.expr │ │ ├── gumbelCopula.cdfDerWrtPar.expr │ │ ├── gumbelCopula.genfun.expr │ │ ├── gumbelCopula.genfunDer.expr │ │ ├── gumbelCopula.pdf.expr │ │ ├── gumbelCopula.pdfDerWrtArg.expr │ │ └── gumbelCopula.pdfDerWrtPar.expr │ ├── netsrc │ │ └── sgen.for │ ├── obsolete │ │ ├── dgamma.f │ │ ├── localpower.R │ │ ├── localpower.c │ │ ├── oldgof.R │ │ ├── sgen.f │ │ ├── skewNormalCopula.R │ │ ├── try.c │ │ └── varEstCopula.R │ └── tauRho │ │ ├── README.R │ │ ├── evtrps.R │ │ ├── getSysdataImage.R │ │ ├── gridsetup.R │ │ ├── trpsrho.R │ │ ├── trpstau.R │ │ └── validPlot.R └── rData │ ├── GIG_vign-nlogl-gr.rds │ ├── README.org │ ├── retstable_CPU2.rda │ ├── retstable_Nstat.rda │ └── retstable_st2.rda ├── man ├── An.Rd ├── Bernoulli.Rd ├── Copula.Rd ├── K.Rd ├── Mvdc.Rd ├── RSpobs.Rd ├── SMI.12.Rd ├── Sibuya.Rd ├── Stirling.Rd ├── absdpsiMC.Rd ├── acR.Rd ├── acopula-class.Rd ├── allComp.Rd ├── archmCopula-class.Rd ├── archmCopula.Rd ├── assocMeasures.Rd ├── asymCopula-class.Rd ├── asymCopula.Rd ├── beta.Blomqvist.Rd ├── cCopula.Rd ├── cloud2-methods.Rd ├── coeffG.Rd ├── contour-methods.Rd ├── contourplot2-methods.Rd ├── copFamilies.Rd ├── copula-class.Rd ├── copula-internal.Rd ├── copula-package.Rd ├── corKendall.Rd ├── dDiag.Rd ├── describeCop.Rd ├── dnacopula.Rd ├── ellipCopula-class.Rd ├── ellipCopula.Rd ├── emde.Rd ├── emle.Rd ├── empCopula-class.Rd ├── empCopula.Rd ├── enacopula.Rd ├── estim-misc.Rd ├── evCopula-class.Rd ├── evCopula.Rd ├── evTestA.Rd ├── evTestC.Rd ├── evTestK.Rd ├── exchEVTest.Rd ├── exchTest.Rd ├── fgmCopula-class.Rd ├── fgmCopula.Rd ├── fhCopula-class.Rd ├── fhCopula.Rd ├── fitCopula-class.Rd ├── fitCopula.Rd ├── fitLambda.Rd ├── fitMvdc.Rd ├── fixedPar.Rd ├── gasoil.Rd ├── generator-methods.Rd ├── getAcop.Rd ├── getIniParam.Rd ├── getTheta.Rd ├── ggraph-tools.Rd ├── gnacopula.Rd ├── gofCopula.Rd ├── gofEVCopula.Rd ├── gofOtherTstat.Rd ├── gofTstat.Rd ├── htrafo.Rd ├── indepCopula-class.Rd ├── indepCopula.Rd ├── indepTest.Rd ├── initOpt.Rd ├── interval-class.Rd ├── interval.Rd ├── log1mexp.Rd ├── loss.Rd ├── margCopula.Rd ├── math-fun.Rd ├── matrix_tools.Rd ├── mixCopula-class.Rd ├── mixCopula.Rd ├── moCopula-class.Rd ├── moCopula.Rd ├── multIndepTest.Rd ├── multSerialIndepTest.Rd ├── mvdc-class.Rd ├── nacPairthetas.Rd ├── nacTiming.Rd ├── nacopula-class.Rd ├── nesdepth.Rd ├── onacopula.Rd ├── opower.Rd ├── pairs2.Rd ├── pairsCond.Rd ├── pairsRosenblatt.Rd ├── persp-methods.Rd ├── plackettCopula-class.Rd ├── plackettCopula.Rd ├── plot-methods.Rd ├── pnacopula.Rd ├── pobs.Rd ├── polylog.Rd ├── polynEval.Rd ├── printNacopula.Rd ├── prob.Rd ├── qqplot2.Rd ├── rF01FrankJoe.Rd ├── rFFrankJoe.Rd ├── radSymTest.Rd ├── rdj.Rd ├── retstable.Rd ├── rlog.Rd ├── rnacModel.Rd ├── rnacopula.Rd ├── rnchild.Rd ├── rotCopula.Rd ├── rstable1.Rd ├── safeUroot.Rd ├── serialIndepTest.Rd ├── setTheta.Rd ├── show-methods.Rd ├── splom2-methods.Rd ├── tauAMH.Rd ├── uranium.Rd ├── varianceReduction.Rd ├── wireframe2-methods.Rd └── xvCopula.Rd ├── src ├── An.c ├── An.h ├── Makevars ├── cop_gsl.h ├── copula.h ├── copula_int.h ├── ecIndepTest.c ├── empcop.c ├── empcop.h ├── evtest.c ├── exchtest.c ├── fgm.c ├── gof.c ├── gof.h ├── indepTest_utils.c ├── indepTests.h ├── init.c ├── logseries.c ├── multIndepTest.c ├── multSerialIndepTest.c ├── nacopula.h ├── polyn_eval.c ├── rF01Frank.c ├── rF01Joe.c ├── rLog.c ├── rSibuya.c ├── retstable.c ├── serialIndepTest.c ├── set_utils.c └── set_utils.h ├── tests ├── Stirling-etc.R ├── copula-play.R ├── dC-dc-ex.R ├── estim-ex.R ├── explicitCop-ex.R ├── fitting-ex.R ├── fixedPar-ex.R ├── ggraph-tst.R ├── khoudraji-ex.R ├── misc.R ├── mixCop-tst.R ├── moments.R ├── nac-experi.R ├── pdf.R ├── retstable-ex.R ├── rstable-ex.R ├── tail-pcopula.R └── tail-pcopula.Rout.save └── vignettes ├── AC_Liouville.Rmd ├── AR_Clayton.Rmd ├── Frank-Rmpfr.Rnw ├── GIG.Rmd ├── HAXC.Rmd ├── NALC.Rmd ├── copula_GARCH.Rmd ├── dNAC.Rmd ├── empiricial_copulas.Rmd ├── logL_visualization.Rmd ├── nacopula-pkg.Rnw ├── nacopula.bib ├── qrng.Rmd ├── rhoAMH-dilog.Rnw ├── style.css └── wild_animals.Rmd /ChangeLog: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/copula/1251bec7d5eb868a01e417aeb0d11b58a36f9911/ChangeLog -------------------------------------------------------------------------------- /LICENCE: -------------------------------------------------------------------------------- 1 | Copyrights 2 | ========== 3 | 4 | After the merge of nacopula with copula, all files are: 5 | Copyright (C) 2012 Marius Hofert, Ivan Kojadinovic, Martin Maechler, and Jun Yan 6 | 7 | 8 | Licence 9 | ======= 10 | 11 | This is free software; you can redistribute it and/or modify 12 | it under the terms of the GNU General Public License as published by 13 | the Free Software Foundation, either version 3 of the License, or 14 | (at your option) any later version. 15 | 16 | This program is distributed in the hope that it will be useful, 17 | but WITHOUT ANY WARRANTY; without even the implied warranty of 18 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19 | GNU General Public License for more details. 20 | 21 | The file share/licenses/GPL-3 in the R (source or binary) distribution is a 22 | copy of version 3 of the 'GNU General Public License'. 23 | That can also be viewed at http://www.r-project.org/licenses/ 24 | 25 | Marius Hofert 26 | Ivan Kojadinovic 27 | Martin Maechler 28 | Jun Yan 29 | 30 | 31 | -------------------------------------------------------------------------------- /R/archmCopula.R: -------------------------------------------------------------------------------- 1 | ## Copyright (C) 2012 Marius Hofert, Ivan Kojadinovic, Martin Maechler, and Jun Yan 2 | ## 3 | ## This program is free software; you can redistribute it and/or modify it under 4 | ## the terms of the GNU General Public License as published by the Free Software 5 | ## Foundation; either version 3 of the License, or (at your option) any later 6 | ## version. 7 | ## 8 | ## This program is distributed in the hope that it will be useful, but WITHOUT 9 | ## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 10 | ## FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | ## details. 12 | ## 13 | ## You should have received a copy of the GNU General Public License along with 14 | ## this program; if not, see . 15 | 16 | 17 | archmCopula <- function(family, param = NA_real_, dim = 2L, ...) { 18 | family <- tolower(family) 19 | dim <- as.integer(dim) 20 | if(family == "amh" && dim != 2L) 21 | stop("'amh' is not yet available for dim > 2") 22 | switch(family, 23 | "clayton" = claytonCopula(param, dim = dim, ...), 24 | "frank" = frankCopula (param, dim = dim, ...), 25 | "amh" = amhCopula (param, dim = dim, ...), 26 | "gumbel" = gumbelCopula (param, dim = dim, ...), 27 | "joe" = joeCopula (param, dim = dim, ...), 28 | ## otherwise: 29 | { fams <- sub("Copula$", '', names(getClass("archmCopula")@subclasses)) 30 | stop("Valid family names are ", paste(dQuote(fams), collapse=", ")) 31 | }) 32 | } 33 | 34 | setMethod(describeCop, c("archmCopula", "character"), function(x, kind, prefix="", ...) { 35 | d <- x@dimension 36 | if(kind == "very short") # e.g. for show() which has more parts 37 | return(paste0(prefix, getAname(x), " copula")) 38 | ch <- paste0(prefix, getAname(x), " copula, dim. d = ", d) 39 | switch(kind <- match.arg(kind), 40 | short = ch, 41 | long = paste0(ch, "\n", prefix, " param.: ", 42 | capture.output(str(x@parameters, give.head=FALSE))), 43 | stop("invalid 'kind': ", kind)) 44 | }) 45 | 46 | ## not used for *our* Archimedean cop's, as all five have their own method 47 | ## (but used for users definining their own: 48 | tauArchmCopula <- function(copula) { 49 | 1 + 4 * integrate(function(x) iPsi(copula, x) / diPsi(copula, x), 50 | 0, 1)$value 51 | } 52 | setMethod("tau", signature("archmCopula"), tauArchmCopula) 53 | 54 | -------------------------------------------------------------------------------- /R/fhCopula.R: -------------------------------------------------------------------------------- 1 | ## Copyright (C) 2012 Marius Hofert, Ivan Kojadinovic, Martin Maechler, and Jun Yan 2 | ## 3 | ## This program is free software; you can redistribute it and/or modify it under 4 | ## the terms of the GNU General Public License as published by the Free Software 5 | ## Foundation; either version 3 of the License, or (at your option) any later 6 | ## version. 7 | ## 8 | ## This program is distributed in the hope that it will be useful, but WITHOUT 9 | ## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 10 | ## FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | ## details. 12 | ## 13 | ## You should have received a copy of the GNU General Public License along with 14 | ## this program; if not, see . 15 | 16 | 17 | ### Frechet--Hoeffding bound copula class ###################################### 18 | 19 | ## Constructor (see ellipCopula() or archmCopula()) 20 | fhCopula <- function(family = c("upper", "lower"), dim = 2L) 21 | { 22 | switch(match.arg(family), # error if invalid 23 | "lower" = lowfhCopula(dim = dim), 24 | "upper" = upfhCopula(dim = dim)) 25 | } 26 | 27 | 28 | ### Methods #################################################################### 29 | 30 | ## describe method 31 | setMethod(describeCop, c("fhCopula", "character"), function(x, kind, prefix="", ...) { 32 | kind <- match.arg(kind) 33 | cl <- sub("Copula$", "", class(x)) # -> "lowfh" / "upfh" 34 | cl <- if (cl == "lowfh") "lower Frechet-Hoeffding bound" else "upper Frechet-Hoeffding bound" 35 | clNam <- paste0(prefix, cl) 36 | if(kind == "very short") # e.g. for show() which has more parts 37 | return(clNam) 38 | d <- dim(x) 39 | ch <- paste(paste0(clNam, ", dim. d ="), d) 40 | switch(kind <- match.arg(kind), 41 | short = ch, 42 | long = ch, 43 | stop("invalid 'kind': ", kind)) 44 | }) 45 | 46 | ## dCopula method (other *Copula() methods are W/M specific) 47 | setMethod("dCopula", signature("matrix", "fhCopula"), 48 | function(u, copula, log = FALSE, ...) { 49 | stop("Frechet-Hoeffding bounds do not have densities") 50 | ## Alternatively: 51 | ## stopifnot(ncol(u) == copula@dimension) 52 | ## rep.int(if(log) -Inf else 0, nrow(u)) # or even Inf or NA on the diagonal 53 | }) 54 | -------------------------------------------------------------------------------- /R/indepCopula.R: -------------------------------------------------------------------------------- 1 | ## Copyright (C) 2012 Marius Hofert, Ivan Kojadinovic, Martin Maechler, and Jun Yan 2 | ## 3 | ## This program is free software; you can redistribute it and/or modify it under 4 | ## the terms of the GNU General Public License as published by the Free Software 5 | ## Foundation; either version 3 of the License, or (at your option) any later 6 | ## version. 7 | ## 8 | ## This program is distributed in the hope that it will be useful, but WITHOUT 9 | ## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 10 | ## FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | ## details. 12 | ## 13 | ## You should have received a copy of the GNU General Public License along with 14 | ## this program; if not, see . 15 | 16 | 17 | ### Independence copula ######################################################## 18 | 19 | ## Constructor 20 | indepCopula <- function(dim = 2L) 21 | { 22 | ## get expressions of cdf and pdf 23 | cdfExpr <- function(d) { 24 | uis <- paste0("u", 1:d) 25 | expr <- paste(uis, collapse="*") 26 | parse(text = expr) 27 | } 28 | pdfExpr <- function(cdf, d) { 29 | val <- cdf 30 | for (i in 1:d) { 31 | val <- D(val, paste0("u", i)) 32 | } 33 | val 34 | } 35 | cdf <- cdfExpr((dim <- as.integer(dim))) 36 | new("indepCopula", dimension = dim, 37 | exprdist = c(cdf = cdf, pdf = pdfExpr(cdf, d = dim))) 38 | } 39 | 40 | 41 | ## Methods 42 | setMethod("rCopula", signature("numeric", "indepCopula"), 43 | function(n, copula) matrix(runif(n * copula@dimension), nrow = n)) 44 | setMethod("pCopula", signature("matrix", "indepCopula"), 45 | function(u, copula, log.p=FALSE) { 46 | stopifnot(ncol(u) == copula@dimension) 47 | if(log.p) rowSums(log(u)) else apply(u, 1, prod) 48 | }) 49 | setMethod("dCopula", signature("matrix", "indepCopula"), 50 | function(u, copula, log=FALSE, ...) { 51 | stopifnot(ncol(u) == copula@dimension) 52 | rep.int(if(log) 0 else 1, nrow(u)) 53 | }) 54 | setMethod("tau", "indepCopula", function(copula, ...) 0) 55 | setMethod("rho", "indepCopula", function(copula, ...) 0) 56 | setMethod("lambda", "indepCopula", 57 | function(copula, ...) c(lower = 0, upper = 0)) 58 | setMethod("A", signature("indepCopula"), function(copula, w) rep.int(1, length(w))) 59 | 60 | ## GETR 61 | setMethod("describeCop", c("indepCopula", "character"), 62 | function(x, kind = c("short", "very short", "long"), prefix = "", ...) { 63 | kind <- match.arg(kind) 64 | if(kind == "very short") # e.g. for show() which has more parts 65 | return(paste0(prefix, "Independence copula")) 66 | ## else 67 | d <- dim(x) 68 | ch <- paste0(prefix, "Independence copula, dim. d = ", d) 69 | switch(kind <- match.arg(kind), 70 | short = ch, 71 | long = ch, 72 | stop("invalid 'kind': ", kind)) 73 | }) 74 | -------------------------------------------------------------------------------- /R/logseries.R: -------------------------------------------------------------------------------- 1 | ## Copyright (C) 2012 Marius Hofert, Ivan Kojadinovic, Martin Maechler, and Jun Yan 2 | ## 3 | ## This program is free software; you can redistribute it and/or modify it under 4 | ## the terms of the GNU General Public License as published by the Free Software 5 | ## Foundation; either version 3 of the License, or (at your option) any later 6 | ## version. 7 | ## 8 | ## This program is distributed in the hope that it will be useful, but WITHOUT 9 | ## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 10 | ## FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | ## details. 12 | ## 13 | ## You should have received a copy of the GNU General Public License along with 14 | ## this program; if not, see . 15 | 16 | ### Kemp 1981, Applied Statistics 30(3), pp349--253 for RNG 17 | ### The cf is Log[1 - a exp(i t)] / Log[1 - a] 18 | ## dlogseries <- function(x, alpha, log = FALSE) { 19 | ## val <- - alpha^x / x / log(1 - alpha) 20 | ## if (log) log(val) else val 21 | ## } 22 | 23 | ## plogseries <- function(q, alpha, lower.tail = TRUE, log.p = FALSE) { 24 | ## if (!lower.tail) q <- 1 - q 25 | ## val <- 1 - alpha^(1 + q) * hyperg2F1(1 + q, 1, 2 + q, alpha) / (1 + q) 26 | ## if (log.p) log(val) else val 27 | ## } 28 | 29 | 30 | ## These call ../src/logseries.c code 31 | ## ~~~~~~~~~~~~~~~~~~ 32 | ## "FIXME": use ../src/rLog.c and R's rLog() 33 | ## ----- ~~~~~~~~~~~~~ 34 | 35 | ##' only used in rfrankCopula() in ./frankCopula.R currently: 36 | rlogseries <- function(n, alpha) { 37 | .C(rlogseries_R, as.integer(n), rep_len(as.double(alpha), n), val = integer(n))$val 38 | } 39 | 40 | rlogseries.ln1p <- function(n, h) { # 'double' result: integer overflows 41 | .C(rlogseries_R_ln1p, as.integer(n), as.double(h), val = double(n))$val 42 | } 43 | -------------------------------------------------------------------------------- /R/lowfhCopula.R: -------------------------------------------------------------------------------- 1 | ## Copyright (C) 2012 Marius Hofert, Ivan Kojadinovic, Martin Maechler, and Jun Yan 2 | ## 3 | ## This program is free software; you can redistribute it and/or modify it under 4 | ## the terms of the GNU General Public License as published by the Free Software 5 | ## Foundation; either version 3 of the License, or (at your option) any later 6 | ## version. 7 | ## 8 | ## This program is distributed in the hope that it will be useful, but WITHOUT 9 | ## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 10 | ## FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | ## details. 12 | ## 13 | ## You should have received a copy of the GNU General Public License along with 14 | ## this program; if not, see . 15 | 16 | 17 | ### Lower Frechet--Hoeffding bound copula class ################################ 18 | 19 | ## Constructor 20 | lowfhCopula <- function(dim = 2L) 21 | { 22 | if(dim != 2) stop("The lower Frechet-Hoeffding bound copula is only available in the bivariate case") 23 | cdfExpr <- function(d) { 24 | uis <- c(paste0("u", 1:d, "-1"), "1") 25 | expr <- paste(uis, collapse = "+") 26 | expr <- paste0("max(", expr, ",0)") 27 | parse(text = expr) 28 | } 29 | new("lowfhCopula", 30 | dimension = as.integer(dim), 31 | exprdist = c(cdf = cdfExpr(dim), 32 | pdf = expression())) # FIXME? empty pdf disappears !? 33 | } 34 | 35 | 36 | ### Methods #################################################################### 37 | 38 | ## for dCopula(), see fhCopula.R 39 | setMethod("pCopula", signature("matrix", "lowfhCopula"), 40 | function(u, copula, log.p = FALSE) { 41 | d <- ncol(u) 42 | stopifnot(d == copula@dimension) 43 | res <- pmax(rowSums(u) - d + 1, 0) 44 | if(log.p) log(res) else res 45 | }) 46 | setMethod("rCopula", signature("numeric", "lowfhCopula"), 47 | function(n, copula) { 48 | U <- runif(n) 49 | cbind(U, 1-U) 50 | }) 51 | 52 | setMethod("tau", signature("lowfhCopula"), function(copula) -1) 53 | setMethod("rho", signature("lowfhCopula"), function(copula) -1) 54 | setMethod("lambda", signature("lowfhCopula"), function(copula) c(lower = 0, upper = 0)) 55 | -------------------------------------------------------------------------------- /R/margCopula.R: -------------------------------------------------------------------------------- 1 | ##' @title Marginal Copula of a Given Copula 2 | ##' @param copula input copula 3 | ##' @param keep logical vector indicating which margins to keep 4 | ##' @return marginal copula (corresponding to the components in 'keep') 5 | ##' @note Currently only for ellipCopula and archmCopula 6 | ##' @author Jun Yan 7 | ##' @note Consider a 5-dim AR1 structured correlation matrix based on rho = 0.8 8 | ##' and use keep = c(FALSE, TRUE, FALSE, TRUE, TRUE) to see that 9 | ##' the new correlation matrix has off-diagonal entries rho^2, rho^3, rho 10 | ##' => neither AR1- nor Toeplitz-structured anymore 11 | setGeneric("margCopula", function(copula, keep) { 12 | stopifnot(length(keep) == copula@dimension, sum(keep) >= 2, 13 | is(copula, "tCopula") || is(copula, "normalCopula") || is(copula, "archmCopula")) 14 | standardGeneric("margCopula") 15 | }) 16 | 17 | ## Normal copula 18 | margNormalCopula <- function(copula, keep) { 19 | dim <- sum(keep) # dimension of the new, marginal copula 20 | if (copula@dispstr == "ex") 21 | normalCopula(getTheta(copula), dim = dim, dispstr = "ex") 22 | else { # ar1, toep, and un all become un 23 | normalCopula(P2p(getSigma(copula)[keep, keep]), 24 | dim = dim, dispstr = "un") 25 | } 26 | } 27 | 28 | ## t copula 29 | margTCopula <- function(copula, keep) { 30 | dim <- sum(keep) # dimension of the new, marginal copula 31 | if (copula@dispstr == "ex") 32 | tCopula(copula@getRho(copula), dim = dim, dispstr = "ex", 33 | df = getdf(copula), df.fixed = copula@df.fixed) 34 | else { # ar1, toep, and un all become un 35 | ## Note: (At least) if the new copula is bivariate or 'keep' starts at 1 36 | ## and is 'connected', then the structure is actually 'AR1' 37 | ## This could be checked via... 38 | ## d <- dim(copula) # old copula dimension 39 | ## is.AR1 <- (dim == 2) || (keep[1] && all(diff(seq_len(d)[keep]) == 1)) # still 'AR1' structure? 40 | ## param <- if(is.AR1) copula@getRho(copula) else P2p(getSigma(copula)[keep, keep]) 41 | ## if(!is.AR1) dispstr <- "toep" 42 | ## ... but makes things just more complicated 43 | ## (not always returning an object of the same type) 44 | tCopula(P2p(getSigma(copula)[keep, keep]), 45 | dim = dim, dispstr = "un", 46 | df = getdf(copula), df.fixed = copula@df.fixed) 47 | } 48 | } 49 | 50 | setMethod("margCopula", signature("normalCopula", "logical"), margNormalCopula) 51 | setMethod("margCopula", signature("tCopula", "logical"), margTCopula) 52 | 53 | ## Archimedean copulas 54 | setMethod("margCopula", signature("archmCopula", "logical"), 55 | function(copula, keep) { 56 | dim <- sum(keep) 57 | copula@dimension <- dim 58 | copula 59 | }) 60 | -------------------------------------------------------------------------------- /R/obs.R: -------------------------------------------------------------------------------- 1 | ## Copyright (C) 2012 Marius Hofert, Ivan Kojadinovic, Martin Maechler, and Jun Yan 2 | ## 3 | ## This program is free software; you can redistribute it and/or modify it under 4 | ## the terms of the GNU General Public License as published by the Free Software 5 | ## Foundation; either version 3 of the License, or (at your option) any later 6 | ## version. 7 | ## 8 | ## This program is distributed in the hope that it will be useful, but WITHOUT 9 | ## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 10 | ## FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | ## details. 12 | ## 13 | ## You should have received a copy of the GNU General Public License along with 14 | ## this program; if not, see . 15 | 16 | 17 | ### Auxiliary transformations for copula observations ########################## 18 | 19 | ##' @title Pseudo-observations 20 | ##' @param x matrix of random variates to be converted to pseudo-observations 21 | ##' @param na.last passed to rank() 22 | ##' @param ties.method passed to rank() 23 | ##' @param lower.tail if FALSE, pseudo-observations when apply the empirical 24 | ##' marginal survival functions are returned. 25 | ##' @return pseudo-observations (of the same dimensions as x) 26 | ##' @author Marius Hofert & Martin Maechler 27 | pobs <- function(x, na.last = "keep", 28 | ## formals(rank) works in pre-2015-10-15 and newer version of rank(): 29 | ties.method = eval(formals(rank)$ties.method), 30 | lower.tail = TRUE) 31 | { 32 | ties.method <- match.arg(ties.method) 33 | U <- if(!is.null(dim(x))) 34 | apply(x, 2, rank, na.last=na.last, ties.method=ties.method) / (nrow(x)+1) 35 | else 36 | rank(x, na.last=na.last, ties.method=ties.method) / (length(x)+1) 37 | if(inherits(x, "zoo")) # incl "xts" (but no similar) -- FIXME? and use: 38 | ### if(is.object(x) && !isS4(x) && !is.data.frame(x)) ## "zoo", "xts" et al 39 | attributes(U) <- attributes(x) 40 | if(lower.tail) U else 1-U 41 | } 42 | 43 | -------------------------------------------------------------------------------- /R/prob.R: -------------------------------------------------------------------------------- 1 | ## Copyright (C) 2012 Marius Hofert, Ivan Kojadinovic, Martin Maechler, and Jun Yan 2 | ## 3 | ## This program is free software; you can redistribute it and/or modify it under 4 | ## the terms of the GNU General Public License as published by the Free Software 5 | ## Foundation; either version 3 of the License, or (at your option) any later 6 | ## version. 7 | ## 8 | ## This program is distributed in the hope that it will be useful, but WITHOUT 9 | ## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 10 | ## FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | ## details. 12 | ## 13 | ## You should have received a copy of the GNU General Public License along with 14 | ## this program; if not, see . 15 | 16 | 17 | ### Computing probabilities of falling in hyperrectangles 18 | 19 | ### prob() --- Generic and all Methods here 20 | ### ====== 21 | 22 | ##' @title Compute the probability P[l < U <= u] where U ~ copula x 23 | ##' @param x copula object 24 | ##' @param l d-vector of lower "integration" limits 25 | ##' @param u d-vector of upper "integration" limits 26 | ##' @return the probability that a random vector following the given copula 27 | ##' falls in the hypercube with lower and upper corner l and u, respectively. 28 | ##' @author Marius Hofert, Martin Maechler 29 | setGeneric("prob", function(x, l, u) standardGeneric("prob")) 30 | 31 | setMethod("prob", signature(x ="Copula"), 32 | function(x, l,u) { 33 | d <- dim(x) 34 | stopifnot(is.numeric(l), is.numeric(u), 35 | length(u) == d, d == length(l), 36 | 0 <= l, l <= u, u <= 1) 37 | if(d > 30) 38 | stop("prob() for copula dimensions > 30 are not supported (yet)") 39 | D <- 2^d 40 | m <- 0:(D - 1) 41 | ## digitsBase() from package 'sfsmisc' {slightly simplified} : 42 | ## Purpose: Use binary representation of 0:N 43 | ## Author: Martin Maechler, Date: Wed Dec 4 14:10:27 1991 44 | II <- matrix(0, nrow = D, ncol = d) 45 | for (i in d:1L) { 46 | II[,i] <- m %% 2L + 1L 47 | if (i > 1) m <- m %/% 2L 48 | } 49 | ## Sign: the ("u","u",...,"u") case has +1; = c(2,2,...,2) 50 | Sign <- c(1,-1)[1L + (- rowSums(II)) %% 2] 51 | U <- array(cbind(l,u)[cbind(c(col(II)), c(II))], dim = dim(II)) 52 | sum(Sign * pCopula(U, x)) 53 | }) 54 | -------------------------------------------------------------------------------- /R/stable.R: -------------------------------------------------------------------------------- 1 | ## Copyright (C) 2012 Marius Hofert, Ivan Kojadinovic, Martin Maechler, and Jun Yan 2 | ## 3 | ## This program is free software; you can redistribute it and/or modify it under 4 | ## the terms of the GNU General Public License as published by the Free Software 5 | ## Foundation; either version 3 of the License, or (at your option) any later 6 | ## version. 7 | ## 8 | ## This program is distributed in the hope that it will be useful, but WITHOUT 9 | ## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 10 | ## FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | ## details. 12 | ## 13 | ## You should have received a copy of the GNU General Public License along with 14 | ## this program; if not, see . 15 | 16 | ##' Generate stable(alpha, beta=1, gamma = cos(alpha * pi/2)^(1/alpha), pm=1) 17 | ##' ----------------------------------- "Scaled" 18 | ##' Note that the gamma factor leads to a *simplified* formula because it cancels mostly. 19 | ##' for rCopula(, .) only if options(copula:rstable1 = "rPosStable") 20 | ##' 21 | ##' @title Generate 'Scaled' stable(alpha, beta=1, gamma = **, pm=1) random numbers 22 | ##' @param n integer 23 | ##' @param alpha number in (0, 1) 24 | ##' @references: Chambers, Mallows, and Stuck 1976, JASA, p.341, formula (2.2) 25 | ##' @return numeric vector of length n 26 | rPosStableS <- function(n, alpha) { 27 | if (alpha >= 1) stop("alpha must be < 1") 28 | theta <- runif(n, 0, pi) 29 | W <- rexp(n) 30 | ## a <- sin((1 - alpha) *theta) * sin(alpha * theta)^(alpha / (1 - alpha)) / 31 | ## sin(theta)^(1/(1 - alpha)) 32 | I_a <- 1 - alpha 33 | a <- sin(I_a *theta) * (sin(alpha * theta)^alpha / sin(theta)) ^ (1/I_a) 34 | (a / W)^(I_a/alpha) 35 | } 36 | 37 | -------------------------------------------------------------------------------- /R/sysdata.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/copula/1251bec7d5eb868a01e417aeb0d11b58a36f9911/R/sysdata.rda -------------------------------------------------------------------------------- /R/timing.R: -------------------------------------------------------------------------------- 1 | ## Copyright (C) 2012 Marius Hofert, Ivan Kojadinovic, Martin Maechler, and Jun Yan 2 | ## 3 | ## This program is free software; you can redistribute it and/or modify it under 4 | ## the terms of the GNU General Public License as published by the Free Software 5 | ## Foundation; either version 3 of the License, or (at your option) any later 6 | ## version. 7 | ## 8 | ## This program is distributed in the hope that it will be useful, but WITHOUT 9 | ## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 10 | ## FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | ## details. 12 | ## 13 | ## You should have received a copy of the GNU General Public License along with 14 | ## this program; if not, see . 15 | 16 | 17 | ### Timing for the implemented nested Archimedean copulas 18 | 19 | ##' Computes user times for the admissible parameter combinations provided by "taus" 20 | ##' 21 | ##' @title Timing frailties 22 | ##' @param n number of variates to be generated 23 | ##' @param family the (nested) Archimedean family to be timed 24 | ##' @param taus the sequence of Kendall's tau to be tested 25 | ##' @param digits number of digits for the output 26 | ##' @param verbose print current state of the timing during timing 27 | ##' @return a (tau_0 x tau_1)-matrix with first column indicating the user run 28 | ##' times for V0 and the other cells the run time for V01 corresponding 29 | ##' to two given taus among "taus" based on the generated V0's 30 | ##' @author Marius Hofert 31 | nacFrail.time <- function(n, family, taus, digits=3, verbose=FALSE) 32 | { 33 | ## setup 34 | f <- function(x) formatC(x, digits=digits, width = 8) 35 | mTime <- function(x) 1000 * system.time(x)[1] # measuring milliseconds 36 | l <- length(taus) 37 | f.taus <- format(taus, digits=digits) 38 | res <- matrix(,nrow=l,ncol=l, 39 | ## use taus as row and column headers: 40 | dimnames = 41 | list('outer tau' = f.taus, 42 | ' inner tau' = c(" ", f.taus[-1]))) 43 | cop <- getAcop(family) 44 | thetas <- cop@iTau(taus) 45 | 46 | ## timing (based on user time) 47 | for(i in seq_along(thetas)) { # run over all theta0 48 | ## run times for V0 go into the first column: 49 | res[i,1] <- mTime(V0 <- cop@V0(n,thetas[i])) 50 | if(verbose) cat("V0: tau_0 = ",f.taus[i], 51 | "; time = ", f(res[i,1]), " ms\n",sep="") 52 | if(i < l) for(j in (i+1):l) { # run over all theta1 53 | res[i,j] <- mTime(cop@V01(V0,thetas[i], thetas[j])) 54 | if(verbose) cat(" V01: tau_0 = ",f.taus[i],", tau_1 = ", f.taus[j], 55 | "; time = ",f(res[i,j])," ms\n", sep="") 56 | } 57 | } 58 | res 59 | } 60 | -------------------------------------------------------------------------------- /R/upfhCopula.R: -------------------------------------------------------------------------------- 1 | ## Copyright (C) 2012 Marius Hofert, Ivan Kojadinovic, Martin Maechler, and Jun Yan 2 | ## 3 | ## This program is free software; you can redistribute it and/or modify it under 4 | ## the terms of the GNU General Public License as published by the Free Software 5 | ## Foundation; either version 3 of the License, or (at your option) any later 6 | ## version. 7 | ## 8 | ## This program is distributed in the hope that it will be useful, but WITHOUT 9 | ## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 10 | ## FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | ## details. 12 | ## 13 | ## You should have received a copy of the GNU General Public License along with 14 | ## this program; if not, see . 15 | 16 | 17 | ### Upper Frechet--Hoeffding bound copula class ################################ 18 | 19 | ## Constructor 20 | upfhCopula <- function(dim = 2L) 21 | { 22 | cdfExpr <- function(d) { 23 | uis <- paste0("u", 1:d, collapse = ",") 24 | expr <- paste0("min(", uis, ")") 25 | parse(text = expr) 26 | } 27 | new("upfhCopula", 28 | dimension = as.integer(dim), 29 | exprdist = c(cdf = cdfExpr(dim), 30 | pdf = expression())) # FIXME? empty pdf disappears !? 31 | } 32 | 33 | 34 | ### Methods #################################################################### 35 | 36 | ## for dCopula(), see fhCopula.R 37 | setMethod("pCopula", signature("matrix", "upfhCopula"), 38 | function(u, copula, log.p = FALSE) { 39 | stopifnot(ncol(u) == copula@dimension) 40 | res <- apply(u, 1, min) 41 | if(log.p) log(res) else res 42 | }) 43 | setMethod("rCopula", signature("numeric", "upfhCopula"), 44 | function(n, copula) matrix(runif(n), nrow = n, ncol = copula@dimension)) 45 | 46 | setMethod("tau", signature("upfhCopula"), function(copula) 1) 47 | setMethod("rho", signature("upfhCopula"), function(copula) 1) 48 | setMethod("lambda", signature("upfhCopula"), function(copula) c(lower = 1, upper = 1)) 49 | -------------------------------------------------------------------------------- /R/varianceReduction.R: -------------------------------------------------------------------------------- 1 | ## Copyright (C) 2012 Marius Hofert, Ivan Kojadinovic, Martin Maechler, and Jun Yan 2 | ## 3 | ## This program is free software; you can redistribute it and/or modify it under 4 | ## the terms of the GNU General Public License as published by the Free Software 5 | ## Foundation; either version 3 of the License, or (at your option) any later 6 | ## version. 7 | ## 8 | ## This program is distributed in the hope that it will be useful, but WITHOUT 9 | ## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 10 | ## FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | ## details. 12 | ## 13 | ## You should have received a copy of the GNU General Public License along with 14 | ## this program; if not, see . 15 | 16 | 17 | ## Variance reduction methods for copulas 18 | 19 | ##' @title Latin hypercube sampling 20 | ##' @param u (n, d)-matrix of copula data 21 | ##' @param ... additional arguments passed to rank() 22 | ##' @return (n, d)-matrix containing the Latin Hypercube sample 23 | ##' @author Marius Hofert 24 | ##' @note See Cuberus et al. (2019, "Copulas checker-type approximations: 25 | ##'' Application to quantiles estimation of sums of dependent random variables") 26 | ##' or Genest, Neslehova (2007, "A primer on copulas for count data") 27 | ##' The empirical checkerboard copula uses uniform mass in each 28 | ##' d-box \prod_{j=1}^d ((i_j-1)/N, i_j/N] for each (i_1,..,i_d) 29 | ##' in {1,...,N}^d. As such, this is equivalent to Latin Hypercube Sampling. 30 | rLatinHypercube <- function(u, ...) 31 | { 32 | stopifnot(0 <= u, u <= 1) 33 | ## As pCopula(), we could use: 34 | ## u[] <- pmax(0, pmin(1, u)) 35 | if(!is.matrix(u)) u <- rbind(u, deparse.level = 0L) 36 | n <- nrow(u) 37 | U <- matrix(runif(n * ncol(u)), nrow = n) 38 | (apply(u, 2, rank, ...) - 1 + U) / n 39 | } 40 | 41 | ##' @title Antithetic variates 42 | ##' @param u (n, d)-matrix of copula data 43 | ##' @return (n, d, 2)-array containing u in .[,,1] and the corresponding 44 | ##' antithetic sample in .[,,2] 45 | ##' @author Marius Hofert 46 | rAntitheticVariates <- function(u) 47 | { 48 | stopifnot(0 <= u, u <= 1) 49 | ## As pCopula(), we could use: 50 | ## u[] <- pmax(0, pmin(1, u)) 51 | if(!is.matrix(u)) u <- rbind(u, deparse.level = 0L) 52 | array(c(u, 1-u), dim = c(nrow(u), ncol(u), 2)) 53 | } 54 | -------------------------------------------------------------------------------- /R/wrapper.R: -------------------------------------------------------------------------------- 1 | ## Copyright (C) 2012 Marius Hofert and Martin Maechler 2 | ## 3 | ## This program is free software; you can redistribute it and/or modify it under 4 | ## the terms of the GNU General Public License as published by the Free Software 5 | ## Foundation; either version 3 of the License, or (at your option) any later 6 | ## version. 7 | ## 8 | ## This program is distributed in the hope that it will be useful, but WITHOUT 9 | ## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 10 | ## FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | ## details. 12 | ## 13 | ## You should have received a copy of the GNU General Public License along with 14 | ## this program; if not, see . 15 | 16 | 17 | ### Wrappers for dealing with elliptical (Gauss, t_nu) and Archimedean copulas 18 | 19 | ##' @title Copula class for the given copula object 20 | ##' @param cop copula object 21 | ##' @return "ellipCopula" or "outer_nacopula" depending on the given copula object 22 | ##' @author Marius Hofert 23 | copClass <- function(cop) 24 | { 25 | cls <- class(cop) 26 | if(is(cop, "copula") && (cls=="normalCopula" || cls=="tCopula")) "ellipCopula" # note: there could be other "copula" objects which are not elliptical 27 | else if(cls=="outer_nacopula") "outer_nacopula" # can be Archimedean or nested Archimedean 28 | else stop("not yet supported copula object") 29 | } 30 | 31 | ##' @title Copula family for the given copula object 32 | ##' @param cop copula object (either elliptical or (nested) Archimedean) 33 | ##' @return family string 34 | ##' @author Marius Hofert and Martin Maechler 35 | copFamily <- function(cop) 36 | { 37 | cls <- getClass(class(cop)) # so extends( . , "..") is efficient 38 | if(extends(cls, "copula")) { 39 | if(extends(cls, "normalCopula")) "normal" 40 | else if(extends(cls, "tCopula")) "t" 41 | else stop("unsupported copula family") 42 | } else if(extends(cls, "outer_nacopula")) { 43 | cop@copula@name # could be nested or not 44 | } else stop("not yet supported copula object") 45 | } 46 | 47 | ##' @title Copula family for the given copula object 48 | ##' @param cop copula object (either elliptical or (nested) Archimedean) 49 | ##' @return family string 50 | ##' @author Marius Hofert 51 | copFamilyClass <- function(family) 52 | { 53 | if(family == "normal" || family == "t") 54 | "ellipCopula" 55 | else if(family %in% .ac.longNames || 56 | family %in% paste0("opower:", .ac.longNames)) 57 | "outer_nacopula" # note: opower not really supported yet 58 | else stop("family ", family, " not yet supported") 59 | } 60 | 61 | -------------------------------------------------------------------------------- /R/zzz.R: -------------------------------------------------------------------------------- 1 | ### --- At the end, when "everything" is defined --- 2 | 3 | fitCopula_methods <- eval(formals(fitCopula_dflt)$method) 4 | 5 | .copulaEnv <- new.env(parent = emptyenv(), hash = FALSE)# e.g., for once-per-session warnings 6 | 7 | 8 | if(FALSE) { ## <<--- 2016-07-28 --- The following kills hasMethod(, ) 9 | 10 | ## the generics for which we may want to have "bail out" methods: 11 | .thisEnv <- environment()# == asNamespace("copula") but not yet 12 | gg <- local({ 13 | g <- getGenerics(.thisEnv) 14 | g <- g[g@package == "copula"] 15 | funs <- lapply(g, function(fnam) get(fnam, mode="function", envir=.thisEnv)) 16 | ## those that have 1st arg 'copula': 17 | g[vapply(lapply(funs, formals), function(f) names(f[1]) == "copula", logical(1))] 18 | }) 19 | 20 | ## bail out methods for everything --- only called if no method for *sub*class exists: 21 | ## i.e., almost always if not yet implemented for 'nacopula': 22 | 23 | ## a1 <- vapply(gg, function(gn) length(formals(gn)) == 1, logical(1)) 24 | ## for(gname in gg[a1]) 25 | ## setMethod(gname, "Copula", function(copula) 26 | ## stop(gettextf("%s() method for class \"%s\" not yet implemented", 27 | ## .Generic, class(copula)))) 28 | ## for(gname in gg[!a1]) { # possibly more than one arg -- use correct argument list 29 | for(gname in gg) { # possibly more than one arg -- use correct argument list 30 | f <- getDataPart(getGeneric(gname, where=.thisEnv)) 31 | body(f) <- bquote(stop(gettextf("%s() method for class \"%s\" not yet implemented", 32 | .Generic, class(copula)))) 33 | setMethod(gname, "Copula", f) 34 | } 35 | rm(gg, .thisEnv) 36 | 37 | }## no longer (2016-07-28) 38 | -------------------------------------------------------------------------------- /build/partial.rdb: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/copula/1251bec7d5eb868a01e417aeb0d11b58a36f9911/build/partial.rdb -------------------------------------------------------------------------------- /build/vignette.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/copula/1251bec7d5eb868a01e417aeb0d11b58a36f9911/build/vignette.rds -------------------------------------------------------------------------------- /data/SMI.12.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/copula/1251bec7d5eb868a01e417aeb0d11b58a36f9911/data/SMI.12.rda -------------------------------------------------------------------------------- /data/gasoil.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/copula/1251bec7d5eb868a01e417aeb0d11b58a36f9911/data/gasoil.rda -------------------------------------------------------------------------------- /data/loss.tab.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/copula/1251bec7d5eb868a01e417aeb0d11b58a36f9911/data/loss.tab.gz -------------------------------------------------------------------------------- /data/rdj.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/copula/1251bec7d5eb868a01e417aeb0d11b58a36f9911/data/rdj.rda -------------------------------------------------------------------------------- /data/uranium.tab.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/copula/1251bec7d5eb868a01e417aeb0d11b58a36f9911/data/uranium.tab.gz -------------------------------------------------------------------------------- /demo/00Index: -------------------------------------------------------------------------------- 1 | fitting-tests Tests of fitCopula 2 | estimation.gof Estimation and goodness-of-fit capabilities 3 | estimation_via_HAC Estimation procedure from the HAC package 4 | gofCopula Goodness-of-fit test for copula models 5 | gof_graph Graphical goodness-of-fit based on pairwise Rosenblatt transforms 6 | G_ak Coefficients a_k for Gumbel's density derivatives, MLE, etc 7 | opC-demo Outer power copula (Clayton only, for now) 8 | polyGJ Investigating precision and run time of polyG and polyJ 9 | dDiag-plots Plotting dDiag() densities (over range of families, theta, d) 10 | dDiag-plots-part-2 Contiuation of above 'dDiag-plots' 11 | tail_compatibility Demo accompanying the tail compatibility paper 12 | timings Using timing() to measure speed of basic Archimedean families 13 | retstable Computation of exponentially tilted stable random variates 14 | -------------------------------------------------------------------------------- /demo/estimation_via_HAC.R: -------------------------------------------------------------------------------- 1 | ## Copyright (C) 2012 Marius Hofert, Ivan Kojadinovic, Martin Maechler, and Jun Yan 2 | ## 3 | ## This program is free software; you can redistribute it and/or modify it under 4 | ## the terms of the GNU General Public License as published by the Free Software 5 | ## Foundation; either version 3 of the License, or (at your option) any later 6 | ## version. 7 | ## 8 | ## This program is distributed in the hope that it will be useful, but WITHOUT 9 | ## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 10 | ## FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | ## details. 12 | ## 13 | ## You should have received a copy of the GNU General Public License along with 14 | ## this program; if not, see . 15 | 16 | ### This demo shows how the HAC package can be used for estimationg NACs 17 | 18 | require(HAC) 19 | require(copula) 20 | 21 | ## Build an 'nacopula' object (nested Archimedean copula (NAC)) 22 | theta <- 2:5 23 | copG <- onacopulaL("Gumbel", list(theta[1], NULL, list(list(theta[2], c(2,1)), 24 | list(theta[4], c(5,6)), 25 | list(theta[3], c(4,3))))) 26 | ## Sample from copG 27 | set.seed(271) 28 | U <- pobs(rnacopula(1000, copula=copG)) 29 | 30 | ## fitCopula(copG, U) does not provide fitting capabilities for HACs/NACs yet 31 | ## but we can convert copG to a 'hac' object 32 | hacG <- nacopula2hac(copG) 33 | plot(hacG) # plot method 34 | 35 | ## Parameters of the nested Gumbel copula can either be estimated 36 | ## based on a fixed structure... 37 | colnames(U) <- paste(1:ncol(U)) 38 | hac.fixed <- estimate.copula(U, hac=hacG) # defaults: type = 1 (Gumbel), method = 1 (MPLE) 39 | ## ... or the structure of the Gumbel copula can be estimated as well: 40 | hac.flex <- estimate.copula(U, type=hacG$type) 41 | ## Note: 42 | ## estimate.copula(, hac = ...) calls .QML() internally which proceeds as follows: 43 | ## 1) Compute matrix (tau_{ij}) of pairwise maximum (log-)likelihood estimators (via tau) 44 | ## 2) Determine the pair (i,j) ('pair') with maximal tau_{ij} and convert it to theta_{ij} 45 | ## (see tau2theta()) 46 | ## 3) Replace U[,i] by delta(max{U_i,U_j}) (~ U(0,1)) for delta(u) = phi(2 * phi^{-1}(u)) 47 | ## and remove U[,j] (see .cop.T()) 48 | ## 4) Repeat this process until there is an associated estimate of theta for the whole path 49 | ## of variables. They then determine the estimates for all parameters in the given 50 | ## nested structure (see .union() and .compare.one() therein) 51 | 52 | ## Show the estimates 53 | plot(hac.fixed) 54 | plot(hac.flex) 55 | 56 | ## Last but not least, the estimation results can be re-converted 57 | ## into 'nacopula'-objects again 58 | cop.fixed <- hac2nacopula(hac.fixed) 59 | cop.flex <- hac2nacopula(hac.flex) 60 | -------------------------------------------------------------------------------- /demo/fitting-tests.R: -------------------------------------------------------------------------------- 1 | #### Testing fitCopula 2 | ###################################### 3 | 4 | require(copula) 5 | 6 | source(system.file("Rsource", "tstFit-fn.R", package="copula", mustWork=TRUE)) 7 | ## ../inst/Rsource/tstFit-fn.R 8 | 9 | options(nwarnings = 2000)# default 50 - only keeps the 50 last warnings.. 10 | 11 | 12 | ## test code 13 | system.time( 14 | rr <- tstFit1cop(normalCopula(), tau.set=seq(0.2,0.8,by=0.2), n.set=c(25,50,100,200), N=200) 15 | ) 16 | ## ~ 400 seconds 17 | ## well, now (2012-09-17, lynne) faster: 18 | ## user system elapsed 19 | ## 201.006 0.167 203.282 20 | 21 | d <- reshape.tstFit(rr) 22 | plots.tstFit(d)# MM: log-scale desirable but ugly tick labelling 23 | 24 | plots.tstFit(d, log=FALSE) 25 | 26 | 27 | ## t-copula instead of normal -- small set for testing here: 28 | set.seed(17) 29 | system.time( 30 | rrt <- tstFit1cop(tCopula(df.fixed=TRUE), 31 | tau.set=c(.4, .8), 32 | n.set=c(10, 50, 200), N=128) 33 | ) 34 | plots.tstFit(reshape.tstFit(rrt)) 35 | 36 | 37 | ## Fit a tevCopula() :... still somewhat frequent optim errors(), 38 | ## from non-finite loglikCopula() values: 39 | set.seed(3) 40 | rf <- replFitCop(tevCopula(.6, df.fixed=TRUE), 41 | n = 25, N = 40, estimate.variance=FALSE) 42 | warnings() # 11 warnings (out of N = 40) 43 | ## In .local(copula, tau, ...) : tau is out of the range [0, 1] 44 | ## In .local(copula, rho, ...) : rho is out of the range [0, 1] 45 | 46 | ## 47 | set.seed(321) 48 | system.time( 49 | rtev <- tstFit1cop(tevCopula(df.fixed=TRUE), 50 | tau.set= seq(0.2,0.8, by=0.2), 51 | n.set = c(25,50,100,200), N=200, 52 | estimate.variance = FALSE)##- not implemented, as: 53 | ## there is no formula for dcdtheta*() for this copula 54 | ) 55 | ## user system elapsed 56 | ## 1279.605 0.625 1290.210 57 | ## There were 50 or more warnings (use warnings() to see the first 50) 58 | ## an all are either irho or itau related: 59 | ## 47: In .local(copula, rho, ...) : rho is out of the range [0, 1] 60 | ## 50: In .local(copula, tau, ...) : tau is out of the range [0, 1] 61 | warnings() 62 | plots.tstFit(reshape.tstFit(rtev)) 63 | ## "mpl" often not plotted {"NA"} 64 | 65 | proc.time() 66 | -------------------------------------------------------------------------------- /demo/gofCopula.R: -------------------------------------------------------------------------------- 1 | ## Copyright (C) 2012 Marius Hofert, Ivan Kojadinovic, Martin Maechler, and Jun Yan 2 | ## 3 | ## This program is free software; you can redistribute it and/or modify it under 4 | ## the terms of the GNU General Public License as published by the Free Software 5 | ## Foundation; either version 3 of the License, or (at your option) any later 6 | ## version. 7 | ## 8 | ## This program is distributed in the hope that it will be useful, but WITHOUT 9 | ## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 10 | ## FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | ## details. 12 | ## 13 | ## You should have received a copy of the GNU General Public License along with 14 | ## this program; if not, see . 15 | 16 | ##>>> NOTA BENE must contain exactly the \dontrun{} part of 17 | ## ../man/gofCopula.Rd 18 | ## =================== 19 | 20 | ## A two-dimensional data example ---------------------------------- 21 | x <- rCopula(200, claytonCopula(3)) 22 | 23 | ## Does the Gumbel family seem to be a good choice (statistic "Sn")? 24 | gofCopula(gumbelCopula(), x) 25 | ## With "SnC", really s..l..o..w.. --- with "SnB", *EVEN* slower 26 | gofCopula(gumbelCopula(), x, method = "SnC", trafo.method = "cCopula") 27 | ## What about the Clayton family? 28 | gofCopula(claytonCopula(), x) 29 | 30 | ## Similar with a different estimation method 31 | gofCopula(gumbelCopula (), x, estim.method="itau") 32 | gofCopula(claytonCopula(), x, estim.method="itau") 33 | 34 | 35 | ## A three-dimensional example ------------------------------------ 36 | x <- rCopula(200, tCopula(c(0.5, 0.6, 0.7), dim = 3, dispstr = "un")) 37 | 38 | ## Does the Gumbel family seem to be a good choice? 39 | g.copula <- gumbelCopula(dim = 3) 40 | gofCopula(g.copula, x) 41 | ## What about the t copula? 42 | t.copula <- tCopula(dim = 3, dispstr = "un", df.fixed = TRUE) 43 | if(FALSE) ## this is *VERY* slow currently 44 | gofCopula(t.copula, x) 45 | 46 | ## The same with a different estimation method 47 | gofCopula(g.copula, x, estim.method="itau") 48 | if(FALSE) # still really slow 49 | gofCopula(t.copula, x, estim.method="itau") 50 | 51 | ## The same using the multiplier approach 52 | gofCopula(g.copula, x, simulation="mult") 53 | gofCopula(t.copula, x, simulation="mult") 54 | if(FALSE) # no yet possible 55 | gofCopula(t.copula, x, simulation="mult", estim.method="itau") 56 | -------------------------------------------------------------------------------- /inst/Rsource/cops.R: -------------------------------------------------------------------------------- 1 | 2 | ## Look at all non-virtual classes: 3 | copClasses <- function(notYet = c("schlatherCopula")) { 4 | stopifnot(require("copula")) 5 | copcl <- unique(names(getClass("copula")@subclasses)) 6 | isVirt <- vapply(copcl, isVirtualClass, NA) 7 | copcl <- copcl[!isVirt] 8 | copcl[notYet != copcl] #copcl[-match(notYet, copcl)] 9 | } 10 | copcl <- copClasses() 11 | 12 | ## TODO: Generalize to allow 'dim = 3' 13 | ## ---- ==> take only those which have a 'dim' argument 14 | ##' generates a list of copulas (dim = 2) from their class names 15 | copObjs <- function(cl, first.arg = c("dim", "param"), 16 | exclude = c("indepCopula", "lowfhCopula", "upfhCopula", "moCopula"), # don't have iTau(), for example. 17 | envir = asNamespace("copula")) 18 | { 19 | copF <- sapply(cl, get, envir=envir) 20 | frstArg <- vapply(copF, function(F) names(formals(F))[[1]], "") 21 | copF1 <- copF[frstArg %in% first.arg] 22 | objs <- lapply(copF1, function(.) .()) 23 | stopifnot(sapply(objs, is, class2 = "copula"), 24 | sapply(objs, validObject)) 25 | if(length(exclude)) objs[ !(names(objs) %in% exclude) ] else objs 26 | } 27 | copObs <- copObjs(copcl) 28 | if(FALSE) ## including the indepCopula 29 | str(copObjs(copcl, exclude=NULL), max.level = 1) 30 | 31 | copcl. <- names(copObs)# not including "indepCopula" 32 | 33 | copO.2 <- copObs[excl.2 <- !(copcl. %in% c("amhCopula", "joeCopula", "tCopula"))] 34 | # because AMH has limited tau-range and t copula no iRho() 35 | copBnds <- sapply(copObs, function(C) 36 | c(min= C@param.lowbnd[1], max= C@param.upbnd[1])) 37 | copBnd.2 <- copBnds[, excl.2] 38 | 39 | if(FALSE) { ## inspect 40 | copcl 41 | str(copObs, max.level=1) 42 | ## The parameter bounds: 43 | t(copBnds) 44 | } 45 | 46 | -------------------------------------------------------------------------------- /inst/Rsource/fixup-sapply.R: -------------------------------------------------------------------------------- 1 | ## Copyright (C) 2012 Marius Hofert, Ivan Kojadinovic, Martin Maechler, and Jun Yan 2 | ## 3 | ## This program is free software; you can redistribute it and/or modify it under 4 | ## the terms of the GNU General Public License as published by the Free Software 5 | ## Foundation; either version 3 of the License, or (at your option) any later 6 | ## version. 7 | ## 8 | ## This program is distributed in the hope that it will be useful, but WITHOUT 9 | ## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 10 | ## FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | ## details. 12 | ## 13 | ## You should have received a copy of the GNU General Public License along with 14 | ## this program; if not, see . 15 | 16 | 17 | ## sapply() cannot (yet!) produce ## higher-level arrays 18 | ## Martin's version of 2.13.0 : 19 | simplify2array <- function(x, higher = TRUE) 20 | { 21 | if(length(common.len <- unique(unlist(lapply(x, length)))) > 1L) 22 | return(x) 23 | if(common.len == 1L) 24 | unlist(x, recursive = FALSE) 25 | else if(common.len > 1L) { 26 | n <- length(x) 27 | ## make sure that array(*) will not call rep() {e.g. for 'call's}: 28 | r <- as.vector(unlist(x, recursive = FALSE)) 29 | if(higher && length(c.dim <- unique(lapply(x, dim))) == 1 && 30 | is.numeric(c.dim <- c.dim[[1L]]) && 31 | prod(d <- c(c.dim, n)) == length(r)) { 32 | 33 | iN1 <- is.null(n1 <- dimnames(x[[1L]])) 34 | n2 <- names(x) 35 | dnam <- 36 | if(!(iN1 && is.null(n2))) 37 | c(if(iN1) rep.int(list(n1), length(c.dim)) else n1, 38 | list(n2)) ## else NULL 39 | array(r, dim = d, dimnames = dnam) 40 | 41 | } else if(prod(d <- c(common.len, n)) == length(r)) 42 | array(r, dim = d, 43 | dimnames= if(!(is.null(n1 <- names(x[[1L]])) & 44 | is.null(n2 <- names(x)))) list(n1,n2)) 45 | else x 46 | } 47 | else x 48 | } 49 | 50 | sapply <- function(X, FUN, ..., simplify = TRUE, USE.NAMES = TRUE) 51 | { 52 | FUN <- match.fun(FUN) 53 | answer <- lapply(X, FUN, ...) 54 | if(USE.NAMES && is.character(X) && is.null(names(answer))) 55 | names(answer) <- X 56 | if(!identical(simplify, FALSE) && length(answer)) 57 | simplify2array(answer, higher = (simplify == "array")) 58 | else answer 59 | } 60 | -------------------------------------------------------------------------------- /inst/doc/AC_Liouville.R: -------------------------------------------------------------------------------- 1 | ## ----prelim, echo=FALSE------------------------------------------------------- 2 | ## lower resolution - less size (default dpi = 72): 3 | knitr::opts_chunk$set(dpi = 48) 4 | 5 | ## ----pkg+sourc, message=FALSE------------------------------------------------- 6 | require(copula) 7 | source(system.file("Rsource", "AC-Liouville.R", package="copula")) 8 | set.seed(271) 9 | 10 | ## ----rACsimp------------------------------------------------------------------ 11 | n <- 1000 12 | theta <- 0.59 13 | d <- 3 14 | U <- rACsimplex(n, d=d, theta=theta, Rdist="Gamma") 15 | cor(U, method="kendall") 16 | 17 | ## ----pairs-rACsimp, fig.align="center", fig.width=6, fig.height=6------------- 18 | par(pty="s") 19 | pairs(U, gap=0, pch=".") # or cex=0.5 20 | 21 | ## ----Liouville---------------------------------------------------------------- 22 | n <- 2000 23 | theta <- 0.6 24 | alpha <- c(1, 5, 20) 25 | U <- rLiouville(n, alpha=alpha, theta=theta, Rdist="Gamma") 26 | cor(U, method="kendall") 27 | 28 | ## ----pairs-Liouville, fig.align="center", fig.width=6, fig.height=6----------- 29 | par(pty="s") 30 | pairs(U, gap=0, pch=".") # or cex=0.5 31 | 32 | ## ----ACLiou------------------------------------------------------------------- 33 | n <- 1000 34 | theta <- 0.59 35 | alpha <- c(1, 3, 4) 36 | U <- rACLiouville(n, alpha=alpha, theta=theta, family="Clayton") 37 | cor(U, method="kendall") 38 | 39 | ## ----pairs-ACLiou, fig.align="center", fig.width=6, fig.height=6-------------- 40 | par(pty="s") 41 | pairs(U, gap=0, pch=".") # or cex=0.5 42 | 43 | -------------------------------------------------------------------------------- /inst/doc/AC_Liouville.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: Archimedean Liouville Copulas 3 | author: Marius Hofert 4 | date: '`r Sys.Date()`' 5 | output: 6 | html_vignette: 7 | css: style.css 8 | vignette: > 9 | %\VignetteEngine{knitr::rmarkdown} 10 | %\VignetteIndexEntry{Archimedean Liouville Copulas} 11 | --- 12 | ```{r prelim, echo=FALSE} 13 | ## lower resolution - less size (default dpi = 72): 14 | knitr::opts_chunk$set(dpi = 48) 15 | ```{r pkg+sourc, message=FALSE} 16 | require(copula) 17 | source(system.file("Rsource", "AC-Liouville.R", package="copula")) 18 | set.seed(271) 19 | ``` 20 | 21 | ## Archimedean-Simplex copulas 22 | 23 | ```{r rACsimp} 24 | n <- 1000 25 | theta <- 0.59 26 | d <- 3 27 | U <- rACsimplex(n, d=d, theta=theta, Rdist="Gamma") 28 | cor(U, method="kendall") 29 | ``` 30 | 31 | ```{r pairs-rACsimp, fig.align="center", fig.width=6, fig.height=6} 32 | par(pty="s") 33 | pairs(U, gap=0, pch=".") # or cex=0.5 34 | ``` 35 | 36 | 37 | ## Liouville copulas 38 | 39 | See McNeil, Neslehova (2010, Figure 3) 40 | 41 | ```{r Liouville} 42 | n <- 2000 43 | theta <- 0.6 44 | alpha <- c(1, 5, 20) 45 | U <- rLiouville(n, alpha=alpha, theta=theta, Rdist="Gamma") 46 | cor(U, method="kendall") 47 | ``` 48 | 49 | ```{r pairs-Liouville, fig.align="center", fig.width=6, fig.height=6} 50 | par(pty="s") 51 | pairs(U, gap=0, pch=".") # or cex=0.5 52 | ``` 53 | 54 | 55 | ## Archimedean-Liouville copulas 56 | 57 | See McNeil, Neslehova (2010, Figure 4) 58 | 59 | ```{r ACLiou} 60 | n <- 1000 61 | theta <- 0.59 62 | alpha <- c(1, 3, 4) 63 | U <- rACLiouville(n, alpha=alpha, theta=theta, family="Clayton") 64 | cor(U, method="kendall") 65 | ``` 66 | 67 | ```{r pairs-ACLiou, fig.align="center", fig.width=6, fig.height=6} 68 | par(pty="s") 69 | pairs(U, gap=0, pch=".") # or cex=0.5 70 | ``` 71 | 72 | -------------------------------------------------------------------------------- /inst/doc/AR_Clayton.R: -------------------------------------------------------------------------------- 1 | ## ----message=FALSE------------------------------------------------------------ 2 | require(copula) 3 | set.seed(271) 4 | 5 | ## ----------------------------------------------------------------------------- 6 | mu <- 0 7 | sigma <- 1 8 | df <- 3 9 | alpha <- 10 10 | 11 | ## ----------------------------------------------------------------------------- 12 | rtls <- function(n, df, mu, sigma) sigma * rt(n,df) + mu 13 | ptls <- function(x, df, mu, sigma) pt((x - mu)/sigma,df) 14 | qtls <- function(u, df, mu, sigma) sigma * qt(u,df) + mu 15 | dtls <- function(u, df, mu, sigma) dt((x - mu)/sigma,df)/sigma 16 | 17 | ## ----------------------------------------------------------------------------- 18 | rclayton <- function(n, alpha) { 19 | u <- runif(n+1) # innovations 20 | v <- u 21 | for(i in 2:(n+1)) 22 | v[i] <- ((u[i]^(-alpha/(1+alpha)) -1)*v[i-1]^(-alpha) +1)^(-1/alpha) 23 | v[2:(n+1)] 24 | } 25 | n <- 200 26 | u <- rclayton(n, alpha = alpha) 27 | u <- qtls(u, df=df, mu=mu, sigma=sigma) 28 | y <- u[-n] 29 | x <- u[-1] 30 | 31 | ## ----------------------------------------------------------------------------- 32 | fitCopula(claytonCopula(dim=2), 33 | cbind(ptls(x,df,mu,sigma), ptls(y,df,mu,sigma))) 34 | 35 | ## ----------------------------------------------------------------------------- 36 | ## Identical margins 37 | M2tlsI <- mvdc(claytonCopula(dim=2), c("tls","tls"), 38 | rep(list(list(df=NA, mu=NA, sigma=NA)), 2), marginsIdentical= TRUE) 39 | (fit.id.mar <- fitMvdc(cbind(x,y), M2tlsI, start=c(3,1,1, 10))) 40 | 41 | ## Not necessarily identical margins 42 | M2tls <- mvdc(claytonCopula(dim=2), c("tls","tls"), 43 | rep(list(list(df=NA, mu=NA, sigma=NA)), 2)) 44 | fitMvdc(cbind(x,y), M2tls, start=c(3,1,1, 3,1,1, 10)) 45 | 46 | ## ----fig.align="center", fig.width=6, fig.height=6---------------------------- 47 | u.cond <- function(z, tau, df, mu, sigma, alpha) 48 | ((tau^(-alpha/(1+alpha)) -1) * ptls(z,df,mu,sigma)^(-alpha) + 1) ^ (-1/alpha) 49 | y.cond <- function(z, tau, df, mu, sigma, alpha) { 50 | u <- u.cond(z, tau, df, mu, sigma, alpha) 51 | qtls(u, df=df, mu=mu, sigma=sigma) 52 | } 53 | plot(x, y) 54 | title("True and estimated conditional quantile functions") 55 | mtext(quote("for" ~~ tau == (1:5)/6)) 56 | z <- seq(min(y),max(y),len = 60) 57 | for(i in 1:5) { 58 | tau <- i/6 59 | lines(z, y.cond(z, tau, df,mu,sigma, alpha)) 60 | ## and compare with estimate: 61 | b <- fit.id.mar@estimate 62 | lines(z, y.cond(z, tau, df=b[1], mu=b[2], sigma=b[3], alpha=b[4]), 63 | col="red") 64 | } 65 | 66 | -------------------------------------------------------------------------------- /inst/doc/Frank-Rmpfr.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/copula/1251bec7d5eb868a01e417aeb0d11b58a36f9911/inst/doc/Frank-Rmpfr.pdf -------------------------------------------------------------------------------- /inst/doc/mlogL_mpfr_i686.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/copula/1251bec7d5eb868a01e417aeb0d11b58a36f9911/inst/doc/mlogL_mpfr_i686.rds -------------------------------------------------------------------------------- /inst/doc/mlogL_mpfr_x86_64.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/copula/1251bec7d5eb868a01e417aeb0d11b58a36f9911/inst/doc/mlogL_mpfr_x86_64.rds -------------------------------------------------------------------------------- /inst/doc/nacopula-pkg.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/copula/1251bec7d5eb868a01e417aeb0d11b58a36f9911/inst/doc/nacopula-pkg.pdf -------------------------------------------------------------------------------- /inst/doc/rhoAMH-dilog.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/copula/1251bec7d5eb868a01e417aeb0d11b58a36f9911/inst/doc/rhoAMH-dilog.pdf -------------------------------------------------------------------------------- /inst/docs/mathnb/README: -------------------------------------------------------------------------------- 1 | archmCPdf.m: Mathematica code that generates expressions of Archimedean copula 2 | cdf, pdf, and genfun derivatives; the maximum dimension for Frank 3 | is determined to be 4, otherwise, the system run out of memory. 4 | In particular, derPdfWrtPar is the toughest one to get. 5 | 6 | evcopula.nb: Mathematica notebook that generates expressions of extreme value 7 | copula cdf, pdf, and deriv1cdf 8 | 9 | exprPrep.R: R code that reads the expression files and generate R objects 10 | into files ../../R/*Expr.R . 11 | 12 | The input of algr2dump is a copula which has cdf and pdf expressions 13 | in exprdist. It generates these files: claytonExpr.R, 14 | gumbelExpr.R, frankExpr.R, amhExpr.R, plackettExpr.R, 15 | galambosExpr.R, huslerReissExpr.R. 16 | 17 | 18 | getDerExpr.m: Abandoned Mathematica code that generates derivative expressions. 19 | Reason of abandoning: after reading pdf expressions back in, 20 | they are not exactly the same as before. Why? 21 | -------------------------------------------------------------------------------- /inst/docs/mathnb/amhCopula.cdf.expr: -------------------------------------------------------------------------------- 1 | u1 2 | -((u1*u2)/(-1 + alpha*(-1 + u1)*(-1 + u2))) -------------------------------------------------------------------------------- /inst/docs/mathnb/amhCopula.cdfDerWrtArg.expr: -------------------------------------------------------------------------------- 1 | 1 2 | ((1 + alpha*(-1 + u2))*u2)/(-1 + alpha*(-1 + u1)*(-1 + u2))**2 -------------------------------------------------------------------------------- /inst/docs/mathnb/amhCopula.cdfDerWrtPar.expr: -------------------------------------------------------------------------------- 1 | 0 2 | ((-1 + u1)*u1*(-1 + u2)*u2)/(-1 + alpha*(-1 + u1)*(-1 + u2))**2 -------------------------------------------------------------------------------- /inst/docs/mathnb/amhCopula.genfun.expr: -------------------------------------------------------------------------------- 1 | List((-1 + alpha)/((1 + alpha*(-1 + u))*u),-(((-1 + alpha)*(1 + alpha*(-1 + 2*u)))/((1 + alpha*(-1 + u))**2*u**2))) -------------------------------------------------------------------------------- /inst/docs/mathnb/amhCopula.genfunDer.expr: -------------------------------------------------------------------------------- 1 | (-1 + alpha)/((1 + alpha*(-1 + u))*u) 2 | -(((-1 + alpha)*(1 + alpha*(-1 + 2*u)))/((1 + alpha*(-1 + u))**2*u**2)) -------------------------------------------------------------------------------- /inst/docs/mathnb/amhCopula.pdf.expr: -------------------------------------------------------------------------------- 1 | 1 2 | -((1 + alpha**2*(-1 + u1)*(-1 + u2) + alpha*(-2 + u1 + u2 + u1*u2))/(-1 + alpha*(-1 + u1)*(-1 + u2))**3) -------------------------------------------------------------------------------- /inst/docs/mathnb/amhCopula.pdfDerWrtArg.expr: -------------------------------------------------------------------------------- 1 | 0 2 | (2*alpha*(-1 + alpha**2*(-1 + u1)*(-1 + u2)**2 + 2*u2 + alpha*(-1 + u2)*(-2 + u1 + 2*u2 + u1*u2)))/(-1 + alpha*(-1 + u1)*(-1 + u2))**4 -------------------------------------------------------------------------------- /inst/docs/mathnb/amhCopula.pdfDerWrtPar.expr: -------------------------------------------------------------------------------- 1 | 0 2 | (alpha**2*(-1 + u1)**2*(-1 + u2)**2 + (-1 + 2*u1)*(-1 + 2*u2) + 2*alpha*(-1 + u1)*(-1 + u2)*(-1 + u1 + u2 + u1*u2))/(-1 + alpha*(-1 + u1)*(-1 + u2))**4 -------------------------------------------------------------------------------- /inst/docs/mathnb/archmDer.m: -------------------------------------------------------------------------------- 1 | (* 2 | To get both input and output lines use the following in the firstline: 3 | AppendTo[$Echo, "stdout"] 4 | 5 | To run the input file in background: 6 | nohup time math < archmDer.m > archmDer.out & 7 | 8 | *) 9 | 10 | AppendTo[$Echo, "stdout"] 11 | 12 | frankGenFun[x_] := -Log[(Exp[-alpha*x] - 1)/(Exp[-alpha] - 1)] 13 | frankGenInv[s_] := -1/alpha*Log[1 + Exp[-s]*(Exp[-alpha] - 1)] 14 | 15 | claytonGenFun[x_] := x^(-alpha) - 1 16 | claytonGenInv[s_] := (1 + s)^(-1/alpha) 17 | 18 | gumbelGenFun[x_] := ( - Log[x] )^alpha 19 | gumbelGenInv[s_] := Exp[-s ^(1 / alpha)] 20 | 21 | amhGenFun[x_] := Log[ (1 - alpha (1 - x) ) / x ] 22 | amhGenInv[s_] := (1 - alpha) / (Exp[s] - alpha) 23 | 24 | myD[f_, x_, n_] := Module[{df, i}, 25 | df[0] = f; 26 | For[i = 1, i <= n, i++, 27 | df[i] = Simplify[D[df[i - 1], x]]; 28 | ]; 29 | Table[df[i], {i, 1, n}] 30 | ] 31 | uu = List[u1, u2, u3, u4, u5, u6, u7, u8, u9, u10] 32 | 33 | mypdf[gfun_, ginv_, n_] := Module[ 34 | {di, df, ss, part1, part2, val}, 35 | di[s_] = Simplify[D[ginv[s], {s, n}]]; 36 | df[u_] = Simplify[D[gfun[u], u]]; 37 | ss = Sum[gfun[uu[[i]]], {i, 1, n}]; 38 | part1 = Simplify[di[ss]]; 39 | part2 = Simplify[Product[df[uu[[i]]], {i, 1, n}]]; 40 | val = Simplify[part1 * part2]; 41 | val 42 | ] 43 | mycdf[gfun_, ginv_, n_] := Module[ 44 | {ss}, 45 | ss = Sum[gfun[uu[[i]]], {i, 1, n}]; 46 | Simplify[ginv[ss]] 47 | ] 48 | 49 | Export["frankCopula.pdf.expr", 50 | FortranForm[Table[mypdf[frankGenFun, frankGenInv, i], {i, 1, 6}]], "Table"] 51 | Export["frankCopula.genfun.expr", FortranForm[myD[frankGenFun[u], u, 2]], "Table"] 52 | 53 | Export["claytonCopula.pdf.expr", 54 | FortranForm[Table[mypdf[claytonGenFun, claytonGenInv, i], {i, 1, 10}]], "Table"] 55 | Export["claytonCopula.genfun.expr", FortranForm[myD[claytonGenFun[u], u, 2]], "Table"] 56 | 57 | Export["gumbelCopula.pdf.expr", 58 | FortranForm[Table[mypdf[gumbelGenFun, gumbelGenInv, i], {i, 1, 10}]], "Table"] 59 | Export["gumbelCopula.genfun.expr", FortranForm[myD[gumbelGenFun[u], u, 2]], "Table"] 60 | 61 | Export["amhCopula.pdf.expr", 62 | FortranForm[Table[mypdf[amhGenFun, amhGenInv, i], {i, 1, 2}]], "Table"] 63 | Export["amhCopula.genfun.expr", FortranForm[myD[amhGenFun[u], u, 2]], "Table"] 64 | 65 | 66 | -------------------------------------------------------------------------------- /inst/docs/mathnb/check2Ivan.R: -------------------------------------------------------------------------------- 1 | library(copula, lib.loc="../../../../copula.Rcheck") 2 | source("../../../R/claytonExpr.R") 3 | source("../../../R/gumbelExpr.R") 4 | source("../../../R/frankExpr.R") 5 | source("../../../R/plackettExpr.R") 6 | 7 | source("../../../R/E.R") 8 | 9 | source("../../../R/derCdfPdf.R") 10 | 11 | 12 | set.seed(1234) 13 | 14 | #### clayton 15 | cop <- claytonCopula(2, dim=5) 16 | u <- rCopula(10, cop) 17 | 18 | dCdtheta(cop, u) 19 | dCdu(cop, u) 20 | derPdfWrtParams(cop, u) 21 | derPdfWrtArgs(cop, u) 22 | 23 | #### gumbel 24 | cop <- gumbelCopula(2, dim=5) 25 | u <- rCopula(10, cop) 26 | 27 | dCdtheta(cop, u) 28 | dCdu(cop, u) 29 | derPdfWrtParams(cop, u) 30 | derPdfWrtArgs(cop, u) 31 | 32 | 33 | #### frank 34 | cop <- frankCopula(2, dim=5) 35 | u <- rCopula(10, cop) 36 | 37 | dCdtheta(cop, u) 38 | dCdu(cop, u) 39 | derPdfWrtParams(cop, u) 40 | derPdfWrtArgs(cop, u) 41 | 42 | #### plackett 43 | cop <- plackettCopula(2) # dim = 2 only 44 | u <- rCopula(10, cop) 45 | 46 | dCdtheta(cop, u) 47 | dCdu(cop, u) 48 | derPdfWrtParams(cop, u) 49 | derPdfWrtArgs(cop, u) 50 | -------------------------------------------------------------------------------- /inst/docs/mathnb/claytonCopula.cdf.expr: -------------------------------------------------------------------------------- 1 | (u1**(-alpha))**(-1/alpha) 2 | (-1 + u1**(-alpha) + u2**(-alpha))**(-1/alpha) 3 | (-2 + u1**(-alpha) + u2**(-alpha) + u3**(-alpha))**(-1/alpha) 4 | (-3 + u1**(-alpha) + u2**(-alpha) + u3**(-alpha) + u4**(-alpha))**(-1/alpha) 5 | (-4 + u1**(-alpha) + u2**(-alpha) + u3**(-alpha) + u4**(-alpha) + u5**(-alpha))**(-1/alpha) 6 | (-5 + u1**(-alpha) + u2**(-alpha) + u3**(-alpha) + u4**(-alpha) + u5**(-alpha) + u6**(-alpha))**(-1/alpha) 7 | (-6 + u1**(-alpha) + u2**(-alpha) + u3**(-alpha) + u4**(-alpha) + u5**(-alpha) + u6**(-alpha) + u7**(-alpha))**(-1/alpha) 8 | (-7 + u1**(-alpha) + u2**(-alpha) + u3**(-alpha) + u4**(-alpha) + u5**(-alpha) + u6**(-alpha) + u7**(-alpha) + u8**(-alpha))**(-1/alpha) 9 | (-8 + u1**(-alpha) + u2**(-alpha) + u3**(-alpha) + u4**(-alpha) + u5**(-alpha) + u6**(-alpha) + u7**(-alpha) + u8**(-alpha) + u9**(-alpha))**(-1/alpha) 10 | (-9 + u1**(-alpha) + u10**(-alpha) + u2**(-alpha) + u3**(-alpha) + u4**(-alpha) + u5**(-alpha) + u6**(-alpha) + u7**(-alpha) + u8**(-alpha) + u9**(-alpha))**(-1/alpha) -------------------------------------------------------------------------------- /inst/docs/mathnb/claytonCopula.cdfDerWrtArg.expr: -------------------------------------------------------------------------------- 1 | 1/(u1*(u1**(-alpha))**(1/alpha)) 2 | u1**(-1 - alpha)/(-1 + u1**(-alpha) + u2**(-alpha))**((1 + alpha)/alpha) 3 | u1**(-1 - alpha)/(-2 + u1**(-alpha) + u2**(-alpha) + u3**(-alpha))**((1 + alpha)/alpha) 4 | u1**(-1 - alpha)/(-3 + u1**(-alpha) + u2**(-alpha) + u3**(-alpha) + u4**(-alpha))**((1 + alpha)/alpha) 5 | u1**(-1 - alpha)/(-4 + u1**(-alpha) + u2**(-alpha) + u3**(-alpha) + u4**(-alpha) + u5**(-alpha))**((1 + alpha)/alpha) -------------------------------------------------------------------------------- /inst/docs/mathnb/claytonCopula.cdfDerWrtPar.expr: -------------------------------------------------------------------------------- 1 | (alpha*Log(u1) + Log(u1**(-alpha)))/(alpha**2*(u1**(-alpha))**(1/alpha)) 2 | ((alpha*(u2**alpha*Log(u1) + u1**alpha*Log(u2)))/(u2**alpha - u1**alpha*(-1 + u2**alpha)) + Log(-1 + u1**(-alpha) + u2**(-alpha)))/(alpha**2*(-1 + u1**(-alpha) + u2**(-alpha))**(1/alpha)) 3 | (-((alpha*(-(Log(u1)/u1**alpha) - Log(u2)/u2**alpha - Log(u3)/u3**alpha))/(-2 + u1**(-alpha) + u2**(-alpha) + u3**(-alpha))) + Log(-2 + u1**(-alpha) + u2**(-alpha) + u3**(-alpha)))/(alpha**2*(-2 + u1**(-alpha) + u2**(-alpha) + u3**(-alpha))**(1/alpha)) 4 | (-((alpha*(-(Log(u1)/u1**alpha) - Log(u2)/u2**alpha - Log(u3)/u3**alpha - Log(u4)/u4**alpha))/(-3 + u1**(-alpha) + u2**(-alpha) + u3**(-alpha) + u4**(-alpha))) + Log(-3 + u1**(-alpha) + u2**(-alpha) + u3**(-alpha) + u4**(-alpha)))/(alpha**2*(-3 + u1**(-alpha) + u2**(-alpha) + u3**(-alpha) + u4**(-alpha))**(1/alpha)) 5 | (-((alpha*(-(Log(u1)/u1**alpha) - Log(u2)/u2**alpha - Log(u3)/u3**alpha - Log(u4)/u4**alpha - Log(u5)/u5**alpha))/(-4 + u1**(-alpha) + u2**(-alpha) + u3**(-alpha) + u4**(-alpha) + u5**(-alpha))) + Log(-4 + u1**(-alpha) + u2**(-alpha) + u3**(-alpha) + u4**(-alpha) + u5**(-alpha)))/(alpha**2*(-4 + u1**(-alpha) + u2**(-alpha) + u3**(-alpha) + u4**(-alpha) + u5**(-alpha))**(1/alpha)) -------------------------------------------------------------------------------- /inst/docs/mathnb/claytonCopula.genfun.expr: -------------------------------------------------------------------------------- 1 | List(-(alpha*u**(-1 - alpha)),alpha*(1 + alpha)*u**(-2 - alpha)) -------------------------------------------------------------------------------- /inst/docs/mathnb/claytonCopula.genfunDer.expr: -------------------------------------------------------------------------------- 1 | -(alpha*u**(-1 - alpha)) 2 | alpha*(1 + alpha)*u**(-2 - alpha) -------------------------------------------------------------------------------- /inst/docs/mathnb/claytonCopula.pdf.expr: -------------------------------------------------------------------------------- 1 | 1/(u1*(u1**(-alpha))**(1/alpha)) 2 | (1 + alpha)*u1**(-1 - alpha)*u2**(-1 - alpha)*(-1 + u1**(-alpha) + u2**(-alpha))**(-2 - 1/alpha) 3 | (1 + alpha)*(1 + 2*alpha)*u1**(-1 - alpha)*u2**(-1 - alpha)*u3**(-1 - alpha)*(-2 + u1**(-alpha) + u2**(-alpha) + u3**(-alpha))**(-3 - 1/alpha) 4 | (1 + alpha)*(1 + 2*alpha)*(1 + 3*alpha)*u1**(-1 - alpha)*u2**(-1 - alpha)*u3**(-1 - alpha)*u4**(-1 - alpha)*(-3 + u1**(-alpha) + u2**(-alpha) + u3**(-alpha) + u4**(-alpha))**(-4 - 1/alpha) 5 | (1 + alpha)*(1 + 2*alpha)*(1 + 3*alpha)*(1 + 4*alpha)*u1**(-1 - alpha)*u2**(-1 - alpha)*u3**(-1 - alpha)*u4**(-1 - alpha)*u5**(-1 - alpha)*(-4 + u1**(-alpha) + u2**(-alpha) + u3**(-alpha) + u4**(-alpha) + u5**(-alpha))**(-5 - 1/alpha) 6 | (1 + alpha)*(1 + 2*alpha)*(1 + 3*alpha)*(1 + 4*alpha)*(1 + 5*alpha)*u1**(-1 - alpha)*u2**(-1 - alpha)*u3**(-1 - alpha)*u4**(-1 - alpha)*u5**(-1 - alpha)*u6**(-1 - alpha)*(-5 + u1**(-alpha) + u2**(-alpha) + u3**(-alpha) + u4**(-alpha) + u5**(-alpha) + u6**(-alpha))**(-6 - 1/alpha) 7 | (1 + alpha)*(1 + 2*alpha)*(1 + 3*alpha)*(1 + 4*alpha)*(1 + 5*alpha)*(1 + 6*alpha)*u1**(-1 - alpha)*u2**(-1 - alpha)*u3**(-1 - alpha)*u4**(-1 - alpha)*u5**(-1 - alpha)*u6**(-1 - alpha)*u7**(-1 - alpha)*(-6 + u1**(-alpha) + u2**(-alpha) + u3**(-alpha) + u4**(-alpha) + u5**(-alpha) + u6**(-alpha) + u7**(-alpha))**(-7 - 1/alpha) 8 | (1 + alpha)*(1 + 2*alpha)*(1 + 3*alpha)*(1 + 4*alpha)*(1 + 5*alpha)*(1 + 6*alpha)*(1 + 7*alpha)*u1**(-1 - alpha)*u2**(-1 - alpha)*u3**(-1 - alpha)*u4**(-1 - alpha)*u5**(-1 - alpha)*u6**(-1 - alpha)*u7**(-1 - alpha)*u8**(-1 - alpha)*(-7 + u1**(-alpha) + u2**(-alpha) + u3**(-alpha) + u4**(-alpha) + u5**(-alpha) + u6**(-alpha) + u7**(-alpha) + u8**(-alpha))**(-8 - 1/alpha) 9 | (1 + alpha)*(1 + 2*alpha)*(1 + 3*alpha)*(1 + 4*alpha)*(1 + 5*alpha)*(1 + 6*alpha)*(1 + 7*alpha)*(1 + 8*alpha)*u1**(-1 - alpha)*u2**(-1 - alpha)*u3**(-1 - alpha)*u4**(-1 - alpha)*u5**(-1 - alpha)*u6**(-1 - alpha)*u7**(-1 - alpha)*u8**(-1 - alpha)*u9**(-1 - alpha)*(-8 + u1**(-alpha) + u2**(-alpha) + u3**(-alpha) + u4**(-alpha) + u5**(-alpha) + u6**(-alpha) + u7**(-alpha) + u8**(-alpha) + u9**(-alpha))**(-9 - 1/alpha) 10 | (1 + alpha)*(1 + 2*alpha)*(1 + 3*alpha)*(1 + 4*alpha)*(1 + 5*alpha)*(1 + 6*alpha)*(1 + 7*alpha)*(1 + 8*alpha)*(1 + 9*alpha)*u1**(-1 - alpha)*u10**(-1 - alpha)*u2**(-1 - alpha)*u3**(-1 - alpha)*u4**(-1 - alpha)*u5**(-1 - alpha)*u6**(-1 - alpha)*u7**(-1 - alpha)*u8**(-1 - alpha)*u9**(-1 - alpha)*(-9 + u1**(-alpha) + u10**(-alpha) + u2**(-alpha) + u3**(-alpha) + u4**(-alpha) + u5**(-alpha) + u6**(-alpha) + u7**(-alpha) + u8**(-alpha) + u9**(-alpha))**(-10 - 1/alpha) -------------------------------------------------------------------------------- /inst/docs/mathnb/claytonCopula.pdfDerWrtArg.expr: -------------------------------------------------------------------------------- 1 | 0 2 | -(((1 + alpha)*u1**(-2 + alpha)*u2**(-1 + alpha)*(alpha*u2**alpha + (1 + alpha)*u1**alpha*(-1 + u2**alpha)))/((-1 + u1**(-alpha) + u2**(-alpha))**(1/alpha)*(-u2**alpha + u1**alpha*(-1 + u2**alpha))**3)) 3 | ((1 + alpha)*(1 + 2*alpha)*u2**(-1 - alpha)*u3**(-1 - alpha)*(-2 + u1**(-alpha) + u2**(-alpha) + u3**(-alpha))**(-4 - 1/alpha)*(1 + 3*alpha + (-1 - alpha)*u1**alpha*(-2 + u1**(-alpha) + u2**(-alpha) + u3**(-alpha))))/u1**(2*(1 + alpha)) 4 | ((1 + alpha)*(1 + 2*alpha)*(1 + 3*alpha)*u2**(-1 - alpha)*u3**(-1 - alpha)*u4**(-1 - alpha)*(-3 + u1**(-alpha) + u2**(-alpha) + u3**(-alpha) + u4**(-alpha))**(-5 - 1/alpha)*(1 + 4*alpha + (-1 - alpha)*u1**alpha*(-3 + u1**(-alpha) + u2**(-alpha) + u3**(-alpha) + u4**(-alpha))))/u1**(2*(1 + alpha)) 5 | ((1 + alpha)*(1 + 2*alpha)*(1 + 3*alpha)*(1 + 4*alpha)*u2**(-1 - alpha)*u3**(-1 - alpha)*u4**(-1 - alpha)*u5**(-1 - alpha)*(-4 + u1**(-alpha) + u2**(-alpha) + u3**(-alpha) + u4**(-alpha) + u5**(-alpha))**(-6 - 1/alpha)*(1 + 5*alpha + (-1 - alpha)*u1**alpha*(-4 + u1**(-alpha) + u2**(-alpha) + u3**(-alpha) + u4**(-alpha) + u5**(-alpha))))/u1**(2*(1 + alpha)) -------------------------------------------------------------------------------- /inst/docs/mathnb/claytonCopula.pdfDerWrtPar.expr: -------------------------------------------------------------------------------- 1 | (alpha*Log(u1) + Log(u1**(-alpha)))/(alpha**2*u1*(u1**(-alpha))**(1/alpha)) 2 | (u1**(-1 + alpha)*u2**(-1 + alpha)*(-(alpha*(1 + alpha)*(u2**alpha + alpha*(u2**alpha + u1**alpha*(-1 + u2**alpha)))*Log(u1)) - alpha*(1 + alpha)*(-(alpha*u2**alpha) + u1**alpha*(1 + alpha + alpha*u2**alpha))*Log(u2) + (-u2**alpha + u1**alpha*(-1 + u2**alpha))*(alpha**2 + (1 + alpha)*Log(-1 + u1**(-alpha) + u2**(-alpha)))))/(alpha**2*(-1 + u1**(-alpha) + u2**(-alpha))**(1/alpha)*(-u2**alpha + u1**alpha*(-1 + u2**alpha))**3) 3 | u1**(-1 - alpha)*u2**(-1 - alpha)*u3**(-1 - alpha)*(-2 + u1**(-alpha) + u2**(-alpha) + u3**(-alpha))**(-3 - 1/alpha)*(1 + 2*alpha + 2*(1 + alpha) - (1 + alpha)*(1 + 2*alpha)*Log(u1) - (1 + alpha)*(1 + 2*alpha)*Log(u2) - (1 + alpha)*(1 + 2*alpha)*Log(u3) + (1 + alpha)*(1 + 2*alpha)*(((-3 - 1/alpha)*(-(Log(u1)/u1**alpha) - Log(u2)/u2**alpha - Log(u3)/u3**alpha))/(-2 + u1**(-alpha) + u2**(-alpha) + u3**(-alpha)) + Log(-2 + u1**(-alpha) + u2**(-alpha) + u3**(-alpha))/alpha**2)) 4 | u1**(-1 - alpha)*u2**(-1 - alpha)*u3**(-1 - alpha)*u4**(-1 - alpha)*(-3 + u1**(-alpha) + u2**(-alpha) + u3**(-alpha) + u4**(-alpha))**(-4 - 1/alpha)*(1 + 5*alpha + 6*alpha**2 + 3*(1 + alpha)*(1 + 2*alpha) + 2*(1 + alpha)*(1 + 3*alpha) - (1 + alpha)*(1 + 2*alpha)*(1 + 3*alpha)*Log(u1) - (1 + alpha)*(1 + 2*alpha)*(1 + 3*alpha)*Log(u2) - (1 + alpha)*(1 + 2*alpha)*(1 + 3*alpha)*Log(u3) - (1 + alpha)*(1 + 2*alpha)*(1 + 3*alpha)*Log(u4) + (1 + alpha)*(1 + 2*alpha)*(1 + 3*alpha)*(((-4 - 1/alpha)*(-(Log(u1)/u1**alpha) - Log(u2)/u2**alpha - Log(u3)/u3**alpha - Log(u4)/u4**alpha))/(-3 + u1**(-alpha) + u2**(-alpha) + u3**(-alpha) + u4**(-alpha)) + Log(-3 + u1**(-alpha) + u2**(-alpha) + u3**(-alpha) + u4**(-alpha))/alpha**2)) 5 | u1**(-1 - alpha)*u2**(-1 - alpha)*u3**(-1 - alpha)*u4**(-1 - alpha)*u5**(-1 - alpha)*(-4 + u1**(-alpha) + u2**(-alpha) + u3**(-alpha) + u4**(-alpha) + u5**(-alpha))**(-5 - 1/alpha)*(4*(1 + alpha)*(1 + 2*alpha)*(1 + 3*alpha) + 3*(1 + alpha)*(1 + 2*alpha)*(1 + 4*alpha) + 2*(1 + alpha)*(1 + 3*alpha)*(1 + 4*alpha) + (1 + 2*alpha)*(1 + 3*alpha)*(1 + 4*alpha) - (1 + alpha)*(1 + 2*alpha)*(1 + 3*alpha)*(1 + 4*alpha)*Log(u1) - (1 + alpha)*(1 + 2*alpha)*(1 + 3*alpha)*(1 + 4*alpha)*Log(u2) - (1 + alpha)*(1 + 2*alpha)*(1 + 3*alpha)*(1 + 4*alpha)*Log(u3) - (1 + alpha)*(1 + 2*alpha)*(1 + 3*alpha)*(1 + 4*alpha)*Log(u4) - (1 + alpha)*(1 + 2*alpha)*(1 + 3*alpha)*(1 + 4*alpha)*Log(u5) + (1 + alpha)*(1 + 2*alpha)*(1 + 3*alpha)*(1 + 4*alpha)*(((-5 - 1/alpha)*(-(Log(u1)/u1**alpha) - Log(u2)/u2**alpha - Log(u3)/u3**alpha - Log(u4)/u4**alpha - Log(u5)/u5**alpha))/(-4 + u1**(-alpha) + u2**(-alpha) + u3**(-alpha) + u4**(-alpha) + u5**(-alpha)) + Log(-4 + u1**(-alpha) + u2**(-alpha) + u3**(-alpha) + u4**(-alpha) + u5**(-alpha))/alpha**2)) -------------------------------------------------------------------------------- /inst/docs/mathnb/frankCopula.cdf.expr: -------------------------------------------------------------------------------- 1 | -(Log(E**(-(alpha*u1)))/alpha) 2 | -(Log(1 + ((-1 + E**(-(alpha*u1)))*(-1 + E**(-(alpha*u2))))/(-1 + E**(-alpha)))/alpha) 3 | -(Log(1 + ((-1 + E**(-(alpha*u1)))*(-1 + E**(-(alpha*u2)))*(-1 + E**(-(alpha*u3))))/(-1 + E**(-alpha))**2)/alpha) 4 | -(Log(1 + ((-1 + E**(-(alpha*u1)))*(-1 + E**(-(alpha*u2)))*(-1 + E**(-(alpha*u3)))*(-1 + E**(-(alpha*u4))))/(-1 + E**(-alpha))**3)/alpha) 5 | -(Log(1 + ((-1 + E**(-(alpha*u1)))*(-1 + E**(-(alpha*u2)))*(-1 + E**(-(alpha*u3)))*(-1 + E**(-(alpha*u4)))*(-1 + E**(-(alpha*u5))))/(-1 + E**(-alpha))**4)/alpha) 6 | -(Log(1 + ((-1 + E**(-(alpha*u1)))*(-1 + E**(-(alpha*u2)))*(-1 + E**(-(alpha*u3)))*(-1 + E**(-(alpha*u4)))*(-1 + E**(-(alpha*u5)))*(-1 + E**(-(alpha*u6))))/(-1 + E**(-alpha))**5)/alpha) -------------------------------------------------------------------------------- /inst/docs/mathnb/frankCopula.cdfDerWrtArg.expr: -------------------------------------------------------------------------------- 1 | 1 2 | (E**alpha*(-1 + E**(alpha*u2)))/(-E**alpha + E**(alpha + alpha*u1) - E**(alpha*(u1 + u2)) + E**(alpha + alpha*u2)) 3 | ((-1 + E**(-(alpha*u2)))*(-1 + E**(-(alpha*u3))))/(E**(alpha*u1)*(-1 + E**(-alpha))**2*(1 + ((-1 + E**(-(alpha*u1)))*(-1 + E**(-(alpha*u2)))*(-1 + E**(-(alpha*u3))))/(-1 + E**(-alpha))**2)) 4 | ((-1 + E**(-(alpha*u2)))*(-1 + E**(-(alpha*u3)))*(-1 + E**(-(alpha*u4))))/(E**(alpha*u1)*(-1 + E**(-alpha))**3*(1 + ((-1 + E**(-(alpha*u1)))*(-1 + E**(-(alpha*u2)))*(-1 + E**(-(alpha*u3)))*(-1 + E**(-(alpha*u4))))/(-1 + E**(-alpha))**3)) -------------------------------------------------------------------------------- /inst/docs/mathnb/frankCopula.cdfDerWrtPar.expr: -------------------------------------------------------------------------------- 1 | (alpha*u1 + Log(E**(-(alpha*u1))))/alpha**2 2 | ((alpha*E**alpha*(-1 - E**(alpha*(u1 + u2)) - E**(alpha*u2)*(-1 + u1) + u1 + E**(alpha + alpha*u2)*u1 - E**(alpha*u1)*(-1 + u2) + u2 + E**(alpha + alpha*u1)*u2 - E**alpha*(u1 + u2)))/((-1 + E**alpha)*(-E**alpha + E**(alpha + alpha*u1) - E**(alpha*(u1 + u2)) + E**(alpha + alpha*u2))) + Log(1 + ((-1 + E**(-(alpha*u1)))*(-1 + E**(-(alpha*u2))))/(-1 + E**(-alpha))))/alpha**2 3 | (-((alpha*((2*(-1 + E**(-(alpha*u1)))*(-1 + E**(-(alpha*u2)))*(-1 + E**(-(alpha*u3))))/E**alpha + ((-1 + E**alpha)*(-1 + E**(alpha*u2))*(-1 + E**(alpha*u3))*u1)/E**(alpha*(1 + u1 + u2 + u3)) + ((-1 + E**alpha)*(-1 + E**(alpha*u1))*(-1 + E**(alpha*u3))*u2)/E**(alpha*(1 + u1 + u2 + u3)) + ((-1 + E**alpha)*(-1 + E**(alpha*u1))*(-1 + E**(alpha*u2))*u3)/E**(alpha*(1 + u1 + u2 + u3))))/((-1 + E**(-alpha))**3*(1 + ((-1 + E**(-(alpha*u1)))*(-1 + E**(-(alpha*u2)))*(-1 + E**(-(alpha*u3))))/(-1 + E**(-alpha))**2))) + Log(1 + ((-1 + E**(-(alpha*u1)))*(-1 + E**(-(alpha*u2)))*(-1 + E**(-(alpha*u3))))/(-1 + E**(-alpha))**2))/alpha**2 4 | (-((alpha*(3*(-1 + E**(alpha*u1))*(-1 + E**(alpha*u2))*(-1 + E**(alpha*u3))*(-1 + E**(alpha*u4)) - (-1 + E**alpha)*(-1 + E**(alpha*u2))*(-1 + E**(alpha*u3))*(-1 + E**(alpha*u4))*u1 - (-1 + E**alpha)*(-1 + E**(alpha*u1))*(-1 + E**(alpha*u3))*(-1 + E**(alpha*u4))*u2 - (-1 + E**alpha)*(-1 + E**(alpha*u1))*(-1 + E**(alpha*u2))*(-1 + E**(alpha*u4))*u3 - (-1 + E**alpha)*(-1 + E**(alpha*u1))*(-1 + E**(alpha*u2))*(-1 + E**(alpha*u3))*u4))/(E**(alpha*(1 + u1 + u2 + u3 + u4))*(-1 + E**(-alpha))**4*(1 + ((-1 + E**(-(alpha*u1)))*(-1 + E**(-(alpha*u2)))*(-1 + E**(-(alpha*u3)))*(-1 + E**(-(alpha*u4))))/(-1 + E**(-alpha))**3))) + Log(1 + ((-1 + E**(-(alpha*u1)))*(-1 + E**(-(alpha*u2)))*(-1 + E**(-(alpha*u3)))*(-1 + E**(-(alpha*u4))))/(-1 + E**(-alpha))**3))/alpha**2 -------------------------------------------------------------------------------- /inst/docs/mathnb/frankCopula.genfun.expr: -------------------------------------------------------------------------------- 1 | List(alpha/(1 - E**(alpha*u)),(alpha**2*E**(alpha*u))/(-1 + E**(alpha*u))**2) -------------------------------------------------------------------------------- /inst/docs/mathnb/frankCopula.genfunDer.expr: -------------------------------------------------------------------------------- 1 | alpha/(1 - E**(alpha*u)) 2 | (alpha**2*E**(alpha*u))/(-1 + E**(alpha*u))**2 -------------------------------------------------------------------------------- /inst/docs/mathnb/galambos.expr: -------------------------------------------------------------------------------- 1 | List((u1*u2)**(1 - ((1 - Log(u1)/Log(u1*u2))**(-alpha) + (Log(u1)/Log(u1*u2))**(-alpha))**(-1/alpha)),(((Log(u1)*(-Log(u1) + Log(u1*u2)))/Log(u1*u2)**2)**alpha*(2*Log(u1)*((1 - Log(u1)/Log(u1*u2))**(-alpha) + (Log(u1)/Log(u1*u2))**(-alpha))**(2/alpha)*(Log(u1) - Log(u1*u2)) - Log(u1*u2)**2 + ((1 - Log(u1)/Log(u1*u2))**(-alpha) + (Log(u1)/Log(u1*u2))**(-alpha))**(1/alpha)*Log(u1*u2)*(1 + alpha + Log(u1*u2))) + ((1 - Log(u1)/Log(u1*u2))**(-alpha) + (Log(u1)/Log(u1*u2))**(-alpha))**(1/alpha)*((1 - Log(u1)/Log(u1*u2))**(2*alpha)*(Log(u1) - Log(u1*u2))*(Log(u1)*((1 - Log(u1)/Log(u1*u2))**(-alpha) + (Log(u1)/Log(u1*u2))**(-alpha))**(1/alpha) - Log(u1*u2)) + Log(u1)*(Log(u1)/Log(u1*u2))**(2*alpha)*(((1 - Log(u1)/Log(u1*u2))**(-alpha) + (Log(u1)/Log(u1*u2))**(-alpha))**(1/alpha)*(Log(u1) - Log(u1*u2)) + Log(u1*u2))))/((u1*u2)**((1 - Log(u1)/Log(u1*u2))**(-alpha) + (Log(u1)/Log(u1*u2))**(-alpha))**(-1/alpha)*Log(u1)*((1 - Log(u1)/Log(u1*u2))**(-alpha) + (Log(u1)/Log(u1*u2))**(-alpha))**(2/alpha)*((1 - Log(u1)/Log(u1*u2))**alpha + (Log(u1)/Log(u1*u2))**alpha)**2*(Log(u1) - Log(u1*u2))),(u1*u2)**(1 - ((1 - Log(u1)/Log(u1*u2))**(-alpha) + (Log(u1)/Log(u1*u2))**(-alpha))**(-1/alpha))*((1 - ((1 - Log(u1)/Log(u1*u2))**(-alpha) + (Log(u1)/Log(u1*u2))**(-alpha))**(-1/alpha))/u1 + ((-(alpha*(Log(u1)/(u1*Log(u1*u2)**2) - 1/(u1*Log(u1*u2)))*(1 - Log(u1)/Log(u1*u2))**(-1 - alpha)) - alpha*(-(Log(u1)/(u1*Log(u1*u2)**2)) + 1/(u1*Log(u1*u2)))*(Log(u1)/Log(u1*u2))**(-1 - alpha))*((1 - Log(u1)/Log(u1*u2))**(-alpha) + (Log(u1)/Log(u1*u2))**(-alpha))**(-1 - 1/alpha)*Log(u1*u2))/alpha),AfunGalambosCopula) -------------------------------------------------------------------------------- /inst/docs/mathnb/getDerExpr.m: -------------------------------------------------------------------------------- 1 | AppendTo[$Echo, "stdout"] 2 | 3 | (* 4 | myRead[pdfExpFile_] := Module[ 5 | {expr, len}, 6 | expr = Import[pdfExpFile]; 7 | expr = StringReplace[expr, "List(" -> "{"]; 8 | len = StringLength[expr]; 9 | expr = StringReplacePart[expr, "}", {len, len}]; 10 | ToExpression[expr] 11 | ]; 12 | 13 | myDerPdfWrtArgOverPdf[pdfExpr_, i_] := Module[ 14 | {num}, 15 | num = Simplify[D[pdfExpr[[i]], u1]]; 16 | Simplify[num / pdfExpr[[i]]] 17 | ]; 18 | *); 19 | 20 | myGetDer[cname_, m_] := Module[ 21 | {Cdf, CdfDerWrtArg, CdfDerWrtPar, 22 | Pdf, PdfDerWrtArgOverPdf, PdfDerWrtParOverPdf}, 23 | Cdf = ToExpression[ReadList[cname <> "Copula.cdf.expr", "String"]]; 24 | CdfDerWrtArg = Table[Simplify[D[Cdf[[i]], u1]], {i, 1, m}]; 25 | CdfDerWrtPar = Table[Simplify[D[Cdf[[i]], alpha]], {i, 1, m}]; 26 | Export[cname <> "Copula.cdfDerWrtArg.expr", FortranForm /@ CdfDerWrtArg, "Table"]; 27 | Export[cname <> "Copula.cdfDerWrtPar.expr", FortranForm /@ CdfDerWrtPar, "Table"]; 28 | Pdf = ToExpression[ReadList[cname <> "Copula.pdf.expr", "String"]]; 29 | PdfDerWrtArgOverPdf = Table[Simplify[Simplify[D[Pdf[[i]], u1]] / Pdf[[i]]], {i, 1, m}]; 30 | Export[cname <> "Copula.pdfDerWrtArgOverPdf.expr", FortranForm /@ PdfDerWrtArgOverPdf, "Table"]; 31 | PdfDerWrtParOverPdf = Table[Simplify[Simplify[D[Pdf[[i]], alpha]] / Pdf[[i]]], {i, 1, m}]; 32 | Export[cname <> "Copula.pdfDerWrtParOverPdf.expr", FortranForm /@ PdfDerWrtParOverPdf, "Table"]; 33 | True; 34 | ]; 35 | 36 | myGetDer["clayton", 4]; 37 | myGetDer["gumbel", 4]; 38 | myGetDer["frank", 4]; 39 | 40 | 41 | 42 | -------------------------------------------------------------------------------- /inst/docs/mathnb/gumbelCopula.cdf.expr: -------------------------------------------------------------------------------- 1 | E**(-((-Log(u1))**alpha)**(1/alpha)) 2 | E**(-((-Log(u1))**alpha + (-Log(u2))**alpha)**(1/alpha)) 3 | E**(-((-Log(u1))**alpha + (-Log(u2))**alpha + (-Log(u3))**alpha)**(1/alpha)) 4 | E**(-((-Log(u1))**alpha + (-Log(u2))**alpha + (-Log(u3))**alpha + (-Log(u4))**alpha)**(1/alpha)) 5 | E**(-((-Log(u1))**alpha + (-Log(u2))**alpha + (-Log(u3))**alpha + (-Log(u4))**alpha + (-Log(u5))**alpha)**(1/alpha)) 6 | E**(-((-Log(u1))**alpha + (-Log(u2))**alpha + (-Log(u3))**alpha + (-Log(u4))**alpha + (-Log(u5))**alpha + (-Log(u6))**alpha)**(1/alpha)) 7 | E**(-((-Log(u1))**alpha + (-Log(u2))**alpha + (-Log(u3))**alpha + (-Log(u4))**alpha + (-Log(u5))**alpha + (-Log(u6))**alpha + (-Log(u7))**alpha)**(1/alpha)) 8 | E**(-((-Log(u1))**alpha + (-Log(u2))**alpha + (-Log(u3))**alpha + (-Log(u4))**alpha + (-Log(u5))**alpha + (-Log(u6))**alpha + (-Log(u7))**alpha + (-Log(u8))**alpha)**(1/alpha)) 9 | E**(-((-Log(u1))**alpha + (-Log(u2))**alpha + (-Log(u3))**alpha + (-Log(u4))**alpha + (-Log(u5))**alpha + (-Log(u6))**alpha + (-Log(u7))**alpha + (-Log(u8))**alpha + (-Log(u9))**alpha)**(1/alpha)) 10 | E**(-((-Log(u1))**alpha + (-Log(u10))**alpha + (-Log(u2))**alpha + (-Log(u3))**alpha + (-Log(u4))**alpha + (-Log(u5))**alpha + (-Log(u6))**alpha + (-Log(u7))**alpha + (-Log(u8))**alpha + (-Log(u9))**alpha)**(1/alpha)) -------------------------------------------------------------------------------- /inst/docs/mathnb/gumbelCopula.cdfDerWrtArg.expr: -------------------------------------------------------------------------------- 1 | -(((-Log(u1))**alpha)**(1/alpha)/(E**((-Log(u1))**alpha)**(1/alpha)*u1*Log(u1))) 2 | ((-Log(u1))**(-1 + alpha)*((-Log(u1))**alpha + (-Log(u2))**alpha)**(-1 + 1/alpha))/(E**((-Log(u1))**alpha + (-Log(u2))**alpha)**(1/alpha)*u1) 3 | ((-Log(u1))**(-1 + alpha)*((-Log(u1))**alpha + (-Log(u2))**alpha + (-Log(u3))**alpha)**(-1 + 1/alpha))/(E**((-Log(u1))**alpha + (-Log(u2))**alpha + (-Log(u3))**alpha)**(1/alpha)*u1) 4 | ((-Log(u1))**(-1 + alpha)*((-Log(u1))**alpha + (-Log(u2))**alpha + (-Log(u3))**alpha + (-Log(u4))**alpha)**(-1 + 1/alpha))/(E**((-Log(u1))**alpha + (-Log(u2))**alpha + (-Log(u3))**alpha + (-Log(u4))**alpha)**(1/alpha)*u1) 5 | ((-Log(u1))**(-1 + alpha)*((-Log(u1))**alpha + (-Log(u2))**alpha + (-Log(u3))**alpha + (-Log(u4))**alpha + (-Log(u5))**alpha)**(-1 + 1/alpha))/(E**((-Log(u1))**alpha + (-Log(u2))**alpha + (-Log(u3))**alpha + (-Log(u4))**alpha + (-Log(u5))**alpha)**(1/alpha)*u1) -------------------------------------------------------------------------------- /inst/docs/mathnb/gumbelCopula.cdfDerWrtPar.expr: -------------------------------------------------------------------------------- 1 | (((-Log(u1))**alpha)**(1/alpha)*(Log((-Log(u1))**alpha) - alpha*Log(-Log(u1))))/(alpha**2*E**((-Log(u1))**alpha)**(1/alpha)) 2 | (((-Log(u1))**alpha + (-Log(u2))**alpha)**(-1 + 1/alpha)*(-(alpha*(-Log(u1))**alpha*Log(-Log(u1))) + ((-Log(u1))**alpha + (-Log(u2))**alpha)*Log((-Log(u1))**alpha + (-Log(u2))**alpha) - alpha*(-Log(u2))**alpha*Log(-Log(u2))))/(alpha**2*E**((-Log(u1))**alpha + (-Log(u2))**alpha)**(1/alpha)) 3 | -((((-Log(u1))**alpha + (-Log(u2))**alpha + (-Log(u3))**alpha)**(1/alpha)*(-Log((-Log(u1))**alpha + (-Log(u2))**alpha + (-Log(u3))**alpha) + (alpha*((-Log(u1))**alpha*Log(-Log(u1)) + (-Log(u2))**alpha*Log(-Log(u2)) + (-Log(u3))**alpha*Log(-Log(u3))))/((-Log(u1))**alpha + (-Log(u2))**alpha + (-Log(u3))**alpha)))/(alpha**2*E**((-Log(u1))**alpha + (-Log(u2))**alpha + (-Log(u3))**alpha)**(1/alpha))) 4 | -((((-Log(u1))**alpha + (-Log(u2))**alpha + (-Log(u3))**alpha + (-Log(u4))**alpha)**(1/alpha)*(-Log((-Log(u1))**alpha + (-Log(u2))**alpha + (-Log(u3))**alpha + (-Log(u4))**alpha) + (alpha*((-Log(u1))**alpha*Log(-Log(u1)) + (-Log(u2))**alpha*Log(-Log(u2)) + (-Log(u3))**alpha*Log(-Log(u3)) + (-Log(u4))**alpha*Log(-Log(u4))))/((-Log(u1))**alpha + (-Log(u2))**alpha + (-Log(u3))**alpha + (-Log(u4))**alpha)))/(alpha**2*E**((-Log(u1))**alpha + (-Log(u2))**alpha + (-Log(u3))**alpha + (-Log(u4))**alpha)**(1/alpha))) 5 | -((((-Log(u1))**alpha + (-Log(u2))**alpha + (-Log(u3))**alpha + (-Log(u4))**alpha + (-Log(u5))**alpha)**(1/alpha)*(-Log((-Log(u1))**alpha + (-Log(u2))**alpha + (-Log(u3))**alpha + (-Log(u4))**alpha + (-Log(u5))**alpha) + (alpha*((-Log(u1))**alpha*Log(-Log(u1)) + (-Log(u2))**alpha*Log(-Log(u2)) + (-Log(u3))**alpha*Log(-Log(u3)) + (-Log(u4))**alpha*Log(-Log(u4)) + (-Log(u5))**alpha*Log(-Log(u5))))/((-Log(u1))**alpha + (-Log(u2))**alpha + (-Log(u3))**alpha + (-Log(u4))**alpha + (-Log(u5))**alpha)))/(alpha**2*E**((-Log(u1))**alpha + (-Log(u2))**alpha + (-Log(u3))**alpha + (-Log(u4))**alpha + (-Log(u5))**alpha)**(1/alpha))) -------------------------------------------------------------------------------- /inst/docs/mathnb/gumbelCopula.genfun.expr: -------------------------------------------------------------------------------- 1 | List((alpha*(-Log(u))**alpha)/(u*Log(u)),(alpha*(-1 + alpha - Log(u))*(-Log(u))**(-2 + alpha))/u**2) -------------------------------------------------------------------------------- /inst/docs/mathnb/gumbelCopula.genfunDer.expr: -------------------------------------------------------------------------------- 1 | (alpha*(-Log(u))**alpha)/(u*Log(u)) 2 | (alpha*(-1 + alpha - Log(u))*(-Log(u))**(-2 + alpha))/u**2 -------------------------------------------------------------------------------- /inst/docs/obsolete/dgamma.f: -------------------------------------------------------------------------------- 1 | ! Gamma function in double precision 2 | ! 3 | double precision function dgamma(x) 4 | implicit double precision (a - h, o - z) 5 | parameter ( 6 | & p0 = 0.999999999999999990d+00, 7 | & p1 = -0.422784335098466784d+00, 8 | & p2 = -0.233093736421782878d+00, 9 | & p3 = 0.191091101387638410d+00, 10 | & p4 = -0.024552490005641278d+00, 11 | & p5 = -0.017645244547851414d+00, 12 | & p6 = 0.008023273027855346d+00) 13 | parameter ( 14 | & p7 = -0.000804329819255744d+00, 15 | & p8 = -0.000360837876648255d+00, 16 | & p9 = 0.000145596568617526d+00, 17 | & p10 = -0.000017545539395205d+00, 18 | & p11 = -0.000002591225267689d+00, 19 | & p12 = 0.000001337767384067d+00, 20 | & p13 = -0.000000199542863674d+00) 21 | n = nint(x - 2) 22 | w = x - (n + 2) 23 | y = ((((((((((((p13 * w + p12) * w + p11) * w + p10) * 24 | & w + p9) * w + p8) * w + p7) * w + p6) * w + p5) * 25 | & w + p4) * w + p3) * w + p2) * w + p1) * w + p0 26 | if (n .gt. 0) then 27 | w = x - 1 28 | do k = 2, n 29 | w = w * (x - k) 30 | end do 31 | else 32 | w = 1 33 | do k = 0, -n - 1 34 | y = y * (x + k) 35 | end do 36 | end if 37 | dgamma = w / y 38 | end 39 | ! 40 | -------------------------------------------------------------------------------- /inst/docs/obsolete/try.c: -------------------------------------------------------------------------------- 1 | #include "Rinternals.h" 2 | #include "R_ext/Applic.h" 3 | 4 | double stepfn(double x, double a, double b) { 5 | return a * pow(x, 3.0) + b; 6 | } 7 | 8 | void vec_stepfn(double *x, int n, void *ex) { 9 | int i; 10 | double *ptr = ex; 11 | double At = ptr[0], t = ptr[1]; 12 | for (i = 0; i < n; i++) x[i] = stepfn(x[i], At, t); 13 | return; 14 | } 15 | 16 | void int_stepfn(double *lower, double *upper, double *ex) { 17 | double result, abserr; 18 | int last, neval, ier; 19 | int lenw; 20 | int *iwork; 21 | double *work; 22 | int limit=100; 23 | double reltol=0.00001; 24 | double abstol=0.00001; 25 | 26 | lenw = 4 * limit; 27 | iwork = (int *) R_alloc(limit, sizeof(int)); 28 | work = (double *) R_alloc(lenw, sizeof(double)); 29 | 30 | Rdqags(vec_stepfn, (void *)ex, lower, upper, 31 | &abstol, &reltol, 32 | &result, &abserr, &neval, &ier, 33 | &limit, &lenw, &last, 34 | iwork, work); 35 | 36 | printf("%f %f %d\n", result, abserr, ier); 37 | return; 38 | } 39 | 40 | -------------------------------------------------------------------------------- /inst/docs/tauRho/README.R: -------------------------------------------------------------------------------- 1 | ## generate the sysdata.rda file used in the copula package. 2 | 3 | source("trpsrho.R") 4 | source("trpstau.R") 5 | 6 | source("evtrps.R") 7 | 8 | source("getSysdataImage.R") 9 | -------------------------------------------------------------------------------- /inst/docs/tauRho/evtrps.R: -------------------------------------------------------------------------------- 1 | library(copula) ##, lib.loc="../../copula.Rcheck") 2 | library(pspline) ## avoids manually trying knots or df 3 | 4 | source("gridsetup.R") 5 | 6 | ###################################################### 7 | ## test with galambos 8 | ###################################################### 9 | thetaGrid <- seq(0.01, .999, by = .001) 10 | galambosTrFuns <- list(forwardTransf = function(x, ss) (tanh(x / ss))^0.33, 11 | backwardTransf = function(x, ss) ss * atanh(x^(1/0.33)), 12 | forwardDer = function(x, ss) 0.33 * (tanh(x / ss))^(0.33 - 1) * (1 - tanh(x / ss)^2 ) / ss 13 | ) 14 | 15 | nsim <- 0 16 | .galambosTau <- getAssoMeasFun(galambosCopula(0), thetaGrid, nsim, "kendall", c(0, 1), c(0, 1), galambosTrFuns, ss = 15, symmetrize = FALSE) 17 | 18 | nsim <- 0 19 | .galambosRho <- getAssoMeasFun(galambosCopula(0), thetaGrid, nsim, "spearman", c(0, 1), c(0, 1), galambosTrFuns, ss = 5, symmetrize = FALSE) 20 | 21 | 22 | save(.galambosTau, .galambosRho, 23 | file = "galambos.rda") 24 | 25 | ###################################################### 26 | ## test with huslerReiss 27 | ###################################################### 28 | thetaGrid <- seq(0.001, .999, by = .001) 29 | huslerReissTrFuns <- list(forwardTransf = function(x, ss) (tanh(x / ss))^0.33, 30 | backwardTransf = function(x, ss) ss * atanh(x^(1/0.33)), 31 | forwardDer = function(x, ss) 0.33 * (tanh(x / ss))^(0.33 - 1) * (1 - tanh(x / ss)^2 ) / ss 32 | ) 33 | 34 | nsim <- 0 35 | .huslerReissTau <- getAssoMeasFun(huslerReissCopula(0), thetaGrid, nsim, "kendall", c(0, 1), c(0, 1), huslerReissTrFuns, ss = 15, symmetrize = FALSE) 36 | 37 | nsim <- 0 38 | .huslerReissRho <- getAssoMeasFun(huslerReissCopula(0), thetaGrid, nsim, "spearman", c(0, 1), c(0, 1), huslerReissTrFuns, ss = 5, symmetrize = FALSE) 39 | 40 | save(.huslerReissTau, .huslerReissRho, 41 | file = "huslerReiss.rda") 42 | 43 | ###################################################### 44 | ## test with tev, df = 4 45 | ###################################################### 46 | thetaGrid <- seq(0.001, .999, by = .001) 47 | tevTrFuns <- list(forwardTransf = function(x, ss) x^(ss), 48 | backwardTransf = function(x, ss) x^(1 / ss), 49 | forwardDer = function(x, ss) ss * x^(ss - 1) 50 | ) 51 | 52 | nsim <- 0 53 | .tevTau <- getAssoMeasFun(tevCopula(0, df=4), thetaGrid, nsim, "kendall", c(0, 1), c(0, 1), tevTrFuns, ss = 2, symmetrize = FALSE) 54 | 55 | nsim <- 0 56 | .tevRho <- getAssoMeasFun(tevCopula(0, df=4), thetaGrid, nsim, "spearman", c(0, 1), c(0, 1), tevTrFuns, ss = 1, symmetrize = FALSE) 57 | 58 | save(.tevTau, .tevRho, 59 | file = "tev.rda") 60 | -------------------------------------------------------------------------------- /inst/docs/tauRho/getSysdataImage.R: -------------------------------------------------------------------------------- 1 | ########################################################################## 2 | ## This script generates the sysdata.rda file used in the copula package 3 | ########################################################################## 4 | 5 | ## this part was done while working on KojYan2010 (IME) 6 | ## load images generated from trpsrho.R 7 | load("claytonRho.rda") 8 | load("gumbelRho.rda") 9 | ## load image generated from trpstau.R 10 | load("plackettTau.rda") 11 | 12 | ## load images generated from evtrps.R 13 | ## this part was done while working on GKNY 2011 (Bernoulli) 14 | load("galambos.rda") 15 | load("huslerReiss.rda") 16 | load("tev.rda") 17 | 18 | save(.claytonRhoNeg, .claytonRhoPos, ## claytonRhoFun, claytondRho, 19 | .gumbelRho, ## gumbelRhoFun, gumbeldRho, 20 | .plackettTau, ## plackettTauFun, plackettdTau, 21 | .galambosTau, .galambosRho, 22 | .huslerReissTau, .huslerReissRho, 23 | .tevTau, .tevRho, 24 | file = "sysdata.rda", compress=TRUE) 25 | 26 | ################################################################################# 27 | ## NOTE: 28 | ## gumbelRhoFun should not be defined in sysdata.rda. 29 | ## Otherwise .gumbelRho would not be found in R CMD check 30 | ################################################################################# 31 | -------------------------------------------------------------------------------- /inst/docs/tauRho/validPlot.R: -------------------------------------------------------------------------------- 1 | ## produces plots used in KojYan 2010 (IME) 2 | 3 | load("frankRho.rda") 4 | library(copula, lib.loc="../../copula.Rcheck") 5 | source("../../copula/R/debye.R") 6 | 7 | dRhoFrankCopula <- function(copula) { 8 | alpha <- copula@parameters 9 | return( 12 / (alpha * (exp(alpha) - 1)) - 36 / alpha^2 * debye2(alpha) + 24 / alpha^2 * debye1(alpha) ) 10 | } 11 | 12 | thetaGrid <- seq(-.999, .999, by = .001) 13 | alphaGrid <- 40 * atanh(thetaGrid) 14 | rhoTrue <- sapply(alphaGrid, function(x) rho(frankCopula(x))) 15 | dRhoTrue <- sapply(alphaGrid, function(x) dRhoFrankCopula(frankCopula(x))) 16 | 17 | pdf("frank-rho.pdf", height=3, width=6, pointsize=9) 18 | par(mfrow=c(1,2), mgp=c(1.5, 0.5, 0), mar=c(3,3,0,0.5)) 19 | plot(thetaGrid, rhoTrue, type="l", xlab=expression(alpha), ylab=expression(rho)) 20 | curve(frankRhoFun(atanh(x) * 40), add=TRUE, col="blue") 21 | legend("topleft", legend=c("true", "numerical"), col=c("black", "blue"), lty=c(1,2), cex=0.7) 22 | 23 | curve(frankdRho(atanh(x) * 40), col="blue", xlab=expression(alpha), ylab=bquote(rho~"'")) 24 | lines(thetaGrid, dRhoTrue) 25 | legend("topleft", legend=c("true", "numerical"), col=c("black", "blue"), lty=c(1,2), cex=0.7) 26 | dev.off() 27 | 28 | 29 | pdf("frank-rho-err.pdf", height=3, width=6, pointsize=9) 30 | par(mfrow=c(1,2), mgp=c(1.5, 0.5, 0), mar=c(3,3,0,0.5)) 31 | plot(thetaGrid, frankRhoFun(atanh(thetaGrid) * 40) - rhoTrue, type="l", xlab=expression(alpha), ylab=expression(rho)) 32 | 33 | plot(thetaGrid, frankdRho(atanh(thetaGrid) * 40) - dRhoTrue, type="l", xlab=expression(alpha), ylab=bquote(rho~"'")) 34 | dev.off() 35 | 36 | load("t4Rho.rda") 37 | rhoTrue <- sapply(thetaGrid, function(x) rho(tCopula(x))) 38 | dRhoTrue <- 6 / (pi * sqrt(4 - thetaGrid^2)) 39 | 40 | pdf("t4-rho.pdf", height=3, width=6, pointsize=9) 41 | par(mfrow=c(1,2), mgp=c(1.5, 0.5, 0), mar=c(3,3,0,0.5)) 42 | plot(thetaGrid, rhoTrue, type="l", xlab=expression(theta), ylab=expression(rho)) 43 | curve(t4RhoFun(x), add=TRUE, col="blue", lty=2) 44 | legend("bottomright", legend=c("normal", "numerical"), col=c("black", "blue"), lty=c(1,2), cex=0.7) 45 | 46 | curve(t4dRho(x), col="blue", xlab=expression(theta), ylab=bquote(rho~"'"), lty = 2) 47 | lines(thetaGrid, dRhoTrue) 48 | legend("bottomright", legend=c("normal", "numerical"), col=c("black", "blue"), lty=c(1,2), cex=0.7) 49 | dev.off() 50 | 51 | pdf("t4-rho-err.pdf", height=3, width=6, pointsize=9) 52 | par(mfrow=c(1,2), mgp=c(1.5, 0.5, 0), mar=c(3,3,0,0.5)) 53 | plot(thetaGrid, t4RhoFun(thetaGrid) - rhoTrue, type="l", xlab=expression(theta), ylab=bquote("difference in "~rho), ylim=c(-.016, .016)) 54 | 55 | plot(thetaGrid, t4dRho(thetaGrid) - dRhoTrue, type="l", xlab=expression(theta), ylab=bquote("difference in "~rho~"'")) 56 | dev.off() 57 | -------------------------------------------------------------------------------- /inst/rData/GIG_vign-nlogl-gr.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/copula/1251bec7d5eb868a01e417aeb0d11b58a36f9911/inst/rData/GIG_vign-nlogl-gr.rds -------------------------------------------------------------------------------- /inst/rData/README.org: -------------------------------------------------------------------------------- 1 | |---------------------+--------+------------------------| 2 | | Name | Size | Used in (^) | 3 | |---------------------+--------+------------------------| 4 | | retstable_CPU2.rda | 16205 | ../../demo/retstable.R | 5 | | retstable_Nstat.rda | 304463 | ../../demo/retstable.R | 6 | | retstable_st2.rda | 16415 | ../../demo/retstable.R | 7 | | | | ../../tests/v34i09.R | 8 | |---------------------+--------+------------------------| 9 | 10 | ^) Paths are *relative* and valid inside copula pkg's *source* tree 11 | -------------------------------------------------------------------------------- /inst/rData/retstable_CPU2.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/copula/1251bec7d5eb868a01e417aeb0d11b58a36f9911/inst/rData/retstable_CPU2.rda -------------------------------------------------------------------------------- /inst/rData/retstable_Nstat.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/copula/1251bec7d5eb868a01e417aeb0d11b58a36f9911/inst/rData/retstable_Nstat.rda -------------------------------------------------------------------------------- /inst/rData/retstable_st2.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/copula/1251bec7d5eb868a01e417aeb0d11b58a36f9911/inst/rData/retstable_st2.rda -------------------------------------------------------------------------------- /man/SMI.12.Rd: -------------------------------------------------------------------------------- 1 | \name{SMI.12} 2 | \title{SMI Data -- 141 Days in Winter 2011/2012} 3 | \alias{SMI.12} 4 | \alias{lSMI} 5 | \docType{data} 6 | \description{ 7 | \code{SMI.12} contains the close prices of all 20 constituents of 8 | the Swiss Market Index (SMI) from 2011-09-09 to 2012-03-28. 9 | } 10 | \usage{ 11 | data(SMI.12) 12 | } 13 | \format{ 14 | \code{SMI.12} is conceptually a multivariate time series, 15 | here simply stored as \code{\link{numeric}} \code{\link{matrix}}, 16 | where the \code{\link{rownames}} are dates (of week days). 17 | 18 | The format is: 19 | 20 | num [1:141, 1:20] 16.1 15.7 15.7 16.1 16.6 ... 21 | - attr(*, "dimnames")=List of 2 22 | ..$ : chr [1:141] "2011-09-09" "2011-09-12" "2011-09-13" "2011-09-14" ... 23 | ..$ : chr [1:20] "ABBN" "ATLN" "ADEN" "CSGN" ... 24 | 25 | ... from 2011-09-09 to 2012-03-28 26 | 27 | \code{lSMI} is the list of the original data (\emph{before} \code{NA} 28 | \dQuote{imputation}). 29 | } 30 | %\author{Marius Hofert and Martin Maechler} 31 | \source{ 32 | The data was drawn from Yahoo! Finance. 33 | } 34 | \examples{ 35 | data(SMI.12) 36 | ## maybe 37 | head(SMI.12) 38 | 39 | str(D.12 <- as.Date(rownames(SMI.12))) 40 | summary(D.12) 41 | 42 | matplot(D.12, SMI.12, type="l", log = "y", 43 | main = "The 20 SMI constituents (2011-09 -- 2012-03)", 44 | xaxt="n", xlab = "2011 / 2012") 45 | Axis(D, side=1) 46 | 47 | 48 | 49 | if(FALSE) { ##--- This worked up to mid 2012, but no longer --- 50 | begSMI <- "2011-09-09" 51 | endSMI <- "2012-03-28" 52 | ##-- read *public* data ------------------------------ 53 | stopifnot(require(zoo), # -> to access all the zoo methods 54 | require(tseries)) 55 | symSMI <- c("ABBN.VX","ATLN.VX","ADEN.VX","CSGN.VX","GIVN.VX","HOLN.VX", 56 | "BAER.VX","NESN.VX","NOVN.VX","CFR.VX", "ROG.VX", "SGSN.VX", 57 | "UHR.VX", "SREN.VX","SCMN.VX","SYNN.VX","SYST.VX","RIGN.VX", 58 | "UBSN.VX","ZURN.VX") 59 | lSMI <- sapply(symSMI, function(sym) 60 | get.hist.quote(instrument = sym, start= begSMI, end= endSMI, 61 | quote = "Close", provider = "yahoo", 62 | drop=TRUE)) 63 | ## check if stock data have the same length for each company. 64 | sapply(lSMI, length) 65 | ## "concatenate" all: 66 | SMIo <- do.call(cbind, lSMI) 67 | ## and fill in the NAs : 68 | SMI.12 <- na.fill(SMIo, "extend") 69 | colnames(SMI.12) <- sub("\\\\.VX", "", colnames(SMI.12)) 70 | SMI.12 <- as.matrix(SMI.12) 71 | }##---- --- original download 72 | 73 | zoo.there <- "package:zoo" \%in\% search() 74 | if(zoo.there || require("zoo")) { 75 | stopifnot(identical(SMI.12, 76 | local({ S <- as.matrix(na.fill(do.call(cbind, lSMI), "extend")) 77 | colnames(S) <- sub("\\\\.VX", "", colnames(S)); S }))) 78 | if(!zoo.there) detach("package:zoo") 79 | } 80 | 81 | } 82 | \keyword{datasets} 83 | -------------------------------------------------------------------------------- /man/acR.Rd: -------------------------------------------------------------------------------- 1 | \name{acR} 2 | \alias{pacR} 3 | \alias{qacR} 4 | \title{Distribution of the Radial Part of an Archimedean Copula} 5 | \description{ 6 | \code{pacR()} computes the distribution function \eqn{F_R} of the radial 7 | part of an Archimedean copula, given by 8 | \deqn{F_R(x)=1-\sum_{k=0}^{d-1} 9 | \frac{(-x)^k\psi^{(k)}(x)}{k!},\ x\in[0,\infty);}{% 10 | F_R(x)=1-sum(k=0,...,d-1) (-x)^k psi^{(k)}(x)/k!, u in [0,Inf)} 11 | The formula (in a slightly more general form) is given by 12 | McNeil and G. \enc{Nešlehová}{Neslehova} (2009). 13 | 14 | \code{qacR()} computes the quantile function of \eqn{F_R}. 15 | } 16 | \usage{ 17 | pacR(x, family, theta, d, lower.tail = TRUE, log.p = FALSE, \dots) 18 | qacR(p, family, theta, d, log.p = FALSE, interval, 19 | tol = .Machine$double.eps^0.25, maxiter = 1000, \dots) 20 | } 21 | \arguments{ 22 | \item{x}{numeric vector of nonnegative evaluation points for \eqn{F_R}.} 23 | \item{p}{numeric vector %, in \eqn{[0,1]}, 24 | of evaluation points of the quantile function.} 25 | \item{family}{Archimedean family.} 26 | \item{theta}{parameter \eqn{theta}.} 27 | \item{d}{dimension \eqn{d}.} 28 | \item{lower.tail}{\code{\link{logical}}; if \code{TRUE}, 29 | probabilities are \eqn{P[X <= x]} otherwise, \eqn{P[X > x]}.} 30 | \item{log.p}{\code{\link{logical}}; if \code{TRUE}, probabilities 31 | \eqn{p} are given as \eqn{\log p}{log(p)}.} 32 | \item{interval}{root-search interval.} 33 | \item{tol}{see \code{\link{uniroot}()}.} 34 | \item{maxiter}{see \code{\link{uniroot}()}.} 35 | \item{\dots}{additional arguments passed to the procedure for 36 | computing derivatives.} 37 | } 38 | \value{The distribution function of the radial part evaluated at 39 | \code{x}, or its inverse, the quantile at \code{p}.} 40 | %\author{Marius Hofert} 41 | \references{ 42 | McNeil, A. J., G. \enc{Nešlehová}{Neslehova}, J. (2009). 43 | Multivariate Archimedean copulas, \eqn{d}-monotone functions and 44 | \eqn{l_1}-norm symmetric distributions. \emph{The Annals of Statistics} 45 | \bold{37}(5b), 3059--3097. 46 | } 47 | \examples{ 48 | ## setup 49 | family <- "Gumbel" 50 | tau <- 0.5 51 | m <- 256 52 | dmax <- 20 53 | x <- seq(0, 20, length.out=m) 54 | 55 | ## compute and plot pacR() for various d's 56 | y <- vapply(1:dmax, function(d) 57 | pacR(x, family=family, theta=iTau(archmCopula(family), tau), d=d), 58 | rep(NA_real_, m)) 59 | plot(x, y[,1], type="l", ylim=c(0,1), 60 | xlab = quote(italic(x)), ylab = quote(F[R](x)), 61 | main = substitute(italic(F[R](x))~~ "for" ~ d==1:.D, list(.D = dmax))) 62 | for(k in 2:dmax) lines(x, y[,k]) 63 | } 64 | \keyword{distribution} 65 | -------------------------------------------------------------------------------- /man/allComp.Rd: -------------------------------------------------------------------------------- 1 | \name{allComp} 2 | \alias{allComp} 3 | \title{All Components of a (Inner or Outer) Nested Archimedean Copula} 4 | \description{ 5 | Given the nested Archimedean copula \code{x}, return an integer vector 6 | of the \emph{indices} of all components of the corresponding 7 | \code{\linkS4class{outer_nacopula}} which are components of \code{x}, 8 | either direct components or components of possible child copulas. This 9 | is typically only used by programmers investigating the exact nesting 10 | structure. 11 | 12 | For an \code{\linkS4class{outer_nacopula}} object 13 | \code{x}, \code{allComp(x)} must be the same as 14 | \code{1:\link{dim}(x)}, whereas its \dQuote{inner} component copulas 15 | will each contain a \emph{subset} of those indices only. 16 | } 17 | \usage{ 18 | allComp(x) 19 | } 20 | \arguments{ 21 | \item{x}{an \R object inheriting from class \code{\linkS4class{nacopula}}.} 22 | } 23 | \value{ 24 | An \code{\link{integer}} vector of indices \eqn{j} of all components 25 | \eqn{u_j} as described in the description above. 26 | } 27 | %\author{Martin Maechler} 28 | \examples{ 29 | C3 <- onacopula("AMH", C(0.7135, 1, C(0.943, 2:3))) 30 | allComp(C3) # components are 1:3 31 | allComp(C3@childCops[[1]]) # for the child, only (2, 3) 32 | } 33 | \keyword{manip} 34 | \keyword{utilities} 35 | -------------------------------------------------------------------------------- /man/archmCopula-class.Rd: -------------------------------------------------------------------------------- 1 | \name{archmCopula-class} 2 | \title{Class "archmCopula"} 3 | \docType{class} 4 | \alias{archmCopula-class} 5 | \alias{claytonCopula-class} 6 | \alias{frankCopula-class} 7 | \alias{gumbelCopula-class} 8 | \alias{amhCopula-class} 9 | \alias{joeCopula-class} 10 | \description{Archimedean copula class.} 11 | \section{Objects from the Class}{ 12 | Created by calls of the form \code{new("archmCopula", ...)} or rather 13 | typically by \code{\link{archmCopula}()}. Implemented 14 | families are Clayton, Gumbel, Frank, Joe, and Ali-Mikhail-Haq. 15 | } 16 | \section{Slots}{ 17 | \describe{ 18 | \item{\code{exprdist}:}{Object of class \code{"expression"}: 19 | expressions of the cdf and pdf of the copula. These expressions 20 | are used in function \code{\link{pCopula}} and \code{\link{dCopula}}. } 21 | \item{\code{dimension, parameters}, etc:}{all inherited from the 22 | super class \code{\linkS4class{copula}}.} 23 | } 24 | } 25 | \section{Methods}{ 26 | \describe{ 27 | \item{dCopula}{\code{signature(copula = "claytonCopula")}: ... } 28 | \item{pCopula}{\code{signature(copula = "claytonCopula")}: ... } 29 | \item{rCopula}{\code{signature(copula = "claytonCopula")}: ... } 30 | \item{dCopula}{\code{signature(copula = "frankCopula")}: ... } 31 | \item{pCopula}{\code{signature(copula = "frankCopula")}: ... } 32 | \item{rCopula}{\code{signature(copula = "frankCopula")}: ... } 33 | \item{dCopula}{\code{signature(copula = "gumbelCopula")}: ... } 34 | \item{pCopula}{\code{signature(copula = "gumbelCopula")}: ... } 35 | \item{rCopula}{\code{signature(copula = "gumbelCopula")}: ... } 36 | \item{dCopula}{\code{signature(copula = "amhCopula")}: ... } 37 | \item{pCopula}{\code{signature(copula = "amhCopula")}: ... } 38 | \item{rCopula}{\code{signature(copula = "amhCopula")}: ... } 39 | \item{dCopula}{\code{signature(copula = "joeCopula")}: ... } 40 | \item{pCopula}{\code{signature(copula = "joeCopula")}: ... } 41 | \item{rCopula}{\code{signature(copula = "joeCopula")}: ... } 42 | } 43 | } 44 | \section{Extends}{ 45 | Class \code{"archmCopula"} extends class \code{"\linkS4class{copula}"} 46 | directly. Class \code{"claytonCopula"}, \code{"frankCopula"}, 47 | \code{"gumbelCopula"}, \code{"amhCopula"} and \code{"joeCopula"} 48 | extends class \code{"archmCopula"} directly. 49 | } 50 | \note{ 51 | \code{"gumbelCopula"} is also of class \code{"\linkS4class{evCopula}"}. 52 | } 53 | %\author{Marius Hofert, Ivan Kojadinovic, Martin Maechler and Jun Yan} 54 | \seealso{ 55 | \code{\link{archmCopula}}, for constructing such copula objects; 56 | \code{\link{copula-class}}. 57 | } 58 | \keyword{classes} 59 | -------------------------------------------------------------------------------- /man/coeffG.Rd: -------------------------------------------------------------------------------- 1 | \name{coeffG} 2 | \title{Coefficients of Polynomial used for Gumbel Copula} 3 | \alias{coeffG} 4 | \description{ 5 | Compute the coefficients \eqn{a_{d,k}(\theta)}{a[d,k](\theta)} involved in the 6 | generator (psi) derivatives and the copula density of Gumbel copulas. 7 | 8 | For non-small dimensions \eqn{d}, these are numerically challenging to 9 | compute accurately. 10 | } 11 | \usage{ 12 | coeffG(d, alpha, 13 | method = c("sort", "horner", "direct", "dsumSibuya", 14 | paste("dsSib", eval(formals(dsumSibuya)$method), sep = ".")), 15 | log = FALSE, verbose = FALSE) 16 | } 17 | \arguments{ 18 | \item{d}{number of coefficients, (the copula dimension), d >= 1.} 19 | \item{alpha}{parameter \eqn{1/\theta} in \eqn{(0,1]}; you may use 20 | \code{\link[Rmpfr]{mpfr}(alph, precBits = )} 21 | for higher precision methods (\code{"Rmpfr*"}) from package 22 | \CRANpkg{Rmpfr}.} 23 | \item{method}{a \code{\link{character}} string, one of 24 | \describe{ 25 | \item{\code{"sort"}:}{compute coefficients via \eqn{exp(log())} 26 | pulling out the maximum, and sort.} 27 | \item{\code{"horner"}:}{uses polynomial evaluation, our internal 28 | \code{polynEval()}.} 29 | \item{\code{"direct"}:}{brute force approach.} 30 | \item{\code{"dsSib."}:}{uses \code{\link{dsumSibuya}(..., method= "")}.} 31 | } 32 | } 33 | \item{log}{logical determining if the logarithm (\code{\link{log}}) is 34 | to be returned.} 35 | \item{verbose}{logical indicating if some information should be shown, 36 | currently for \code{method == "sort"} only.} 37 | } 38 | \value{ 39 | a numeric vector of length \code{d}, of values 40 | \deqn{% latex 41 | a_k(\theta, d) = (-1)^{d-k}\sum_{j=k}^d \alpha^j * s(d,j) * S(j,k), 42 | k \in \{1,\ldots,d\}.}{% non-latex; can use greek letters: 43 | a_k(\theta, d) = (-1)^(d-k) Sum(j=k..d; \alpha^j * s(d,j) * S(j,k)), 44 | k in 1..d. 45 | } 46 | } 47 | %\author{Marius Hofert and Martin Maechler} 48 | \note{There are still known numerical problems (with non-"Rmpfr" methods; and 49 | those are slow), e.g., for d=100, 50 | alpha=0.8 and \eqn{sign(s(n,k)) = (-1)^{n-k}}{sign(s(n,k)) = (-1)^(n-k)}. 51 | 52 | As a consequence, the \code{method}s and its defaults may change in 53 | the future, and so the exact implementation of \code{coeffG()} is 54 | still considered somewhat experimental. 55 | } 56 | \examples{ 57 | a.k <- coeffG(16, 0.55) 58 | plot(a.k, xlab = quote(k), ylab = quote(a[k]), 59 | main = "coeffG(16, 0.55)", log = "y", type = "o", col = 2) 60 | a.kH <- coeffG(16, 0.55, method = "horner") 61 | stopifnot(all.equal(a.k, a.kH, tol = 1e-11))# 1.10e-13 (64-bit Lnx, nb-mm4) 62 | %% maybe more from ../demo/G_ak.R 63 | } 64 | \keyword{arith} 65 | -------------------------------------------------------------------------------- /man/copula-internal.Rd: -------------------------------------------------------------------------------- 1 | \name{copula-internal} 2 | % Undocumented code objects 3 | 4 | % Undocumented S4 classes: 5 | \alias{schlatherCopula-class} 6 | % Undocumented S4 methods 7 | \title{Internal Copula Functions} 8 | \description{ 9 | Internal Copula functions 10 | } 11 | \details{ 12 | These are not to be called by the user (or in some cases are just 13 | waiting for proper documentation to be written). 14 | } 15 | %\author{Marius Hofert, Ivan Kojadinovic, Martin Maechler and Jun Yan} 16 | \keyword{internal} 17 | -------------------------------------------------------------------------------- /man/corKendall.Rd: -------------------------------------------------------------------------------- 1 | \name{corKendall} 2 | \alias{corKendall} 3 | \title{(Fast) Computation of Pairwise Kendall's Taus} 4 | \description{ 5 | For a data matrix \code{x}, compute the Kendall's tau 6 | \dQuote{correlation} matrix, i.e., all pairwise Kendall's taus 7 | between the columns of \code{x}. 8 | 9 | By default and when \code{x} has no missing values 10 | (\code{\link{NA}}s), the fast \eqn{O(n log(n))} algorithm of 11 | \code{\link[pcaPP]{cor.fk}()} is used. 12 | } 13 | \usage{ 14 | corKendall(x, checkNA = TRUE, 15 | use = if(checkNA && anyNA(x)) "pairwise" else "everything") 16 | } 17 | \arguments{ 18 | \item{x}{data, a n x p matrix (or less efficiently a 19 | data.frame), or a numeric vector which is treated as n x 1 matrix.} 20 | \item{checkNA}{logical indicating if \code{x} should be checked for 21 | \code{\link{NA}}s and in the case of NA's \emph{and} when \code{use} 22 | is not specified (\code{\link{missing}}), \code{cor(*, use = 23 | "pairwise")} should be used. Note that \code{corKendall(x, 24 | checkNA = FALSE)} will produce an error when \code{x} has NA's.} 25 | \item{use}{a string to determine the treatment of \code{\link{NA}}s in 26 | \code{x}, see \code{\link{cor}}; its default determined via 27 | \code{checkNA}. When this differs from \code{"everything"}, \R's 28 | \code{\link{cor}} is used; otherwise \CRANpkg{pcaPP}'s 29 | \code{\link[pcaPP]{cor.fk}()} which cannot deal with \code{\link{NA}}s.} 30 | } 31 | % \author{Martin Maechler} 32 | \value{ 33 | The \eqn{p \times p}{p x p} matrix \eqn{K} of pairwise Kendall's taus, with 34 | \code{K[i,j] := tau(x[,i], x[,j])}. 35 | } 36 | \seealso{ 37 | \code{\link[pcaPP]{cor.fk}()} from \CRANpkg{pcaPP} (used by default 38 | when there are no missing values (\code{NA}s) in \code{x}). 39 | 40 | \code{\link{etau}()} or \code{\link{fitCopula}(*, method = "itau")} 41 | make use of \code{corKendall()}. 42 | } 43 | \examples{ 44 | ## If there are no NA's, corKendall() is faster than cor(*, "kendall") 45 | ## and gives the same : 46 | 47 | system.time(C1 <- cor(swiss, method="kendall")) 48 | system.time(C2 <- corKendall(swiss)) 49 | stopifnot(all.equal(C1, C2, tol = 1e-5)) 50 | 51 | ## In the case of missing values (NA), corKendall() reverts to 52 | ## cor(*, "kendall", use = "pairwise") {no longer very fast} : 53 | 54 | swM <- swiss # shorter names and three missings: 55 | colnames(swM) <- abbreviate(colnames(swiss), min=6) 56 | swM[1,2] <- swM[7,3] <- swM[25,5] <- NA 57 | (C3 <- corKendall(swM)) # now automatically uses the same as 58 | stopifnot(identical(C3, cor(swM, method="kendall", use="pairwise"))) 59 | ## and is quite close to the non-missing "truth": 60 | stopifnot(all.equal(unname(C3), unname(C2), tol = 0.06)) # rel.diff.= 0.055 61 | 62 | try(corKendall(swM, checkNA=FALSE)) # --> Error 63 | ## the error is really from pcaPP::cor.fk(swM) 64 | } 65 | -------------------------------------------------------------------------------- /man/dDiag.Rd: -------------------------------------------------------------------------------- 1 | \name{dDiag} 2 | \alias{dDiag} 3 | \title{Density of the Diagonal of (Nested) Archimedean Copulas} 4 | \description{ 5 | Evaluate the density of the diagonal of a \eqn{d}-dimensional (nested) 6 | Archimedean copula. Note that the diagonal of a copula is a cumulative 7 | distribution function. Currently, only Archimedean copulas are implemented. 8 | } 9 | \usage{ 10 | dDiag(u, cop, log=FALSE) 11 | } 12 | \arguments{ 13 | \item{u}{a numeric vector of evaluation points.} 14 | \item{cop}{a (nested) Archimedean copula object of class 15 | \code{"\linkS4class{outer_nacopula}"}. This also determines the dimension 16 | via the \code{comp} slot} 17 | \item{log}{logical indicating if the \code{\link{log}} of the density of the 18 | diagonal should be returned instead of just the diagonal density.} 19 | } 20 | \value{ 21 | A \code{\link{numeric}} vector containing the values of the density of the 22 | diagonal of the Archimedean copula at \code{u}.} 23 | %\author{Marius Hofert, Martin Maechler} 24 | \references{ 25 | Hofert, M., \enc{Mächler}{Maechler}, M., and McNeil, A. J. (2013). 26 | Archimedean Copulas in High Dimensions: Estimators and Numerical 27 | Challenges Motivated by Financial Applications. 28 | \emph{Journal de la Soci\enc{é}{e}t\enc{é}{e} Fran\enc{ç}{c}aise de 29 | Statistique} 30 | \bold{154}(1), 25--63. 31 | } 32 | \seealso{ 33 | \code{\linkS4class{acopula}} class, \code{\link{dnacopula}}. 34 | } 35 | \examples{ 36 | th. <- c(0.1, 0.2, 0.5, 0.8, 1.4, 2., 5.) 37 | curve(dDiag(x, cop=onacopulaL("Clayton", list(th.[1], 1:3))), 0, 1, 38 | n=1000, ylab="dDiag(x, *)", main="Diagonal densities of Clayton") 39 | abline(h=0, lty=3) 40 | for(j in 2:length(th.)) 41 | curve(dDiag(x, cop=onacopulaL("Clayton", list(th.[j], 1:3))), add=TRUE, 42 | col=j, n=1000) 43 | legend("topleft", do.call(expression, lapply(th., function(th) 44 | substitute(theta == TH, list(TH=th)))), 45 | lty = 1, col=seq_along(th.), bty="n") 46 | } 47 | \keyword{distribution} 48 | -------------------------------------------------------------------------------- /man/describeCop.Rd: -------------------------------------------------------------------------------- 1 | \name{describeCop} 2 | \title{Copula (Short) Description as String} 3 | \alias{describeCop} 4 | \alias{describeCop-methods} 5 | \alias{describeCop,Copula,missing-method} 6 | \alias{describeCop,copula,character-method} 7 | \alias{describeCop,Xcopula,ANY-method} 8 | \alias{describeCop,archmCopula,character-method} 9 | \alias{describeCop,ellipCopula,character-method} 10 | \alias{describeCop,fgmCopula,character-method} 11 | \alias{describeCop,moCopula,character-method} 12 | \alias{describeCop,indepCopula,character-method} 13 | \alias{describeCop,khoudrajiCopula,character-method} 14 | \alias{describeCop,mixCopula,character-method} 15 | \alias{describeCop,rotCopula,character-method} 16 | \alias{describeCop,fhCopula,character-method} 17 | \alias{describeCop,empCopula,character-method} 18 | \docType{methods} 19 | \description{ 20 | Describe a \code{\linkS4class{copula}} object, i.e., its basic 21 | properties as a string. This is a utility used when 22 | \code{\link{print}()}ing or \code{\link{plot}()}ting copulas, e.g., 23 | after a fitting. 24 | } 25 | \usage{ 26 | describeCop(x, kind = c("short", "very short", "long"), prefix = "", ...) 27 | } 28 | \section{Methods}{ 29 | \describe{ 30 | \item{\code{signature(x = "archmCopula", kind = "ANY")}}{ .. } 31 | \item{\code{signature(x = "copula", kind = "character")}}{ .. } 32 | \item{\code{signature(x = "copula", kind = "missing")}}{ .. } 33 | \item{\code{signature(x = "ellipCopula", kind = "character")}}{ .. } 34 | \item{\code{signature(x = "fgmCopula", kind = "ANY")}}{ .. } 35 | \item{\code{signature(x = "xcopula", kind = "ANY")}}{ .. } 36 | } 37 | } 38 | \arguments{ 39 | \item{x}{a \code{\linkS4class{copula}} object, or a generalization 40 | such as \code{\linkS4class{parCopula}}.} 41 | \item{kind}{a \code{\link{character}} string specifying the size (or 42 | \dQuote{complexity} of the copula description desired.} 43 | \item{prefix}{a string to be prefixed to the returned string, which 44 | can be useful for indentation in describing extended copulas such 45 | as Khoudraji copulas.} 46 | \item{...}{further arguments; unused currently.} 47 | } 48 | %% \details{ 49 | %% } 50 | \value{ 51 | a \code{\link{character}} string. 52 | } 53 | \seealso{ 54 | Copula class definition \code{\linkS4class{copula}}; 55 | } 56 | \examples{ 57 | ## FIXME 58 | } 59 | \keyword{utilities} 60 | \keyword{methods} 61 | -------------------------------------------------------------------------------- /man/ellipCopula-class.Rd: -------------------------------------------------------------------------------- 1 | \name{ellipCopula-class} 2 | \title{Class "ellipCopula" of Elliptical Copulas} 3 | \docType{class} 4 | \alias{ellipCopula-class} 5 | \alias{normalCopula-class} 6 | \alias{tCopula-class} 7 | \description{ 8 | Copulas generated from elliptical multivariate distributions, notably 9 | Normal- and t-copulas (of specific class \code{"normalCopula"} or 10 | \code{"tCopula"}, respectively). 11 | } 12 | \section{Objects from the Class}{ 13 | Objects are typically created by \code{\link{ellipCopula}()}, 14 | \code{\link{normalCopula}()}, or \code{\link{tCopula}()}. 15 | } 16 | \section{Slots}{ 17 | \describe{ 18 | \item{\code{dispstr}:}{\code{"\link{character}"} string indicating 19 | how the dispersion matrix is parameterized; one of \code{"ex"}, 20 | \code{"ar1"}, \code{"toep"}, or \code{"un"}, see the \code{dispstr} 21 | argument of \code{\link{ellipCopula}()}.} 22 | \item{\code{dimension}:}{Object of class \code{"numeric"}, dimension 23 | of the copula. } 24 | \item{\code{parameters}:}{a \code{\link{numeric}}, (vector of) the parameter 25 | value(s).} 26 | \item{\code{param.names}:}{\code{\link{character}} vector with names 27 | for the \code{parameters} slot, of the same length.} 28 | \item{\code{param.lowbnd}:}{\code{\link{numeric}} vector of lower 29 | bounds for the \code{parameters} slot, of the same length.} 30 | \item{\code{param.upbnd}:}{upper bounds for \code{parameters}, 31 | analogous to \code{parm.lowbnd}.} 32 | \item{\code{fullname}:}{\bold{deprecated}; object of class \code{"character"}, family names 33 | of the copula.} 34 | } 35 | } 36 | \section{Extends}{ 37 | Class \code{"ellipCopula"} extends class \code{\linkS4class{copula}} 38 | directly. Classes \code{"normalCopula"} and \code{"tCopula"} extend 39 | \code{"ellipCopula"} directly. 40 | } 41 | \section{Methods}{ 42 | Many methods are available, notably \code{\link{dCopula}}, 43 | \code{\link{pCopula}}, and \code{\link{rCopula}}. 44 | Use, e.g., \code{\link{methods}(class = "tCopula")} to find others. 45 | } 46 | %\author{Ivan Kojadinovic and Jun Yan} 47 | \seealso{ 48 | \code{\link{ellipCopula}} which also documents \code{tCopula()} and 49 | \code{\link{normalCopula}()}; 50 | \code{\link{copula-class}}. 51 | } 52 | \keyword{classes} 53 | -------------------------------------------------------------------------------- /man/empCopula-class.Rd: -------------------------------------------------------------------------------- 1 | \name{empCopula-class} 2 | \title{Class "empCopula" of Empirical Copulas} 3 | \docType{class} 4 | \alias{empCopula-class} 5 | \alias{dim,empCopula-method}% not yet documented 6 | \description{ 7 | Empirical Copula class. 8 | } 9 | \section{Objects from the Class}{ 10 | Created by calls of the form \code{new("empCopula", ...)} or rather 11 | typically by \code{\link{empCopula}()} based on a matrix 12 | \code{X} of pseudo-observations. Smoothing options are available, see 13 | there. 14 | } 15 | \section{Slots}{ 16 | \describe{ 17 | \item{\code{X}:}{\code{\link{matrix}} of pseudo-observations based 18 | on which the empirical copula is constructed.} 19 | \item{\code{smoothing}:}{\code{\link{character}} string determining 20 | the smoothing method.} 21 | \item{\code{offset}:}{\code{\link{numeric}} giving the shift in the 22 | normalizing factor for computing the empirical copula.}% FIXME: 23 | % length 1 or 2 ?! 24 | \item{\code{ties.method}:}{a string indicating \code{\link{rank}()}'s 25 | ties method for computing the empirical copula.} 26 | } 27 | } 28 | %\author{Marius Hofert} 29 | \seealso{ 30 | The class constructor are \code{\link{empCopula}()}, also for 31 | examples. 32 | } 33 | \keyword{classes} 34 | -------------------------------------------------------------------------------- /man/evCopula-class.Rd: -------------------------------------------------------------------------------- 1 | \name{evCopula-class} 2 | \docType{class} 3 | \alias{evCopula-class} 4 | \alias{galambosCopula-class} 5 | \alias{huslerReissCopula-class} 6 | \alias{tawnCopula-class} 7 | \alias{tevCopula-class} 8 | \title{Classes Representing Extreme-Value Copulas} 9 | \description{ 10 | Class \code{evCopula} is the virtual (mother) class of all 11 | extreme-value copulas. There currently are five subclasses, 12 | \code{"galambosCopula"}, \code{"huslerReissCopula"}, 13 | \code{"tawnCopula"}, \code{"tevCopula"}, and \code{"gumbelCopula"}, 14 | the latter of which is also an Archimedean copula, see the page for 15 | class \code{"\linkS4class{archmCopula}"}. 16 | } 17 | \section{Objects from the Class}{ 18 | \code{evCopula} is a virtual class: No objects may be created from it. 19 | Objects of class \code{"galambosCopula"} etc, can be created by calls 20 | of the form \code{new("galambosCopula", ...)}, but typically rather by 21 | \code{\link{galambosCopula}()}, etc, see there. 22 | } 23 | \section{Slots}{ 24 | All slots are inherited from the mother class 25 | \code{"\linkS4class{copula}"}, see there. 26 | } 27 | \section{Methods}{ 28 | \describe{ 29 | \item{dCopula}{\code{signature(copula = "galambosCopula")}: ... } 30 | \item{pCopula}{\code{signature(copula = "galambosCopula")}: ... } 31 | \item{rCopula}{\code{signature(copula = "galambosCopula")}: ... } 32 | \item{dCopula}{\code{signature(copula = "huslerReissCopula")}: ... } 33 | \item{pCopula}{\code{signature(copula = "huslerReissCopula")}: ... } 34 | \item{rCopula}{\code{signature(copula = "huslerReissCopula")}: ... } 35 | } 36 | } 37 | \section{Extends}{ 38 | Class \code{"evCopula"} extends class \code{"\linkS4class{copula}"} 39 | directly. Classes \code{"galambosCopula"}, \code{"huslerReissCopula"}, 40 | \code{"tawnCopula"}, and \code{"tevCopula"} extend class 41 | \code{"evCopula"} directly. 42 | } 43 | \note{ 44 | %The expressions of pdf are obtained by differentiating the cdf 45 | %expression using function \code{"deriv"}. 46 | Objects of class \code{"\linkS4class{gumbelCopula}"} are also of class 47 | \code{"\linkS4class{archmCopula}"}. 48 | } 49 | %\author{Ivan Kojadinovic and Jun Yan} 50 | \seealso{ 51 | \code{\link{evCopula}}, 52 | \code{\link{evTestC}}, 53 | \code{\link{evTestK}}, 54 | \code{\link{gofEVCopula}}, 55 | \code{\link{copula-class}}. 56 | } 57 | \keyword{classes} 58 | -------------------------------------------------------------------------------- /man/evTestC.Rd: -------------------------------------------------------------------------------- 1 | \name{evTestC} 2 | \alias{evTestC} 3 | \title{Large-sample Test of Multivariate Extreme-Value Dependence} 4 | \description{ 5 | Test of multivariate extreme-value dependence based on the empirical 6 | copula and max-stability. The test statistics are defined in the second 7 | reference. Approximate p-values for the test statistics are obtained 8 | by means of a \emph{multiplier} technique. 9 | } 10 | \usage{ 11 | evTestC(x, N = 1000) 12 | } 13 | \arguments{ 14 | \item{x}{ a data matrix that will be transformed to pseudo-observations. } 15 | \item{N}{ number of multiplier iterations to be used to 16 | simulate realizations of the test statistic under the null 17 | hypothesis.} 18 | } 19 | \details{ 20 | More details are available in the second reference. 21 | See also Remillard and Scaillet (2009). 22 | } 23 | \value{ 24 | An object of \code{\link{class}} \code{htest} which is a list, 25 | some of the components of which are 26 | \item{statistic}{ value of the test statistic. } 27 | \item{p.value}{ corresponding approximate p-value. } 28 | } 29 | %\author{Ivan Kojadinovic and Jun Yan} 30 | \references{ 31 | R\enc{é}{e}millard, B. and Scaillet, O. (2009). Testing for equality 32 | between two copulas. \emph{Journal of Multivariate Analysis}, 100(3), 33 | pages 377-386. 34 | 35 | Kojadinovic, I., Segers, J., and Yan, J. (2011). Large-sample tests of 36 | extreme-value dependence for multivariate copulas. \emph{The Canadian 37 | Journal of Statistics} \bold{39}, 4, pages 703-720. 38 | } 39 | \note{ 40 | This test was derived under the assumption of continuous margins, 41 | which implies that ties occur with probability zero. The 42 | presence of ties in the data might substantially affect the 43 | approximate p-value. 44 | } 45 | \seealso{\code{\link{evTestK}}, \code{\link{evTestA}}, \code{\link{evCopula}}, 46 | \code{\link{gofEVCopula}}, \code{\link{An}}.} 47 | \examples{ 48 | ## Do these data come from an extreme-value copula? 49 | evTestC(rCopula(200, gumbelCopula(3))) 50 | evTestC(rCopula(200, claytonCopula(3))) 51 | 52 | ## Three-dimensional examples 53 | evTestC(rCopula(200, gumbelCopula(3, dim=3))) 54 | evTestC(rCopula(200, claytonCopula(3, dim=3))) 55 | \dontshow{ 56 | set.seed(101) 57 | G.t <- evTestC(rCopula(200, gumbelCopula(3, dim=3))) 58 | C.t <- evTestC(rCopula(200, claytonCopula(3, dim=3))) 59 | eT3 <- evTestC(rCopula(200, tevCopula(.8, df=3))) 60 | stopifnot(all.equal(G.t$p.value, 0.1543, tolerance=.001), 61 | all.equal(C.t$p.value, 4995/9999990, tolerance= 1e-7), 62 | all.equal(eT3$p.value, 0.407092907092907, tolerance= 1e-7)) 63 | } 64 | } 65 | \keyword{htest} 66 | \keyword{multivariate} 67 | -------------------------------------------------------------------------------- /man/fgmCopula-class.Rd: -------------------------------------------------------------------------------- 1 | \name{fgmCopula-class} 2 | \docType{class} 3 | \alias{fgmCopula-class} 4 | \title{Class "fgmCopula" - Multivariate Multiparameter Farlie-Gumbel-Morgenstern Copulas} 5 | \description{ 6 | The class of multivariate multiparameter Farlie-Gumbel-Morgenstern 7 | copulas are typically created via \code{\link{fgmCopula}(..)}. 8 | } 9 | \section{Objects from the Class}{ 10 | Objects are typically created by \code{\link{fgmCopula}(..)}, or more 11 | low-level by (careful) calls to \code{new("fgmCopula", ..)}. 12 | } 13 | \section{Slots}{ 14 | \describe{ 15 | \item{\code{exprdist}:}{Object of class \code{"expression"}, 16 | expressions for the cdf and pdf of the copula. These expressions 17 | are used in function \code{pCopula()} and \code{dCopula()}.} 18 | \item{\code{subsets.char}:}{Object of class \code{"character"}, 19 | containing the subsets of integers used for naming the parameters. } 20 | \item{\code{dimension}:}{Object of class \code{"numeric"}, the 21 | dimension of the copula. } 22 | \item{\code{parameters}:}{Object of class \code{"numeric"}, 23 | parameter values. } 24 | \item{\code{param.names}:}{Object of class \code{"character"}, 25 | parameter names. } 26 | \item{\code{param.lowbnd}:}{Object of class \code{"numeric"}, 27 | parameter lower bound. } 28 | \item{\code{param.upbnd}:}{Object of class \code{"numeric"}, 29 | parameter upper bound. } 30 | \item{\code{fullname}:}{Object of class \code{"character"}, family names 31 | of the copula (deprecated).} 32 | } 33 | } 34 | \section{Methods}{ 35 | \describe{ 36 | \item{dCopula}{\code{signature(copula = "fgmCopula")}: ... } 37 | \item{pCopula}{\code{signature(copula = "fgmCopula")}: ... } 38 | \item{rCopula}{\code{signature(copula = "fgmCopula")}: ... } 39 | } 40 | } 41 | \section{Extends}{ 42 | Class \code{"fgmCopula"} extends class \code{"\linkS4class{copula}"} directly. 43 | } 44 | %\author{Ivan Kojadinovic and Jun Yan} 45 | \references{ 46 | Nelsen, R. B. (2006), \emph{An introduction to Copulas}, Springer, New York. 47 | } 48 | \note{ 49 | The verification of the validity of the parameter values is of high 50 | complexity and may not work for high dimensional copulas. 51 | 52 | The random number generation needs to be properly tested, especially 53 | for dimensions higher than 2. 54 | } 55 | \seealso{ 56 | \code{\link{copula-class}}; to create such 57 | objects, use \code{\link{fgmCopula}()}; see there, also for examples. 58 | } 59 | \keyword{classes} 60 | -------------------------------------------------------------------------------- /man/fgmCopula.Rd: -------------------------------------------------------------------------------- 1 | \name{fgmCopula} 2 | \alias{fgmCopula} 3 | \title{Construction of a fgmCopula Class Object} 4 | \description{ 5 | Constructs a multivariate multiparameter Farlie-Gumbel-Morgenstern 6 | copula class object with its corresponding parameters and dimension. 7 | } 8 | \usage{ 9 | fgmCopula(param, dim = 2) 10 | } 11 | \arguments{ 12 | \item{param}{a numeric vector specifying the parameter values.} 13 | \item{dim}{the dimension of the copula.} 14 | } 15 | \value{ 16 | A Farlie-Gumbel-Morgenstern copula object of class 17 | \code{"\linkS4class{fgmCopula}"}. 18 | } 19 | \note{ 20 | Note that a \eqn{d}-dimensional \code{fgmCopula} must have 21 | \code{npar}\eqn{= 2^d - d - 1} parameters. 22 | The verification of the validity of the parameter values is of high 23 | complexity and may not work for high dimensional copulas. 24 | 25 | The random number generation needs to be properly tested, especially 26 | for dimensions higher than 2. 27 | } 28 | %\author{Ivan Kojadinovic and Jun Yan} 29 | \references{ 30 | Nelsen, R. B. (2006), \emph{An introduction to Copulas}, Springer, New York. 31 | } 32 | \seealso{ 33 | \code{\link{Copula}}, \code{\link{copula-class}}, 34 | \code{\link{fitCopula}}. 35 | } 36 | \examples{ 37 | ## length(param) = #{parameters} for d-dimensional FGM copula: 38 | d <- 2:10; rbind(d, npar = 2^d - d - 1) 39 | ## d 2 3 4 5 6 7 8 9 10 40 | ## npar 1 4 11 26 57 120 247 502 1013 41 | 42 | ## a bivariate example 43 | fgm.cop <- fgmCopula(1) 44 | x <- rCopula(1000, fgm.cop) 45 | cor(x, method = "kendall") 46 | tau(fgm.cop) 47 | cor(x, method = "spearman") 48 | rho(fgm.cop) 49 | persp (fgm.cop, dCopula) 50 | contour(fgm.cop, dCopula) 51 | 52 | ## a trivariate example with wrong parameter values 53 | try( 54 | fgm2.cop <- fgmCopula(c(1,1,1,1), dim = 3) 55 | ) # Error: "Bad vector of parameters" 56 | 57 | ## a trivariate example with satisfactory parameter values 58 | fgm2.cop <- fgmCopula(c(.2,-.2,-.4,.6), dim = 3) 59 | fgm2.cop 60 | } 61 | \keyword{distribution} 62 | \keyword{multivariate} 63 | -------------------------------------------------------------------------------- /man/fhCopula-class.Rd: -------------------------------------------------------------------------------- 1 | \name{fhCopula-class} 2 | \title{Class "fhCopula" of Fr\enc{é}{e}chet-Hoeffding Bound Copulas} 3 | \docType{class} 4 | \alias{fhCopula-class} 5 | \alias{lowfhCopula-class} 6 | \alias{upfhCopula-class} 7 | \description{ 8 | Fr\enc{é}{e}chet-Hoeffding bound copula class. 9 | } 10 | \section{Objects from the Class}{ 11 | Created by calls of the form \code{new("fhCopula", ...)} or rather 12 | typically by \code{\link{fhCopula}()}, \code{lowfhCopula()}, or 13 | \code{upfhCopula()}. Actual (sub) classes are the lower and upper 14 | Fr\enc{é}{e}chet-Hoeffding bound copulas \code{lowfhCopula()} 15 | (\eqn{W}), and \code{upfhCopula()} (\eqn{M}). 16 | } 17 | \section{Slots}{ 18 | \describe{ 19 | \item{\code{dimension}:}{inherited from 20 | super class \code{"\linkS4class{dimCopula}"}.} 21 | \item{\code{exprdist}:}{an \code{\link{expression}} of length two, 22 | named \code{"cdf"} with the \R expression of the CDF, and 23 | \code{"pdf"} which is empty as the PDF does not exist (everywhere).} 24 | } 25 | } 26 | %\author{Marius Hofert} 27 | \seealso{ 28 | \code{\link{ellipCopula}}, \code{\link{archmCopula}}, 29 | \code{\link{evCopula}}. 30 | 31 | The class constructors are \code{\link{fhCopula}()}, 32 | \code{lowfhCopula()}, and \code{upfhCopula()}. See there for 33 | examples. 34 | } 35 | \keyword{classes} 36 | -------------------------------------------------------------------------------- /man/fhCopula.Rd: -------------------------------------------------------------------------------- 1 | \name{fhCopula} 2 | \title{Construction of Fr\enc{é}{e}chet-Hoeffding Bound Copula Objects} 3 | \alias{fhCopula} 4 | \alias{lowfhCopula} 5 | \alias{upfhCopula} 6 | \description{ 7 | Constructs the Fr\enc{é}{e}chet-Hoeffding lower and upper bound 8 | copulas aka \eqn{W} and \eqn{M}. 9 | } 10 | \usage{ 11 | fhCopula(family = c("upper", "lower"), dim = 2L) 12 | 13 | lowfhCopula(dim = 2L) 14 | upfhCopula(dim = 2L) 15 | } 16 | \arguments{ 17 | \item{family}{a character string specifying the 18 | Fr\enc{é}{e}chet-Hoeffding bound copula.} 19 | \item{dim}{the dimension of the copula; note that the lower 20 | Fr\enc{é}{e}chet-Hoeffding bound is only available in the bivariate case.} 21 | } 22 | \value{ 23 | A copula object of class \code{"\linkS4class{lowfhCopula}"} 24 | or \code{"\linkS4class{upfhCopula}"}. 25 | } 26 | \note{ 27 | \code{fhCopula()} is a wrapper for \code{lowfhCopula()} and 28 | \code{upfhCopula()}. 29 | 30 | The \code{\link{dCopula}()} method will simply return an error 31 | for these copulas (as their density does not exist). Also, 32 | since the Fr\enc{é}{e}chet-Hoeffding bound copulas are not 33 | parametric, certain methods available for parametric copulas are 34 | not available. 35 | } 36 | %\author{Marius Hofert} 37 | \examples{ 38 | ## Lower bound W : ------------------------- 39 | 40 | try(W <- lowfhCopula(dim = 3)) # lower bound is *not* a copula for dim > 2 41 | W <- lowfhCopula() 42 | wireframe2(W, FUN = pCopula) 43 | plot(W, n=100) # perfect anti-correlation ( rho = tau = -1 ) 44 | 45 | ## Upper bound M : ------------------------- 46 | 47 | wireframe2(upfhCopula(dim = 2), pCopula) 48 | M <- upfhCopula(dim = 3) 49 | set.seed(271) 50 | splom2(M, n = 100) # "random" data: all perfectly correlated 51 | } 52 | \keyword{distribution} 53 | \keyword{multivariate} 54 | -------------------------------------------------------------------------------- /man/fitCopula-class.Rd: -------------------------------------------------------------------------------- 1 | \name{fitCopula-class} 2 | \title{Classes of Fitted Multivariate Models: Copula, Mvdc} 3 | \docType{class} 4 | \alias{fittedMV-class} 5 | \alias{fitCopula-class} 6 | \alias{fitMvdc-class} 7 | \alias{summaryFitCopula-class} 8 | \alias{summaryFitMvdc-class} 9 | % methods --- see also ./show-methods.Rd, and ./fitMvdc.Rd (S3 meth.s) 10 | \alias{summary,fitCopula-method} 11 | \alias{summary,fitMvdc-method} 12 | \description{ 13 | Classes and summary methods related to copula model fitting. 14 | } 15 | \section{Objects from the Class}{ 16 | Objects can be created by calls to \code{\link{fitCopula}} or 17 | \code{\link{fitMvdc}}, respectively or to their \code{summary} methods. 18 | } 19 | \section{Slots}{ 20 | The \dQuote{mother class}, \code{"fittedMV"} has the slots 21 | \describe{ 22 | \item{\code{estimate}:}{\code{numeric}, the estimated parameters.} 23 | \item{\code{var.est}:}{\code{numeric}, variance matrix estimate of 24 | the parameter estimator. See note below.} 25 | \item{\code{loglik}:}{\code{numeric}, log likelihood evaluated at 26 | the maximizer.} 27 | \item{\code{nsample}:}{\code{numeric}, integer representing the 28 | sample size.} 29 | \item{\code{method}:}{\code{character}, method of estimation.} 30 | \item{\code{fitting.stats}:}{a \code{\link{list}}, currently 31 | containing the numeric \code{convergence} code from 32 | \code{\link{optim}}, the \code{counts}, \code{message}, and all 33 | the \code{control} arguments explicitly passed to \code{\link{optim}()}. 34 | Since \pkg{copula} version 1.0-1 also keeps information about 35 | parameter transformations, currently needed only for 36 | \code{\link{mixCopula}} fits with free weights.} 37 | } 38 | In addition, the \code{"fitCopula"} class has a slot 39 | \describe{ 40 | \item{\code{copula}:}{the \emph{fitted} copula, of class 41 | \code{"\linkS4class{copula}"}.} 42 | } 43 | whereas the \code{"fitMvdc"} has 44 | \describe{ 45 | \item{\code{mvdc}:}{the \emph{fitted} distribution, of class 46 | \code{"\linkS4class{mvdc}"}.} 47 | } 48 | } 49 | \section{Extends}{ 50 | Classes \code{"fitCopula"} and \code{"fitMvdc"} extend class 51 | \code{"fittedMV"}, directly. 52 | } 53 | \section{Methods}{ 54 | \describe{ 55 | \item{summary}{\code{signature(object = "fitMvdc")}: ... } 56 | \item{summary}{\code{signature(object = "fitCopula")}: ... } 57 | } 58 | Further, there are S3 methods (class \code{"fittedMV"}) for 59 | \code{\link{coef}()}, \code{\link{vcov}()} and \code{\link{logLik}()}, 60 | see \code{\link{fitMvdc}}. 61 | } 62 | %\author{Marius Hofert, Ivan Kojadinovic, Martin Maechler and Jun Yan} 63 | \references{ 64 | Genest, C., Ghoudi, K., and Rivest, L.-P. (1995). A semiparametric 65 | estimation procedure of dependence parameters in multivariate 66 | families of distributions. \emph{Biometrika} \bold{82}, 543--552. 67 | } 68 | \keyword{classes} 69 | -------------------------------------------------------------------------------- /man/gasoil.Rd: -------------------------------------------------------------------------------- 1 | \name{gasoil} 2 | \title{Daily Crude Oil and Natural Gas Prices from 2003 to 2006} 3 | \alias{gasoil} 4 | \docType{data} 5 | \description{ 6 | Three years of daily prices (from July 2003 to July 2006) of crude oil 7 | and natural gas. These data should be very close to those analysed in 8 | Gr\enc{é}{e}goire, Genest and Gendron (2008). 9 | } 10 | \usage{data(gasoil, package="copula")} 11 | \format{ 12 | A data frame of 762 daily prices from 2003 to 2006. 13 | \describe{ 14 | \item{\code{date}}{date (of class \code{\link{Date}}).} 15 | \item{\code{oil}}{daily price of crude oil} 16 | \item{\code{gas}}{daily price of natural gas} 17 | } 18 | } 19 | %\author{Marius Hofert, Ivan Kojadinovic, Martin Maechler and Jun Yan} 20 | \references{ 21 | Gr\enc{é}{e}goire, V., Genest, C., and Gendron, M. (2008) 22 | Using copulas to model price dependence in energy markets. 23 | \emph{Energy Risk} \bold{5}(5), 58--64. 24 | } 25 | \examples{ 26 | data(gasoil) 27 | ## Log Scaled Oil & Gas Prices : 28 | lattice :: xyplot(oil + gas ~ date, data = gasoil, auto.key=TRUE, 29 | type = c("l","r"), 30 | scales=list(y = list(log = TRUE), equispaced.log = FALSE)) 31 | } 32 | \keyword{datasets} 33 | -------------------------------------------------------------------------------- /man/getAcop.Rd: -------------------------------------------------------------------------------- 1 | \name{getAcop} 2 | \title{Get "acopula" Family Object by Name} 3 | \alias{getAcop} 4 | \alias{getAname} 5 | \alias{.ac.shortNames} 6 | \alias{.ac.longNames} 7 | \alias{.ac.objNames} 8 | \alias{.ac.classNames} 9 | \description{ 10 | Get one of our "acopula" family objects (see \link{acopula-families} 11 | by name. 12 | 13 | Named strings for \dQuote{translation} between different names and 14 | forms of Archimedean copulas. 15 | } 16 | \usage{ 17 | getAcop (family, check = TRUE) 18 | getAname(family, objName = FALSE) 19 | 20 | .ac.shortNames 21 | .ac.longNames 22 | .ac.objNames 23 | .ac.classNames 24 | } 25 | \arguments{ 26 | \item{family}{either a \code{\link{character}} string, the short or longer 27 | form of the Archimedean family name (for example, "Clayton" or simply "C"; 28 | see the \code{\link{acopula-families}} documentation), or an 29 | \code{\linkS4class{acopula}} family object, or an object inheriting 30 | from class \code{\linkS4class{archmCopula}}.} 31 | \item{check}{logical indicating whether the class of the return value 32 | should be checked to be \code{"\linkS4class{acopula}"}.} 33 | \item{objName}{logical indicating that the \emph{name} of the \R 34 | object should be returned, instead of the family name, e.g., 35 | \code{"copClayton"} instead of \code{"Clayton"}.} 36 | } 37 | \value{\code{getAcop()} returns an \code{"\linkS4class{acopula}"} family 38 | object, typically one of one of our predefined ones. 39 | 40 | \code{getAname()} returns a \code{\link{character}} string, the name 41 | of an \code{"\linkS4class{acopula}"} family object. 42 | 43 | \code{.as.longnames} etc are named string constants, useful in 44 | programming for all our (five) standard Archimedean families. 45 | } 46 | %\author{Martin Maechler} 47 | \seealso{ 48 | Our predefined \code{\link{acopula-families}}; 49 | the class definition \code{"\linkS4class{acopula}"}. 50 | } 51 | \examples{ 52 | getAcop("Gumbel") 53 | 54 | ## different ways of getting the same "acopula" family object: 55 | stopifnot(## Joe (three ways): 56 | identical(getAcop("J"), getAcop("Joe")), 57 | identical(getAcop("J"), copJoe), 58 | ## Frank (yet another two different ways): 59 | identical(getAcop(frankCopula()), copFrank), 60 | identical(getAcop("frankCopula"), copFrank)) 61 | 62 | stopifnot( 63 | identical(getAname(claytonCopula()), getAname("C")), 64 | identical(getAname(copClayton), "Clayton"), identical(getAname("J"), "Joe"), 65 | identical(getAname(amhCopula(), TRUE), "copAMH"), 66 | identical(getAname(joeCopula(), TRUE), "copJoe") 67 | ) 68 | 69 | .ac.shortNames 70 | .ac.longNames 71 | .ac.objNames 72 | .ac.classNames 73 | } 74 | \keyword{manip} 75 | -------------------------------------------------------------------------------- /man/getIniParam.Rd: -------------------------------------------------------------------------------- 1 | \name{getIniParam} 2 | \title{Get Initial Parameter Estimate for Copula} 3 | \alias{getIniParam} 4 | \alias{getIniParam,mixCopula-method} 5 | \alias{getIniParam,parCopula-method} 6 | \description{ 7 | A (S4) generic function and methods providing a typically cheap method to get 8 | valid parameters for the \code{copula}, given the \code{data}. This is 9 | used, e.g., in \code{\link{fitCopula}()} when \code{start} is not 10 | specified. 11 | } 12 | \usage{ 13 | getIniParam(copula, data, default, named = TRUE, \dots) 14 | } 15 | \arguments{ 16 | \item{copula}{a \code{"\linkS4class{copula}"} object.} 17 | \item{data}{an \eqn{n\times d}{n x d}-matrix of data to which the copula should be fitted.} 18 | \item{default}{a parameter vector of correct length, to be used when no 19 | method is available or the method does \dQuote{not work}.} 20 | \item{named}{\code{\link{logical}} indicating if the result should have 21 | \code{\link{names}}.} 22 | \item{\dots}{optional further arguments to underlying methods.} 23 | } 24 | 25 | \section{Methods}{ 26 | \describe{ 27 | \item{\code{signature(copula = "parCopula")}}{Close to a \emph{default} 28 | method (as class \code{"\linkS4class{parCopula}"} contains most 29 | copulas), currently mainly trying to use a version of 30 | \code{\link{fitCopula}(*, method = "itau")} (itself based on moment 31 | matching \code{\link{iTau}()}).} 32 | \item{\code{signature(copula = "mixCopula")}}{ 33 | a relatively simple method, for the copula parameters, trying 34 | \code{getInitParam(cop[[k]])} for each component, and using equal weights \code{w[k]}.} 35 | } 36 | } 37 | %% \details{ 38 | %% } 39 | \value{ 40 | a \code{\link{numeric}} vector of correct length, say \code{param}, which 41 | should e.g., \dQuote{work} in \code{\link{loglikCopula}(param, u = data, copula)}. 42 | } 43 | %% \author{Martin Maechler} 44 | \seealso{ 45 | \code{\link{getTheta}()} gets such a vector \emph{from} a \code{copula} object; 46 | \code{\link{fitCopula}}, \code{\link{loglikCopula}}. 47 | } 48 | \examples{ 49 | # TODO ! 50 | } 51 | \keyword{models} 52 | -------------------------------------------------------------------------------- /man/getTheta.Rd: -------------------------------------------------------------------------------- 1 | \name{getTheta} 2 | \title{Get the Parameter(s) of a Copula} 3 | \alias{getTheta} 4 | \alias{getTheta-methods} 5 | \alias{getTheta,parCopula-method} 6 | \alias{getTheta,copula-method} 7 | \alias{getTheta,acopula-method} 8 | \alias{getTheta,Xcopula-method} 9 | \alias{getTheta,khoudrajiCopula-method} 10 | \alias{getTheta,mixCopula-method} 11 | \alias{getTheta,rotCopula-method} 12 | \description{ 13 | Get the parameter (vector) \eqn{\theta}{theta} (\code{theta}) of 14 | a copula, see \code{\link{setTheta}} for more background. 15 | } 16 | \usage{%% S4 generic and all S4 methods have same signature (no '...') 17 | getTheta(copula, freeOnly = TRUE, attr = FALSE, named = attr) 18 | } 19 | \arguments{ 20 | \item{copula}{an \R object of class \code{"\linkS4class{parCopula}"}, 21 | e.g., \code{"\linkS4class{copula}"}.}% only, for now 22 | %%, i.e., any copula from package \pkg{copula}. 23 | \item{freeOnly}{logical indicating that only non-fixed aka 24 | \dQuote{free} parameters are to be returned (as vector).} 25 | \item{attr}{logical indicating if \code{\link{attributes}} (such as 26 | lower and uppder bounds for each parameters) are to be returned as well.} 27 | \item{named}{logical if the resulting parameter vector should have 28 | \code{\link{names}}.} 29 | } 30 | \section{Methods}{ 31 | \describe{ 32 | \item{\code{signature(copula = "parCopula")}}{a default method, 33 | returning \code{numeric(0).}} 34 | \item{\code{signature(copula = "copula")}}{ .. } 35 | \item{\code{signature(copula = "acopula")}}{ .. } 36 | \item{\code{signature(copula = "khoudrajiCopula")}}{ .. } 37 | \item{\code{signature(copula = "mixCopula")}}{ .. } 38 | \item{\code{signature(copula = "rotCopula")}}{ .. } 39 | \item{\code{signature(copula = "Xcopula")}}{ .. } 40 | } 41 | } 42 | %% \details{ 43 | %% } 44 | \value{ 45 | parameter vector of the copula, a \code{\link{numeric}} vector, 46 | possibly with names and other attributes (depending on the \code{attr} 47 | and \code{named} arguments). 48 | } 49 | \seealso{ 50 | \code{\link{setTheta}}, its inverse. 51 | } 52 | \examples{ 53 | showMethods("getTheta") 54 | \dontshow{stopifnot(all.equal(} 55 | getTheta(setTheta(copClayton, 0.5)) # is 0.5 56 | \dontshow{, 0.5))} 57 | } 58 | \keyword{manip} 59 | \keyword{methods} 60 | -------------------------------------------------------------------------------- /man/gofOtherTstat.Rd: -------------------------------------------------------------------------------- 1 | \name{gofOtherTstat} 2 | \alias{gofBTstat} 3 | \title{Various Goodness-of-fit Test Statistics} 4 | \description{ 5 | \code{gofBTstat()} computes supposedly Beta distributed test 6 | statistics for checking uniformity of \code{u} on the unit sphere. 7 | } 8 | \usage{ 9 | gofBTstat(u) 10 | } 11 | \arguments{ 12 | \item{u}{\eqn{(n,d)}-matrix of values whose rows supposedly follow a 13 | uniform distribution on the unit sphere in \eqn{\mathbf{R}^d}{IR^d}.} 14 | } 15 | \value{ 16 | An \eqn{(n,d-1)}-\code{\link{matrix}} where the \eqn{(i,k)}th entry is 17 | \deqn{B_{ik}=\frac{\sum_{j=1}^k u_{ij}^2}{\sum_{j=1}^d u_{ij}^2}. 18 | }{B[ik] = (u[i,1]^2+..+u[i,k]^2) / (u[i,1]^2+..+u[i,d]^2).} 19 | } 20 | %\author{Marius Hofert.} 21 | \references{ 22 | Li, R.-Z., Fang, K.-T., and Zhu, L.-X. (1997). 23 | Some Q-Q probability plots to test spherical and elliptical symmetry. 24 | \emph{Journal of Computational and Graphical Statistics} \bold{6}(4), 435--450. 25 | } 26 | \examples{ 27 | ## generate data on the unit sphere 28 | n <- 360 29 | d <- 5 30 | set.seed(1) 31 | x <- matrix(rnorm(n*d), ncol=d) 32 | U <- x/sqrt(rowSums(x^2)) 33 | 34 | ## compute the test statistics B_k, k in {1,..,d-1} 35 | Bmat <- gofBTstat(U) 36 | 37 | ## (graphically) check if Bmat[,k] follows a Beta(k/2, (d-k)/2) distribution 38 | qqp <- function(k, Bmat) { 39 | d <- ncol(Bmat)+1L 40 | tit <- substitute(plain("Beta")(.A.,.B.)~~ bold("Q-Q Plot"), 41 | list(.A. = k/2, .B. = (d-k)/2)) 42 | qqplot2(Bmat[,k], qF=function(p) qbeta(p, shape1=k/2, shape2=(d-k)/2), 43 | main.args=list(text=tit, side=3, cex=1.3, line=1.1, xpd=NA)) 44 | } 45 | qqp(1, Bmat=Bmat) # k=1 46 | qqp(3, Bmat=Bmat) # k=3 47 | } 48 | \keyword{htest} 49 | \keyword{goodness-of-fit} 50 | \keyword{distribution} 51 | \keyword{multivariate} 52 | -------------------------------------------------------------------------------- /man/indepCopula-class.Rd: -------------------------------------------------------------------------------- 1 | \name{indepCopula-class} 2 | \docType{class} 3 | \alias{indepCopula-class} 4 | \title{Class "indepCopula"} 5 | \description{Independence copula class.} 6 | \section{Objects from the Class}{ 7 | Objects can be created by calls of the form \code{new("indepCopula", ...)} 8 | or by function \code{\link{indepCopula}()}. Such objects can be 9 | useful as special cases of parametric copulas, bypassing 10 | copula-specific computations such as distribution, density, and sampler. 11 | } 12 | \section{Slots}{ 13 | \describe{ 14 | \item{\code{dimension}:}{Object of class \code{"numeric"}, dimension 15 | of the copula.} 16 | \item{\code{exprdist}:}{an \code{\link{expression}} of length two, 17 | for the \dQuote{formulas} of the cdf and pdf of the copula.}% used in ../R/dC-dc.R 18 | } 19 | } 20 | \section{Methods}{ 21 | \describe{ 22 | \item{A}{\code{signature(copula = "indepCopula")}: ... } 23 | \item{dCopula}{\code{signature(copula = "indepCopula")}: ... } 24 | \item{pCopula}{\code{signature(copula = "indepCopula")}: ... } 25 | \item{rCopula}{\code{signature(copula = "indepCopula")}: ... } 26 | } 27 | } 28 | \section{Extends}{ 29 | Class \code{"indepCopula"} directly extends classes 30 | \code{"\linkS4class{dimCopula}"} and \code{"\linkS4class{parCopula}"}. 31 | } 32 | %\author{Ivan Kojadinovic, Jun Yan and Martin M} 33 | \seealso{ 34 | \code{\link{indepCopula}}; documentation for classes 35 | \code{\linkS4class{dimCopula}} and 36 | \code{\linkS4class{parCopula}}. 37 | } 38 | \examples{ 39 | getClass("indepCopula") 40 | } 41 | \keyword{classes} 42 | -------------------------------------------------------------------------------- /man/indepCopula.Rd: -------------------------------------------------------------------------------- 1 | \name{indepCopula} 2 | \alias{indepCopula} 3 | \title{Construction of Independence Copula Objects} 4 | \description{ 5 | Constructs an independence copula with its corresponding dimension. 6 | } 7 | \usage{ 8 | indepCopula(dim = 2) 9 | } 10 | \arguments{ 11 | \item{dim}{the dimension of the copula.} 12 | } 13 | \value{ 14 | An independence copula object of class \code{"\linkS4class{indepCopula}"}. 15 | } 16 | %\author{Ivan Kojadinovic and Jun Yan} 17 | \seealso{Mathematically, the independence copula is also a special 18 | (boundary) case of e.g., classes \code{"\linkS4class{archmCopula}"}, 19 | \code{"\linkS4class{ellipCopula}"}, and \code{"\linkS4class{evCopula}"}. 20 | } 21 | \examples{ 22 | indep.cop <- indepCopula(3) 23 | x <- rCopula(10, indep.cop) 24 | dCopula(x, indep.cop) 25 | persp(indepCopula(), pCopula) 26 | } 27 | \keyword{ distribution } 28 | \keyword{ multivariate } 29 | -------------------------------------------------------------------------------- /man/interval-class.Rd: -------------------------------------------------------------------------------- 1 | \name{interval-class} 2 | \Rdversion{1.1} 3 | \docType{class} 4 | \alias{interval-class} 5 | \alias{maybeInterval-class} 6 | \alias{format,interval-method} 7 | \alias{show,interval-method} 8 | \alias{\%in\%,numeric,interval-method} 9 | \alias{Summary,interval-method} 10 | \title{Class "interval" of Simple Intervals} 11 | \description{ 12 | The S4 \code{\link{class}} \code{"interval"} is a simple class for numeric 13 | intervals. 14 | 15 | \code{"maybeInterval"} is a class union (see 16 | \code{\link{setClassUnion}}) of \code{"interval"} and \code{"NULL"}. 17 | } 18 | \section{Objects from the Class}{ 19 | Objects can be created by calls of the form \code{new("interval", ...)}, 20 | but typically they are built via \code{\link{interval}()}. 21 | } 22 | \section{Slots}{ 23 | \describe{ 24 | \item{\code{.Data}:}{numeric vector of length two, specifying the 25 | interval ranges.} 26 | \item{\code{open}:}{\code{\link{logical}} vector of length two, 27 | specifying if the interval is open or closed on the left and 28 | right, respectively.} 29 | } 30 | } 31 | \section{Extends}{ 32 | Class \code{"interval"} extends \code{"\linkS4class{numeric}"}, from 33 | data part, and \code{"maybeInterval"}, directly. 34 | } 35 | \section{Methods}{ 36 | \describe{ 37 | \item{"\%in\%"}{\code{signature(x = "numeric", table = "interval")}: 38 | check if \code{x} is inside the interval, carefully differentiating 39 | open and closed intervals.} 40 | \item{format}{\code{signature(x = "interval")}: ... } 41 | \item{show}{\code{signature(object = "interval")}: ... } 42 | \item{Summary}{\code{signature(x = "interval")}: Group methods, 43 | notably \code{\link{range}()}, \code{\link{min}()}, etc.} 44 | } 45 | } 46 | \note{ 47 | There are more sophisticated interval classes, functions and methods, 48 | notably in package \CRANpkg{intervals}. We only use this as a simple 49 | interface in order to specify our copula functions consistently. 50 | } 51 | %\author{Martin Maechler} 52 | \seealso{ 53 | \code{\link{interval}} constructs "interval" objects conveniently. 54 | } 55 | \examples{ 56 | -1:2 \%in\% interval("(0, Inf)") 57 | ## 0 is *not* inside 58 | } 59 | \keyword{classes} 60 | -------------------------------------------------------------------------------- /man/interval.Rd: -------------------------------------------------------------------------------- 1 | \name{interval} 2 | \alias{interval} 3 | \title{Construct Simple "interval" Object} 4 | \description{ 5 | Easy construction of an object of class \code{\linkS4class{interval}}, 6 | using typical mathematical notation. 7 | } 8 | \usage{ 9 | interval(ch) 10 | } 11 | \arguments{ 12 | \item{ch}{a character string specifying the interval.} 13 | } 14 | \value{ 15 | an \code{\linkS4class{interval}} object. 16 | } 17 | %\author{Martin Maechler} 18 | \seealso{ 19 | the \code{\linkS4class{interval}} class documentation, 20 | notably its reference to more sophisticated interval classes available 21 | for \R. 22 | } 23 | \examples{ 24 | interval("[0, 1)") 25 | 26 | ## Two ways to specify open interval borders: 27 | identical(interval("]-1,1["), 28 | interval("(-1,1)")) 29 | 30 | ## infinite : 31 | interval("[0, Inf)") 32 | 33 | ## arithmetic with scalars works: 34 | 4 + 2 * interval("[0, 1.5)") # -> [4, 7) 35 | 36 | ## str() to look at internals: 37 | str( interval("[1.2, 7]") ) 38 | } 39 | \keyword{arith} 40 | \keyword{utilities} 41 | -------------------------------------------------------------------------------- /man/log1mexp.Rd: -------------------------------------------------------------------------------- 1 | \name{log1mexp} 2 | \alias{log1pexp} 3 | \alias{log1mexp} 4 | \title{Compute f(a) = \eqn{\mathrm{log}}{log}(1 +/- \eqn{\mathrm{exp}}{exp}(-a)) 5 | Numerically Optimally} 6 | \description{ 7 | Compute f(a) = log(1 - exp(-a)), respectively 8 | g(x) = log(1 + exp(x)) quickly numerically accurately. 9 | } 10 | \usage{ 11 | log1mexp(a, cutoff = log(2)) 12 | log1pexp(x, c0 = -37, c1 = 18, c2 = 33.3) 13 | } 14 | \arguments{ 15 | \item{a}{numeric vector of positive values} 16 | \item{x}{numeric vector} 17 | \item{cutoff}{positive number; \code{log(2)} is \dQuote{optimal}, 18 | %% see below, TODO 19 | but the exact value is unimportant, and anything in 20 | \eqn{[0.5, 1]} is fine.} 21 | \item{c0, c1, c2}{cutoffs for \code{log1pexp}; see below.} 22 | } 23 | \value{ 24 | f(a) == log(1 - exp(-a)) == log1p(-exp(-a)) == 25 | log(-expm1(-a)) 26 | 27 | or 28 | 29 | g(x) == log(1 + exp(x)) == log1p(exp(x)) 30 | 31 | computed accurately and quickly 32 | } 33 | %\author{Martin Maechler, May 2002; \code{log1pexp()} in 2012} 34 | \references{% ~/R/Pkgs/Rmpfr/vignettes/log1mexp-note.Rnw 35 | Martin \enc{Mächler}{Maechler} (2012). 36 | Accurately Computing \eqn{\log(1-\exp(-|a|))}; 37 | \url{https://CRAN.R-project.org/package=Rmpfr/vignettes/log1mexp-note.pdf}. 38 | % see also <> in ../inst/doc/Frank-Rmpfr.Rnw 39 | } 40 | \examples{ 41 | a <- 2^seq(-58,10, length = 256) 42 | fExpr <- expression( 43 | log(1 - exp(-a)), 44 | log(-expm1(-a)), 45 | log1p(-exp(-a)), 46 | log1mexp(a)) 47 | names(fExpr) <- c("DEF", "expm1", "log1p", "F") 48 | str(fa <- do.call(cbind, as.list(fExpr))) 49 | head(fa)# expm1() works here 50 | tail(fa)# log1p() works here 51 | 52 | ## graphically: 53 | lwd <- 1.5*(5:2); col <- adjustcolor(1:4, 0.4) 54 | op <- par(mfcol=c(1,2), mgp = c(1.25, .6, 0), mar = .1+c(3,2,1,1)) 55 | matplot(a, fa, type = "l", log = "x", col=col, lwd=lwd) 56 | legend("topleft", fExpr, col=col, lwd=lwd, lty=1:4, bty="n") 57 | # expm1() & log1mexp() work here 58 | 59 | matplot(a, -fa, type = "l", log = "xy", col=col, lwd=lwd) 60 | legend("left", paste("-",fExpr), col=col, lwd=lwd, lty=1:4, bty="n") 61 | # log1p() & log1mexp() work here 62 | par(op) 63 | 64 | curve(log1pexp, -10, 10, asp=1) 65 | abline(0,1, h=0,v=0, lty=3, col="gray") 66 | 67 | ## Cutoff c1 for log1pexp() -- not often "needed": 68 | curve(log1p(exp(x)) - log1pexp(x), 16, 20, n=2049) 69 | ## need for *some* cutoff: 70 | x <- seq(700, 720, by=2) 71 | cbind(x, log1p(exp(x)), log1pexp(x)) 72 | 73 | ## Cutoff c2 for log1pexp(): 74 | curve((x+exp(-x)) - x, 20, 40, n=1025) 75 | curve((x+exp(-x)) - x, 33.1, 33.5, n=1025) 76 | } 77 | \keyword{math} 78 | -------------------------------------------------------------------------------- /man/loss.Rd: -------------------------------------------------------------------------------- 1 | \name{loss} 2 | \Rdversion{1.1} 3 | \alias{loss} 4 | \docType{data} 5 | \title{LOSS and ALAE Insurance Data} 6 | \description{ 7 | Indemnity payment and allocated loss adjustment expense from an insurance 8 | company. 9 | } 10 | \usage{data(loss, package="copula")} 11 | \format{ 12 | A data frame with 1500 observations of the following 4 variables: 13 | \describe{ 14 | \item{\code{loss}}{a numeric vector of loss amount up to the \code{limit}.} 15 | \item{\code{alae}}{a numeric vector of the corresponding allocated loss 16 | adjustment expense.} 17 | \item{\code{limit}}{a numeric vector of limit (-99 means no limit).} 18 | \item{\code{censored}}{1 means censored (limit reached) and 0 otherwise.} 19 | } 20 | } 21 | %\author{Ivan Kojadinovic and Jun Yan} 22 | \references{ 23 | Frees, E. and Valdez, E. (1998). Understanding relationships using 24 | copulas. \emph{North American Actuarial Journal} \bold{2}, 1--25. 25 | } 26 | \examples{ 27 | data(loss) 28 | } 29 | \keyword{datasets} 30 | -------------------------------------------------------------------------------- /man/margCopula.Rd: -------------------------------------------------------------------------------- 1 | \name{margCopula} 2 | \title{Marginal copula of a Copula With Specified Margins} 3 | \alias{margCopula} 4 | \alias{margCopula,archmCopula,logical-method} 5 | \alias{margCopula,normalCopula,logical-method} 6 | \alias{margCopula,tCopula,logical-method} 7 | \description{ 8 | The marginal copula of a copula \eqn{C(u_1,\dots, u_d)} is simply the 9 | restriction of \eqn{C} on a subset of the the coordinate (directions) \eqn{u_1,\dots,u_d}. 10 | } 11 | \usage{ 12 | margCopula(copula, keep) 13 | } 14 | \arguments{ 15 | \item{copula}{a \code{"\linkS4class{copula}"} (\R object) of 16 | dimension, \eqn{d}, say.} 17 | \item{keep}{logical vector (of length \code{d}) indicating which margins to keep.} 18 | } 19 | \details{ 20 | The marginal copula of a copula is needed in practical data analysis when 21 | one or more of the components of some multivariate observations is 22 | missing. For normal/t/Archimedean copulas, the marginal copulas can be 23 | easily obtained. For a general copula, this may not be an easy problem. 24 | 25 | The current implementation only supports normal/t/Archimedean 26 | copulas. \code{margCopula} is generic function with methods for the 27 | different copula classes. 28 | } 29 | \value{ 30 | The marginal copula of the specified margin(s). 31 | } 32 | %\author{Jun Yan} 33 | \examples{ 34 | tc <- tCopula(8:2 / 10, dim = 8, dispstr = "toep") 35 | margCopula(tc, c(TRUE, TRUE, FALSE, TRUE, FALSE, FALSE, TRUE, FALSE)) 36 | 37 | nc <- normalCopula(.8, dim = 8, dispstr = "ar1") 38 | mnc <- margCopula(nc, c(TRUE, TRUE, FALSE, TRUE, FALSE, FALSE, TRUE, FALSE)) 39 | mnc7 <- margCopula(nc, (1:8) != 1) 40 | stopifnot(dim(nc) == 8, dim(mnc) == 4, dim(mnc7) == 7) 41 | 42 | gc <- gumbelCopula(2, dim = 8) 43 | margCopula(gc, c(TRUE, TRUE, TRUE, FALSE, FALSE, FALSE, FALSE, FALSE)) 44 | } 45 | \keyword{models} 46 | \keyword{multivariate} 47 | -------------------------------------------------------------------------------- /man/math-fun.Rd: -------------------------------------------------------------------------------- 1 | \name{math-fun} 2 | \alias{A..Z} 3 | \alias{sinc} 4 | \title{Sinc, Zolotarev's, and Other Mathematical Utility Functions} 5 | \description{ 6 | \code{sinc(x)} computes the \emph{sinc function} 7 | \eqn{s(x)=\sin(x)/x}{s(x) = sin(x)/x} for \eqn{x\ne 0}{x != 0} and 8 | \eqn{s(0) = 1}, such that \eqn{s()} is continuous, also at \eqn{x = 0}. 9 | 10 | \code{A..Z(x, a)} computes Zolotarev's function to 11 | the power \code{1-a}. 12 | 13 | } 14 | \usage{ 15 | sinc(x) 16 | A..Z(x, alpha, I.alpha = 1 - alpha) 17 | } 18 | \arguments{ 19 | \item{x}{\code{\link{numeric}} argument in \eqn{[0,\pi]}{[0,pi]}, 20 | typically a vector.} 21 | \item{alpha}{parameter in (0,1].} 22 | \item{I.alpha}{must be \code{ = 1 - alpha}, maybe more accurately 23 | when \code{alpha} is very close to 1.} 24 | } 25 | \details{ 26 | For more details about Zolotarev's function, see, for example, Devroye (2009). 27 | } 28 | \value{ 29 | \code{A..Z(x,alpha)} is \eqn{\tilde A_{Z}(x,\alpha)}{A~Z(x,alpha)}, 30 | defined as 31 | \deqn{\frac{\sin(\alpha x)^\alpha\sin((1-\alpha)x)^{1-\alpha}}{\sin(x)},\ 32 | x\in[0,\pi],}{% 33 | sin(alpha*x)^alpha * sin((1-alpha)*x)^(1-alpha) / sin(x), x in [0,pi],} 34 | 35 | where \eqn{\alpha\in(0,1]}{alpha in (0,1]} is \code{alpha}. 36 | } 37 | %\author{Martin Maechler} 38 | \seealso{ 39 | \code{\link{retstable}} internally makes use of these functions. 40 | } 41 | \references{ 42 | Devroye, L. (2009) 43 | Random variate generation for exponentially and polynomially tilted 44 | stable distributions, 45 | \emph{ACM Transactions on Modeling and Computer Simulation} \bold{19}, 46 | 18, 1--20. 47 | } 48 | \examples{ 49 | curve(sinc, -15,25); abline(h=0,v=0, lty=2) 50 | curve(A..Z(x, 0.25), xlim = c(-4,4), 51 | main = "Zolotarev's function A(x) ^ 1-alpha") 52 | } 53 | \keyword{math} 54 | -------------------------------------------------------------------------------- /man/mixCopula-class.Rd: -------------------------------------------------------------------------------- 1 | \name{mixCopula-class} 2 | \title{Class \code{"mixCopula"} of Copula Mixtures} 3 | \alias{mixCopula-class} 4 | \alias{dim,mixCopula-method} 5 | \alias{lambda,mixCopula-method} 6 | \alias{rho,mixCopula-method} 7 | \Rdversion{1.1} 8 | \docType{class} 9 | \description{ 10 | The class \code{"mixCopula"} is the class of all finite mixtures of 11 | copulas. 12 | 13 | These are given by (a list of) \eqn{m} \dQuote{arbitrary} copulas, and 14 | their respective \eqn{m} non-negative probability weights. 15 | } 16 | \section{Objects from the Class}{ 17 | Objects are typically created by \code{\link{mixCopula}()}. 18 | } 19 | \section{Slots}{ 20 | \describe{ 21 | \item{\code{w}:}{Object of class \code{"mixWeights"}, basically a 22 | non-negative \code{\link{numeric}} vector of length, say \eqn{m}, 23 | which sums to one.} 24 | \item{\code{cops}:}{Object of class \code{"parClist"}, a 25 | \code{\link{list}} of (parametrized) copulas, \code{"\linkS4class{parCopula}"}.} 26 | } 27 | } 28 | \note{ 29 | As the probability weights must some to one (\code{1}), which is part 30 | of the validity (see \code{\link{validObject}}) of an object of class 31 | \code{"mixWeights"}, the number of \dQuote{free} parameters inherently 32 | is (at most) one \emph{less} than the number of mixture components 33 | \eqn{m}. 34 | 35 | Because of that, it does not make sense to fix (see 36 | \code{\link{fixParam}} or \code{\link{fixedParam<-}}) 37 | all but one of the weights: Either all are fixed, or at least two must 38 | be free. Further note, that the definition of free or fixed 39 | parameters, and the meaning of the methods (for \code{mixCopula}) of 40 | \code{\link{getTheta}}, \code{\link{setTheta}} and 41 | \code{\link{fixedParam<-}} will probably change in a next release of 42 | package \pkg{copula}, where it is planned to use a reparametrization 43 | better suited for \code{\link{fitCopula}}. 44 | } 45 | \section{Extends}{ 46 | Class \code{"\linkS4class{parCopula}"}, directly. 47 | Class \code{"\linkS4class{Copula}"}, by class "parCopula", distance 2. 48 | } 49 | \section{Methods}{ 50 | \describe{ 51 | \item{dim}{\code{signature(x = "mixCopula")}: dimension of copula.} 52 | \item{rho}{\code{signature(x = "mixCopula")}: Spearman's rho of 53 | copula \code{x}.} 54 | \item{lambda}{\code{signature(x = "mixCopula")}: lower and upper 55 | tail dependecies \code{\link{lambda}}, \eqn{(\lambda[L],\lambda[U])}, 56 | of the mixture copula.} 57 | } 58 | } 59 | \seealso{ 60 | \code{\link{mixCopula}} for creation and examples. 61 | } 62 | \examples{ 63 | showClass("mixCopula") 64 | } 65 | \keyword{classes} 66 | -------------------------------------------------------------------------------- /man/moCopula-class.Rd: -------------------------------------------------------------------------------- 1 | \name{moCopula-class} 2 | \docType{class} 3 | \alias{moCopula-class} 4 | \title{Class "moCopula" of Marshall-Olkin Copulas} 5 | \description{ 6 | The Marshall-Olkin copula class. 7 | 8 | The (2-dimensional) "MO" copula with parameter 9 | \eqn{\bold\theta\in [0,1]^2}{theta in [0,1]^2} is (i.e., its CDF is) 10 | \deqn{C(u_1, u_2) = min(u_1 * u_2^(1 - \theta_2), u_1^(1 - \theta_1) * u_2).% 11 | }{C(u1, u2) = min(u1 * u2^(1 - theta2), u1^(1 - theta1) * u2).} 12 | Consequently, the density is undefined on a curve (in \eqn{[0,1]^2}), 13 | namely for the points \eqn{\bold{u}=(u_1,u_2)}{u=(u1,u2)} where two 14 | expressions in the above \eqn{min(f(u), g(u))} are equal, 15 | \eqn{f(u)=g(u)}. It is easy to see that that is equivalent to 16 | %% \eqn{u_1 * u_2^(1 - \theta_2) = u_1^(1 - \theta_1) * u_2,% 17 | %% }{u1 * u2^(1 - theta2) = u1^(1 - theta1) * u,2} which is equivalent to 18 | \deqn{u_1^{\theta_1} = u_2^{\theta_2}.}{u1^theta_1 = u2^theta2.} 19 | %% and it is everywhere else, i.e., "almost everywhere"! 20 | } 21 | \section{Objects from the Class}{ 22 | Objects can be created by \code{new("moCopula", ...)} but are 23 | typically produced by \code{\link{moCopula}(...)}. 24 | } 25 | \section{Slots}{ 26 | \describe{ 27 | \item{\code{dimension}:}{Numeric (scalar), the dimension of the copula.} 28 | \item{\code{exprdist}:}{a length two \code{\link{expression}} with 29 | expressions for the CDF and PDF of the copula.}% FIXME: still used? 30 | \item{\code{parameters}:}{numeric vector of two parameter values in \eqn{[0,1]}.} 31 | \item{\code{param.names}:}{\code{"\link{character}"} vector of length two.} 32 | \item{\code{param.lowbnd}:}{numeric vector of two values in \eqn{[0,1]}.} 33 | \item{\code{param.upbnd}:}{numeric vector of two values in \eqn{[0,1]}.} 34 | \item{\code{fullname}:}{(deprecated; do not use!)} 35 | } 36 | } 37 | \section{Methods}{ 38 | Typical copula methods work, see \code{"\linkS4class{moCopula}"} 39 | and use \code{methods(class = "moCopula")}. 40 | } 41 | \section{Extends}{ 42 | Class \code{"moCopula"} extends class \code{"\linkS4class{copula}"} directly. 43 | } 44 | %\author{Marius Hofert} 45 | \references{ 46 | Nelsen, R. B. (2006), \emph{An introduction to Copulas}, Springer, New York. 47 | } 48 | \seealso{ 49 | \code{\link{moCopula}} for constructing them; 50 | \code{\link{copula-class}}. 51 | } 52 | \examples{ 53 | moCopula()@exprdist[["cdf"]] # a simple definition 54 | 55 | methods(class = "moCopula") 56 | contourplot2(moCopula(c(.1, .8)), pCopula, main= "moCopula((0.1, 0.8))") 57 | 58 | Xmo <- rCopula(5000, moCopula(c(.2, .5))) 59 | try( # gives an error, as there is no density (!): 60 | loglikCopula(c(.1, .2), Xmo, moCopula()) 61 | ) 62 | 63 | plot(moCopula(c(.9, .2)), n = 10000, xaxs="i", yaxs="i", 64 | # opaque color (for "density effect"): 65 | pch = 16, col = adjustcolor("black", 0.3)) 66 | } 67 | \keyword{classes} 68 | -------------------------------------------------------------------------------- /man/moCopula.Rd: -------------------------------------------------------------------------------- 1 | \name{moCopula} 2 | \title{The Marshall-Olkin Copula} 3 | \alias{moCopula} 4 | \description{ 5 | Computes Marshall-Olkin copulas in the bivariate case. 6 | } 7 | \usage{ 8 | moCopula(param = NA_real_, dim = 2L) 9 | } 10 | \arguments{ 11 | \item{param}{\code{\link{numeric}} vector of length two specifying the 12 | copula parameters (in \eqn{[0,1]}).} 13 | \item{dim}{the dimension of the copula.} 14 | } 15 | \value{ 16 | \code{moCopula()} is the constructor for objects of class 17 | \code{\linkS4class{moCopula}}. 18 | } 19 | \note{ 20 | Marshall-Olkin copulas are only implemented for \code{dim = 2L}. 21 | } 22 | %% \references{ 23 | %% } 24 | \seealso{ 25 | The \code{"\linkS4class{moCopula}"} class, its mathematical 26 | definition, etc. 27 | } 28 | %\author{Marius Hofert} 29 | \examples{ 30 | alpha <- c(0.2, 0.7) 31 | MO <- moCopula(alpha) 32 | tau(MO) # 0.18 33 | lambda(MO) 34 | stopifnot(all.equal(lambda(MO), 35 | c(lower = 0, upper = 0.2))) 36 | wireframe2 (MO, FUN = pCopula) # if you look carefully, you can see the kink 37 | contourplot2(MO, FUN = pCopula) 38 | set.seed(271) 39 | plot(rCopula(1000, MO)) 40 | } 41 | \keyword{multivariate} 42 | -------------------------------------------------------------------------------- /man/mvdc-class.Rd: -------------------------------------------------------------------------------- 1 | \name{mvdc-class} 2 | \title{Class "mvdc": Multivariate Distributions from Copulas} 3 | \docType{class} 4 | \alias{mvdc-class} 5 | \alias{dim,mvdc-method} 6 | \alias{show,mvdc-method} 7 | \description{ 8 | \code{"mvdc"} is a \code{\link{class}} representing 9 | \bold{m}ulti\bold{v}ariate \bold{d}istributions constructed via 10 | \bold{c}opula and margins, using Sklar's theorem. } 11 | \section{Objects from the Class}{ 12 | Objects are typically created by \code{\link{mvdc}()}, or 13 | can be created by calls of the form \code{new("mvdc", ...)}. 14 | } 15 | \section{Slots}{ 16 | \describe{ 17 | \item{\code{copula}:}{Object of class \code{"\linkS4class{copula}"}, 18 | specifying the copula.} 19 | \item{\code{margins}:}{Object of class \code{"character"}, 20 | specifying the marginal distributions. } 21 | \item{\code{paramMargins}:}{Object of class \code{"list"}, whose 22 | each component is a list of named components, giving the parameter 23 | values of the marginal distributions. See \code{\link{mvdc}}. } 24 | \item{\code{marginsIdentical}:}{Object of class \code{"logical"}, 25 | that, if TRUE, restricts the marginal distributions to be 26 | identical, default is \code{FALSE}. } 27 | } 28 | } 29 | \section{Methods}{ 30 | \describe{ 31 | \item{contour}{\code{signature(x = "mvdc")}: ... } 32 | \item{dim}{\code{signature(x = "mvdc")}: the dimension of the 33 | distribution; this is the same as \code{dim(x@copula)}.} 34 | \item{persp}{\code{signature(x = "mvdc")}: ... } 35 | \item{show}{\code{signature(object = "mvdc")}: quite compactly display 36 | the content of the "mvdc" \code{object}.} 37 | } 38 | } 39 | %\author{Ivan Kojadinovic and Martin Maechler} 40 | \seealso{ 41 | \code{\link{mvdc}}, % ./Mvdc.Rd 42 | also for examples; for fitting, \code{\link{fitMvdc}}. 43 | } 44 | \keyword{classes} 45 | -------------------------------------------------------------------------------- /man/nacPairthetas.Rd: -------------------------------------------------------------------------------- 1 | \name{nacPairthetas} 2 | \alias{nacPairthetas} 3 | \title{Pairwise Thetas of Nested Archimedean Copulas} 4 | \description{ 5 | Return a \eqn{d * d} matrix of pairwise thetas for a nested Archimedean 6 | copula (\code{\linkS4class{nacopula}}) of dimension \eqn{d}. 7 | } 8 | \usage{ 9 | nacPairthetas(x) 10 | } 11 | \arguments{ 12 | \item{x}{an (outer) nacopula (with thetas sets).} 13 | } 14 | % \details{ 15 | % } 16 | \value{ 17 | a (\eqn{d \times d}{d x d}) matrix of thetas, say \code{T}, where 18 | \code{T[j,k]} = theta of the bivariate Archimedean copula 19 | \eqn{C(U_j,U_k)}. 20 | } 21 | %\author{Martin Maechler} 22 | \seealso{ 23 | the class \code{\linkS4class{nacopula}} (with its \code{\link{dim}} 24 | method). 25 | } 26 | \examples{ 27 | ## test with 28 | options(width=97) 29 | 30 | (mm <- rnacModel("Gumbel", d=15, pr.comp = 0.25, order="random")) 31 | stopifnot(isSymmetric(PT <- nacPairthetas(mm))) 32 | round(PT, 2) 33 | 34 | ## The tau's -- "Kendall's correlation matrix" : 35 | round(copGumbel@tau(PT), 2) 36 | 37 | ## do this several times: 38 | m1 <- rnacModel("Gumbel", d=15, pr.comp = 1/8, order="seq") 39 | stopifnot(isSymmetric(PT <- nacPairthetas(m1))) 40 | m1; PT 41 | 42 | %%___ FIXME __: This shows that rnacModel() should choose 'nkids' less 43 | %% aggressively.. 44 | m100 <- rnacModel("Gumbel", d= 100, pr.comp = 1/16, order="seq") 45 | system.time(PT <- nacPairthetas(m100))# how slow {non-optimal algorithm}? 46 | ##-- very fast, still! 47 | stopifnot(isSymmetric(PT)) 48 | m100 49 | 50 | ## image(PT)# not ok -- want one color per theta 51 | nt <- length(th0 <- unique(sort(PT[!is.na(PT)]))) 52 | th1 <- c(th0[1]/2, th0, 1.25*th0[nt]) 53 | ths <- (th1[-1]+th1[-(nt+2)])/2 54 | image(log(PT), breaks = ths, col = heat.colors(nt)) 55 | 56 | ## Nicer and easier: 57 | require(Matrix) 58 | image(as(log(PT),"Matrix"), main = "log( nacPairthetas( m100 ))", 59 | useAbs=FALSE, useRaster=TRUE, border=NA) 60 | } 61 | \keyword{utilities} 62 | -------------------------------------------------------------------------------- /man/nacTiming.Rd: -------------------------------------------------------------------------------- 1 | \name{nacFrail.time} 2 | \alias{nacFrail.time} 3 | \title{Timing for Sampling Frailties of Nested Archimedean Copulas} 4 | \usage{ 5 | nacFrail.time(n, family, taus, digits = 3, verbose = FALSE) 6 | } 7 | \description{ 8 | This function provides measurements of user run times for the frailty 9 | variables involved in a nested Archimedean copula. 10 | } 11 | \arguments{ 12 | \item{n}{integer specifying the sample size to be used for the random 13 | variates \eqn{V_0}{V0} and \eqn{V_{01}}{V01}.} 14 | \item{family}{the Archimedean family (class 15 | \code{"\linkS4class{acopula}"}) for which \eqn{V_0}{V0} and 16 | \eqn{V_{01}}{V01} are sampled.} 17 | \item{taus}{\code{\link{numeric}} vector of Kendall's taus. This vector is 18 | converted to a vector of copula parameters \eqn{\theta}{theta}, which then serve as 19 | \eqn{\theta_0}{theta0} and \eqn{\theta_1}{theta1} for a three-dimensional 20 | fully nested Archimedean copula of the specified \code{family}. First, for 21 | each \eqn{\theta_0}{theta0}, \code{n} random variates \eqn{V_0}{V0} are 22 | generated. Then, given the particular \eqn{\theta_0}{theta0} and the 23 | realizations \eqn{V_0}{V0}, \code{n} random variates 24 | \eqn{V_{01}}{V01} are generated for each \eqn{\theta_1}{theta1} 25 | fulfilling the sufficient nesting condition; see \code{paraConstr} 26 | in \code{\linkS4class{acopula}}.} 27 | \item{digits}{number of digits for the output.} 28 | \item{verbose}{logical indicating if \code{nacFrail.time} output 29 | should generated while the random variates are generated (defaults 30 | to \code{FALSE}).} 31 | } 32 | \value{ 33 | A \eqn{k \times k}{k x k} matrix of user run time measurements in milliseconds 34 | (\code{1000*\link{system.time}(.)[1]}) where \eqn{k} is \code{length(taus)}. 35 | The first column contains the run times for generating the 36 | \eqn{V_0}{V0}s. For the submatrix that remains if the first column is 37 | removed, row \eqn{i} (for \eqn{{\theta_0}_i}{theta0[i]}) contains the run times 38 | for the \eqn{V_{01}}{V01}s for a particular \eqn{\theta_0}{theta0} and all the 39 | admissible \eqn{\theta_1}{theta1}s. 40 | } 41 | %\author{Marius Hofert and Martin Maechler} 42 | \seealso{ 43 | The class \code{\linkS4class{acopula}} and our predefined \code{"acopula"} 44 | family objects in \code{\link{acopula-families}}. For some timings on a 45 | standard notebook, see \code{\link{demo}(timings)} (or the file 46 | \file{timings.R} in the demo folder). 47 | } 48 | \examples{ 49 | ## takes about 7 seconds:% so we rather test a much smaller set in R CMD check 50 | \donttest{ 51 | nacFrail.time(10000, "Gumbel", taus= c(0.05,(1:9)/10, 0.95)) 52 | }%dont 53 | system.time( 54 | print( nacFrail.time(1000, "Gumbel", taus = c(0.5,1,6,9)/10) ) 55 | )% 0.84 sec 56 | } 57 | \keyword{utilities} 58 | -------------------------------------------------------------------------------- /man/nesdepth.Rd: -------------------------------------------------------------------------------- 1 | \name{nesdepth} 2 | \alias{nesdepth} 3 | \title{Nesting Depth of a Nested Archimedean Copula ("nacopula")} 4 | \description{ 5 | Compute the nesting depth of a nested Archimedean copula which is the 6 | length of the longest branch in the tree representation of the copula, 7 | and hence at least one. 8 | } 9 | \usage{ 10 | nesdepth(x) 11 | } 12 | \arguments{ 13 | \item{x}{object of class \code{"\linkS4class{nacopula}"}.} 14 | } 15 | \value{an integer, the nesting depth of the nested Archimedean copula. 16 | An (unnested) Archimedean copula has depth \code{1}. 17 | } 18 | %\author{Marius Hofert and Martin Maechler} 19 | \seealso{ 20 | \code{\link[=nacopula-class]{dim}} of nacopulas. 21 | } 22 | \examples{ 23 | F2 <- onacopula("F", C(1.9, 1, C(4.5, c(2,3)))) 24 | F2 25 | F3 <- onacopula("Clayton", C(1.5, 3:1, 26 | C(2.5, 4:5, 27 | C(15, 9:6)))) 28 | nesdepth(F2) # 2 29 | nesdepth(F3) # 3 30 | \dontshow{ 31 | stopifnot(identical(nesdepth(F2), 2L), 32 | identical(nesdepth(F3), 3L), 33 | identical(nesdepth(onacopula("Gumbel", C(1.5, 3:1))), 1L)) 34 | } 35 | } 36 | \keyword{utilities} 37 | -------------------------------------------------------------------------------- /man/pairs2.Rd: -------------------------------------------------------------------------------- 1 | \name{pairs2} 2 | \alias{pairs2} 3 | \title{Scatter-Plot Matrix ('pairs') for Copula Distributions with Nice Defaults} 4 | \description{ 5 | A version of \pkg{graphics}' package \code{\link{pairs}()}, 6 | particularly useful for visualizing dependence in multivariate 7 | (copula) data. 8 | } 9 | \usage{ 10 | pairs2(x, labels = NULL, labels.null.lab = "U", \dots) 11 | } 12 | \arguments{ 13 | \item{x}{a numeric \code{\link{matrix}} or an \R object for which 14 | \code{\link{as.matrix}(x)} returns such a matrix.} 15 | \item{labels}{the variable names, typically unspecified.} 16 | \item{labels.null.lab}{the \code{\link{character}} string 17 | determining the \dQuote{base name} of the variable labels in case 18 | \code{labels} is \code{NULL} and \code{x} does not have all column names given.} 19 | \item{\dots}{further arguments, passed to \code{\link{pairs}()}.} 20 | } 21 | \value{\code{\link{invisible}()} 22 | } 23 | %\author{Marius Hofert} 24 | \seealso{ 25 | \code{\link{splom2}()} for a similar function based on 26 | \code{\link[lattice]{splom}()}. 27 | } 28 | \examples{ 29 | ## Create a 100 x 7 matrix of random variates from a t distribution 30 | ## with four degrees of freedom and plot the generated data 31 | U <- matrix(rt(700, df = 4), ncol = 7) 32 | pairs2(U, pch = ".") 33 | } 34 | \keyword{hplot} 35 | -------------------------------------------------------------------------------- /man/plackettCopula-class.Rd: -------------------------------------------------------------------------------- 1 | \name{plackettCopula-class} 2 | \docType{class} 3 | \alias{plackettCopula-class} 4 | \title{Class "plackettCopula" of Plackett Copulas} 5 | \description{ 6 | The Plackett copula class. 7 | } 8 | \section{Objects from the Class}{ 9 | Objects can be created by \code{new("plackettCopula", ...)} but are 10 | typically produced by \code{\link{plackettCopula}(alpha)}. 11 | } 12 | \section{Slots}{ 13 | \describe{ 14 | \item{\code{dimension}:}{Numeric (scalar), the dimension of the copula.} 15 | \item{\code{exprdist}:}{a length two \code{\link{expression}} with 16 | expressions for the CDF and PDF of the copula.}% FIXME still used? 17 | \item{\code{parameters}:}{a number (numeric vector of length one) specifying the 18 | \emph{non negative} parameter.} 19 | \item{\code{param.names}:}{the \code{"\link{character}"} string \code{"alpha"}.} 20 | \item{\code{param.lowbnd}:}{the number \code{0}.} 21 | \item{\code{param.upbnd}:}{the number \code{Inf}.} 22 | \item{\code{fullname}:}{(deprecated; do not use!)} 23 | } 24 | } 25 | \section{Methods}{ 26 | Typical copula methods work, see \code{"\linkS4class{plackettCopula}"} 27 | and use \code{methods(class = "plackettCopula")}. 28 | } 29 | \section{Extends}{ 30 | Class \code{"plackettCopula"} extends class \code{"\linkS4class{copula}"} directly. 31 | } 32 | %\author{Ivan Kojadinovic and Jun Yan} 33 | \references{ 34 | Nelsen, R. B. (2006), \emph{An introduction to Copulas}, Springer, New York. 35 | } 36 | \seealso{ 37 | \code{\link{copula-class}}, \code{\link{plackettCopula}}. 38 | } 39 | \examples{ 40 | str(plackettCopula()) 41 | 42 | plackettCopula()@exprdist[["cdf"]] 43 | methods(class = "plackettCopula") 44 | contourplot2(plackettCopula(7), pCopula) 45 | wireframe2(plackettCopula(5), dCopula, main= "plackettCopula(5)") 46 | } 47 | \keyword{classes} 48 | -------------------------------------------------------------------------------- /man/plackettCopula.Rd: -------------------------------------------------------------------------------- 1 | \name{plackettCopula} 2 | \alias{plackettCopula} 3 | \title{Construction of a Plackett Copula} 4 | \description{ 5 | Constructs a Plackett copula (class \code{"plackettCopula}"}) with its 6 | corresponding parameter. 7 | } 8 | \usage{ 9 | plackettCopula(param) 10 | } 11 | \arguments{ 12 | \item{param}{a number (numeric vector of length one) specifying the 13 | \emph{non negative} parameter.} 14 | } 15 | \value{ 16 | A Plackett copula object of class \code{"\linkS4class{plackettCopula}"}. 17 | } 18 | %\author{Ivan Kojadinovic and Jun Yan} 19 | \references{ 20 | Plackett, R. L. (1965). A Class of Bivariate Distributions. 21 | \emph{Journal of the American Statistical Association} \bold{60}, 516--522. 22 | } 23 | \seealso{ 24 | The \code{"\linkS4class{plackettCopula}"} class; 25 | \code{\link{ellipCopula}}, \code{\link{archmCopula}}. 26 | } 27 | \examples{ 28 | plackett.cop <- plackettCopula(param=2) 29 | lambda(plackett.cop) # 0 0 : no tail dependencies 30 | ## For really large param values (here, 1e20 and Inf are equivalent): 31 | set.seed(1); Xe20 <- rCopula(5000, plackettCopula(1e20)) 32 | set.seed(1); Xinf <- rCopula(5000, plackettCopula(Inf)) 33 | stopifnot(all.equal(Xe20, Xinf)) 34 | } 35 | \keyword{distribution} 36 | \keyword{multivariate} 37 | -------------------------------------------------------------------------------- /man/plot-methods.Rd: -------------------------------------------------------------------------------- 1 | \name{plot-methods} 2 | \alias{plot-methods} 3 | \alias{plot,Copula,ANY-method} 4 | \alias{plot,mvdc,ANY-method} 5 | \docType{methods} 6 | \title{Methods for 'plot' in Package 'copula'} 7 | \description{ 8 | Methods for \code{\link{plot}()} to draw a scatter plot of a random 9 | sample from bivariate distributions from package \pkg{copula}. 10 | } 11 | \usage{% ../R/graphics.R 12 | \S4method{plot}{Copula,ANY}(x, n, xlim = 0:1, ylim = 0:1, 13 | xlab = quote(U[1]), ylab = quote(U[2]), main = NULL, \dots) 14 | \S4method{plot}{mvdc,ANY}(x, n, xlim = NULL, ylim = NULL, 15 | xlab = quote(X[1]), ylab = quote(X[2]), \dots) 16 | } 17 | \arguments{ 18 | \item{x}{a \emph{bivariate} \code{"\linkS4class{matrix}"}, 19 | \code{"\linkS4class{data.frame}"}, \code{"\linkS4class{Copula}"} or 20 | a \code{"\linkS4class{mvdc}"} object.} 21 | \item{n}{when \code{x} is not matrix-like: The sample size of the 22 | random sample drawn from \code{x}.} 23 | \item{xlim, ylim}{the x- and y-axis limits.} 24 | \item{xlab, ylab}{the x- and y-axis labels.} 25 | \item{main}{the main title; when true, shows the call's \code{x} 26 | \dQuote{expression}. By default, when \code{NULL} and the \code{x} 27 | expression matches \code{"[Cc]opula"} that expression is used as 28 | well. This smart default is somewhat experimental; feedback is welcome.} 29 | \item{\dots}{additional arguments passed to \code{\link{plot}} 30 | methods, i.e., typically \code{\link{plot.default}}.} 31 | } 32 | \value{invisible(). 33 | } 34 | %\author{Marius Hofert} 35 | \seealso{ 36 | \code{\link{splom2}()} for a scatter-plot \emph{matrix} based on 37 | \code{\link[lattice]{splom}()}. 38 | } 39 | \examples{ 40 | ## For 2-dim. 'copula' objects ------------------------- 41 | ## Plot uses n compula samples 42 | n <- 1000 # sample size 43 | set.seed(271) # (reproducibility) 44 | plot(tCopula(-0.8, df = 1.25), n = n) # automatic main title! 45 | 46 | nu <- 3 # degrees of freedom 47 | tau <- 0.5 # Kendall's tau 48 | th <- iTau(tCopula(df = nu), tau) # corresponding parameter 49 | cop <- tCopula(th, df = nu) # define 2-d copula object 50 | plot(cop, n = n) 51 | 52 | ## For 2-dim. 'mvdc' objects --------------------------- 53 | mvNN <- mvdc(cop, c("norm", "norm"), 54 | list(list(mean = 0, sd = 1), list(mean = 1))) 55 | plot(mvNN, n = n) 56 | } 57 | \keyword{hplot} 58 | -------------------------------------------------------------------------------- /man/pnacopula.Rd: -------------------------------------------------------------------------------- 1 | \name{pnacopula} 2 | \alias{pnacopula} 3 | \alias{pCopula,matrix,nacopula-method} 4 | \alias{pCopula,numeric,nacopula-method} 5 | \title{Evaluation of (Nested) Archimedean Copulas} 6 | \description{ 7 | For a (nested) Archimedean copula (object of class \code{\linkS4class{nacopula}}) 8 | \code{x}, \code{pCopula(u, x)} (or also currently still \code{pnacopula(x, u)}) 9 | evaluates the copula \code{x} at the given vector or matrix \code{u}. 10 | } 11 | \usage{ 12 | \S4method{pCopula}{matrix,nacopula}(u, copula, \dots) 13 | 14 | ## *Deprecated*: 15 | pnacopula(x, u) 16 | } 17 | \arguments{ 18 | \item{copula, x}{(nested) Archimedean copula of dimension \eqn{d}, that is, an 19 | object of class \code{\linkS4class{nacopula}}, typically from 20 | \code{\link{onacopula}(..)}.} 21 | \item{u}{a \code{\link{numeric}} vector of length \eqn{d} or matrix 22 | with \eqn{d} columns.} 23 | \item{\dots}{unused: potential optional arguments passed from and to methods.} 24 | } 25 | \note{ 26 | \code{\link{pCopula}(u, copula)} is a \emph{generic} function with 27 | methods for \emph{all} our copula classes, see \code{\link{pCopula}}. 28 | } 29 | \details{ 30 | The value of an Archimedean copula \eqn{C} with generator \eqn{\psi}{psi} at 31 | \eqn{u} is given by 32 | \deqn{C(\bm{u})=\psi(\psi^{-1}(u_1)+\dots+\psi^{-1}(u_d)),\ \bm{u}\in[0,1]^d. 33 | }{ C(u) = psi(psi^{-1}(u_1)+...+psi^{-1}(u_d)), u in [0,1]^d.} 34 | The value of a nested Archimedean copula is defined similarly. Note that a 35 | d-dimensional copula is called \emph{nested Archimedean} if it is an 36 | Archimedean copula with arguments possibly replaced by other nested 37 | Archimedean copulas. 38 | } 39 | \value{ 40 | A \code{\link{numeric}} in \eqn{[0,1]} which is the copula evaluated 41 | at \code{u}. (Currently not parallelized.) 42 | } 43 | %\author{Marius Hofert and Martin Maechler} 44 | \examples{ 45 | ## Construct a three-dimensional nested Joe copula with parameters 46 | ## chosen such that the Kendall's tau of the respective bivariate margins 47 | ## are 0.2 and 0.5. 48 | theta0 <- copJoe@iTau(.2) 49 | theta1 <- copJoe@iTau(.5) 50 | C3 <- onacopula("J", C(theta0, 1, C(theta1, c(2,3)))) 51 | 52 | ## Evaluate this copula at the vector u 53 | u <- c(.7,.8,.6) 54 | pCopula(u, C3) 55 | 56 | ## Evaluate this copula at the matrix v 57 | v <- matrix(runif(300), ncol=3) 58 | pCopula(v, C3) 59 | 60 | ## Back-compatibility check 61 | stopifnot(identical( pCopula (u, C3), suppressWarnings( 62 | pnacopula(C3, u))), 63 | identical( pCopula (v, C3), suppressWarnings( 64 | pnacopula(C3, v)))) 65 | } 66 | \keyword{multivariate} 67 | \keyword{distribution} 68 | -------------------------------------------------------------------------------- /man/polynEval.Rd: -------------------------------------------------------------------------------- 1 | \name{polynEval} 2 | \alias{polynEval} 3 | \title{Evaluate Polynomials} 4 | \description{ 5 | Evaluate a univariate polynomial at \code{x} (typically a vector), that is, 6 | compute, for a given vector of coefficients \code{coef}, the polynomial 7 | \code{coef[1] + coef[2]*x + ... + coef[p+1]*x^p}. 8 | } 9 | \usage{ 10 | polynEval(coef, x) 11 | } 12 | \arguments{ 13 | \item{coef}{numeric vector. If a vector, \code{x} can be an 14 | array and the result matches \code{x}.} 15 | \item{x}{numeric vector or array.} 16 | } 17 | \details{ 18 | The stable Horner rule is used for evaluation. 19 | 20 | Using the C code speeds up the already fast \R code available in 21 | \code{\link[sfsmisc]{polyn.eval}()} in package \CRANpkg{sfsmisc}. 22 | } 23 | \value{ 24 | numeric vector or array, with the same dimensions as \code{x}, 25 | containing the polynomial values \eqn{p(x)}. 26 | } 27 | %\author{Martin Maechler; the \R version has been in package \pkg{sfsmisc} for ages.} 28 | \seealso{For a much more sophisticated treatment of polynomials, use the 29 | \code{polynom} package (for example, evaluation can be done via 30 | \code{\link[polynom]{predict.polynomial}}). 31 | } 32 | \examples{ 33 | polynEval(c(1,-2,1), x = -2:7) # (x - 1)^2 34 | polynEval(c(0, 24, -50, 35, -10, 1), 35 | x = matrix(0:5, 2,3)) # 5 zeros! 36 | } 37 | \keyword{arith} 38 | -------------------------------------------------------------------------------- /man/printNacopula.Rd: -------------------------------------------------------------------------------- 1 | \name{printNacopula} 2 | \alias{printNacopula} 3 | \alias{show,nacopula-method} 4 | \title{Print Compact Overview of a Nested Archimedean Copula ("nacopula")} 5 | \description{ 6 | Print a compact overview of a nested Archimedean copula, that is, an 7 | object of class \code{"\linkS4class{nacopula}"}. 8 | Calling \code{printNacopula} explicitly allows to customize the 9 | printing behavior. Otherwise, the \code{\link{show}()} method calls 10 | \code{printNacopula} with default arguments only. 11 | } 12 | \usage{ 13 | printNacopula(x, labelKids=NA, deltaInd=, indent.str="", 14 | digits=getOption("digits"), 15 | width=getOption("width"), ...) 16 | } 17 | \arguments{ 18 | \item{x}{an \R object of class \code{\linkS4class{nacopula}}.} 19 | \item{labelKids}{logical specifying if child copulas should be labeled; 20 | If \code{NA} (as per default), on each level, children are labeled 21 | only if they are not only-child.} 22 | \item{deltaInd}{by how much should each child be indented \emph{more} 23 | than its parent? (non-negative integer). The default is three 24 | with \code{labelKids} being the default or \code{TRUE}, otherwise it is 25 | five (for \code{labelKids=FALSE}).} 26 | \item{indent.str}{a \code{\link{character}} string specifying the 27 | indentation, that is, the string that should be \emph{prepended} on the 28 | first line of output, and determine the amount of blanks for the 29 | remaining lines.} 30 | \item{digits, width}{number of significant digits, and desired print 31 | width; see \code{\link{print.default}}.} 32 | \item{\dots}{potentially further arguments, passed to methods.} 33 | } 34 | \value{ 35 | invisibly, \code{x}. 36 | } 37 | %\author{Martin Maechler} 38 | \examples{ 39 | C8 <- onacopula("F", C(1.9, 1, 40 | list(K1 = C(5.7, c(2,5)), 41 | abc= C(5.0, c(3,4,6), 42 | list(L2 = C(11.5, 7:8)))))) 43 | C8 # -> printNacopula(C8) 44 | printNacopula(C8, delta=10) 45 | printNacopula(C8, labelKids=TRUE) 46 | } 47 | \keyword{utilities} 48 | -------------------------------------------------------------------------------- /man/prob.Rd: -------------------------------------------------------------------------------- 1 | \name{prob} 2 | \alias{prob} 3 | \alias{prob-methods} 4 | \alias{prob,Copula-method} 5 | \title{Computing Probabilities of Hypercubes} 6 | \description{ 7 | Compute probabilities of a \eqn{d-}dimensional random vector \eqn{U} 8 | distributed according to a given copula \code{x} to 9 | fall in a hypercube \eqn{(l,u]}, where \eqn{l} and \eqn{u} denote the 10 | lower and upper corners of the hypercube, respectively. 11 | } 12 | \usage{ 13 | prob(x, l, u) 14 | } 15 | \arguments{ 16 | \item{x}{copula of dimension \eqn{d}, that is, an object 17 | inheriting from \code{\linkS4class{Copula}}.} 18 | \item{l, u}{\eqn{d}-dimensional, \code{\link{numeric}}, lower and 19 | upper hypercube boundaries, respectively, satisfying 20 | \eqn{0 \le l_i \le u_i \le 1}{0 <= l_i <= u_i <= 1}, 21 | for \eqn{i\in{1,\dots,d}}{i in {1,...,d}}.} 22 | } 23 | \value{A \code{\link{numeric}} in \eqn{[0,1]} which is the probability 24 | \eqn{P(l_i< U_i \le u_i)}{P(l[i] < U[i] <= u[i])}. 25 | } 26 | %\author{Marius Hofert and Martin Maechler} 27 | \seealso{ 28 | \code{\link{pCopula}(.)}. 29 | } 30 | \examples{ 31 | ## Construct a three-dimensional nested Joe copula with parameters 32 | ## chosen such that the Kendall's tau of the respective bivariate margins 33 | ## are 0.2 and 0.5. 34 | theta0 <- copJoe@iTau(.2) 35 | theta1 <- copJoe@iTau(.5) 36 | C3 <- onacopula("J", C(theta0, 1, C(theta1, c(2,3)))) 37 | 38 | ## Compute the probability of a random vector distributed according to 39 | ## this copula to fall inside the cube with lower point l and upper 40 | ## point u. 41 | l <- c(.7,.8,.6) 42 | u <- c(1,1,1) 43 | prob(C3, l, u) 44 | 45 | ## ditto for a bivariate normal copula with rho = 0.8 : 46 | prob(normalCopula(0.8), c(.2,.4), c(.3,.6)) 47 | } 48 | \keyword{distribution} 49 | \keyword{methods} 50 | 51 | -------------------------------------------------------------------------------- /man/rFFrankJoe.Rd: -------------------------------------------------------------------------------- 1 | \name{rFFrankJoe} 2 | \alias{rFFrank} 3 | \alias{rFJoe} 4 | \title{Sampling Distribution F for Frank and Joe} 5 | \description{ 6 | Generate a vector of variates \eqn{V \sim F}{V ~ F} from the distribution 7 | function \eqn{F} with Laplace-Stieltjes transform 8 | \deqn{(1-(1-\exp(-t)(1-e^{-\theta_1}))^\alpha)/(1-e^{-\theta_0}), 9 | }{(1-(1-exp(-t)*(1-e^(-theta1)))^alpha)/(1-e^(-theta0)),} 10 | for Frank, or 11 | \deqn{1-(1-\exp(-t))^\alpha,}{1-(1-exp(-t))^alpha} for Joe, respectively, 12 | where \eqn{\theta_0}{theta0} and \eqn{\theta_1}{theta1} denote two parameters 13 | of Frank (that is, \eqn{\theta_0,\theta_1\in(0,\infty)}{theta0,theta1 14 | in (0,Inf)}) and Joe (that is, \eqn{\theta_0,\theta_1\in[1,\infty)}{% 15 | theta0,theta1 in [1,Inf)}) satisfying 16 | \eqn{\theta_0\le\theta_1}{theta0 <= theta1} 17 | and \eqn{\alpha=\theta_0/\theta_1}{alpha=theta0/theta1}. 18 | } 19 | \usage{ 20 | rFFrank(n, theta0, theta1, rej) 21 | rFJoe(n, alpha) 22 | } 23 | \arguments{ 24 | \item{n}{number of variates from \eqn{F}.} 25 | \item{theta0}{parameter \eqn{\theta_0}{theta0}.} 26 | \item{theta1}{parameter \eqn{\theta_1}{theta1}.} 27 | \item{rej}{method switch for \code{rFFrank}: if \code{theta0} > 28 | \code{rej} a rejection from Joe's family (Sibuya distribution) is 29 | applied (otherwise, a logarithmic envelope is used).} 30 | \item{alpha}{parameter \eqn{\alpha= 31 | \theta_0/\theta_1}{alpha = theta0/theta1} in \eqn{(0,1]} for 32 | \code{rFJoe}.} 33 | } 34 | \value{ 35 | numeric vector of random variates \eqn{V} of length \code{n}. 36 | } 37 | \details{ 38 | \code{rFFrank(n, theta0, theta1, rej)} calls 39 | \code{\link{rF01Frank}(rep(1,n), theta0, theta1, rej, 1)} and 40 | \code{rFJoe(n, alpha)} calls \code{\link{rSibuya}(n, alpha)}. 41 | } 42 | %\author{Marius Hofert} 43 | \seealso{ 44 | \code{\link{rF01Frank}}, \code{\link{rF01Joe}}, also for references. 45 | \code{\link{rSibuya}}, and \code{\link{rnacopula}}. 46 | } 47 | \examples{ 48 | ## Simple definition of the functions: 49 | rFFrank 50 | rFJoe 51 | } 52 | \keyword{distribution} 53 | -------------------------------------------------------------------------------- /man/radSymTest.Rd: -------------------------------------------------------------------------------- 1 | \name{radSymTest} 2 | \alias{radSymTest} 3 | \title{Test of Exchangeability for a Bivariate Copula} 4 | \description{ 5 | 6 | Test for assessing the radial symmetry of the underlying multivariate 7 | copula based on the empirical copula. The test statistic is a 8 | multivariate extension of the definition adopted in the first 9 | reference. An approximate p-value for the test statistic is obtained 10 | by means of a appropriate \emph{bootstrap} which can take the presence 11 | of ties in the component series of the data into accont; see the 12 | second reference. 13 | 14 | } 15 | \usage{ 16 | radSymTest(x, N = 1000, ties = NA) 17 | } 18 | \arguments{ 19 | \item{x}{ a data matrix that will be transformed to pseudo-observations.} 20 | \item{N}{ number of boostrap iterations to be used to 21 | simulate realizations of the test statistic under the null 22 | hypothesis.} 23 | \item{ties}{ logical; if \code{TRUE}, the boostrap procedure is 24 | adapted to the presence of ties in any of the coordinate samples 25 | of \code{x}; the default value of \code{NA} indicates that the 26 | presence/absence of ties will be checked for automatically.} 27 | } 28 | \details{ 29 | More details are available in the second reference. 30 | } 31 | \value{ 32 | An object of \code{\link{class}} \code{htest} which is a list, 33 | some of the components of which are 34 | \item{statistic}{ value of the test statistic. } 35 | \item{p.value}{ corresponding approximate p-value. } 36 | } 37 | %\author{Ivan Kojadinovic and Jun Yan} 38 | \references{ 39 | 40 | Genest, C. and G. \enc{Nešlehová}{Neslehova}, J. (2014). On tests of 41 | radial symmetry for bivariate copulas. \emph{Statistical Papers} 42 | \bold{55}, 1107--1119. 43 | 44 | Kojadinovic, I. (2017). Some copula inference procedures adapted to 45 | the presence of ties. \emph{Computational Statistics and Data 46 | Analysis} \bold{112}, 24--41, \url{https://arxiv.org/abs/1609.05519}. 47 | } 48 | \seealso{ \code{\link{exchTest}}, \code{\link{exchEVTest}}, \code{\link{gofCopula}}. } 49 | \examples{ 50 | ## Data from radially symmetric copulas 51 | radSymTest(rCopula(200, frankCopula(3))) 52 | \donttest{radSymTest(rCopula(200, normalCopula(0.7, dim = 3)))} 53 | 54 | ## Data from non radially symmetric copulas 55 | radSymTest(rCopula(200, claytonCopula(3))) 56 | \donttest{radSymTest(rCopula(200, gumbelCopula(2, dim=3)))} 57 | } 58 | \keyword{htest} 59 | \keyword{multivariate} 60 | -------------------------------------------------------------------------------- /man/rdj.Rd: -------------------------------------------------------------------------------- 1 | \name{rdj} 2 | \title{Daily Returns of Three Stocks in the Dow Jones} 3 | \alias{rdj} 4 | \docType{data} 5 | \description{ 6 | Five years of daily log-returns (from 1996 to 2000) of Intel 7 | (INTC), Microsoft (MSFT) and General Electric (GE) stocks. These 8 | data were analysed in Chapter 5 of McNeil, Frey and 9 | Embrechts (2005). 10 | } 11 | \usage{data(rdj, package="copula")} 12 | \format{ 13 | A data frame of 1262 daily log-returns from 1996 to 2000. 14 | \describe{ 15 | \item{\code{Date}}{the date, of class \code{"\link{Date}"}.} 16 | \item{\code{INTC}}{daily log-return of the Intel stock} 17 | \item{\code{MSFT}}{daily log-return of the Microsoft stock} 18 | \item{\code{GE}}{daily log-return of the General Electric} 19 | } 20 | } 21 | %\author{Marius Hofert, Ivan Kojadinovic, Martin Maechler and Jun Yan} 22 | \references{ 23 | McNeil, A. J., Frey, R., and Embrechts, P. (2005). 24 | \emph{Quantitative Risk Management: Concepts, Techniques, Tools}. 25 | Princeton University Press. 26 | } 27 | \examples{ 28 | data(rdj) 29 | str(rdj)# 'Date' is of class "Date" 30 | 31 | with(rdj, { 32 | matplot(Date, rdj[,-1], type = "o", xaxt = "n", ylim = .15* c(-1,1), 33 | main = paste("rdj - data; n =", nrow(rdj))) 34 | Axis(Date, side=1) 35 | }) 36 | legend("top", paste(1:3, names(rdj[,-1])), col=1:3, lty=1:3, bty="n") 37 | 38 | \donttest{% save 0.75 sec for fitting and many more for gof 39 | x <- rdj[, -1] # '-1' : not the Date 40 | ## a t-copula (with a vague inital guess of Rho entries) 41 | tCop <- tCopula(rep(.2, 3), dim=3, dispstr="un", df=10, df.fixed=TRUE) 42 | ft <- fitCopula(tCop, data = pobs(x)) 43 | ft 44 | ft@copula # the fitted t-copula as tCopula object 45 | system.time( 46 | g.C <- gofCopula(claytonCopula(dim=3), as.matrix(x), simulation = "mult") 47 | ) ## 5.3 sec 48 | system.time( 49 | g.t <- gofCopula(ft@copula, as.matrix(x), simulation = "mult") 50 | ) ## 8.1 sec 51 | 52 | }% dont... 53 | } 54 | \keyword{datasets} 55 | -------------------------------------------------------------------------------- /man/rlog.Rd: -------------------------------------------------------------------------------- 1 | \name{rlog} 2 | \alias{rlog} 3 | \alias{rlogR} 4 | \title{Sampling Logarithmic Distributions} 5 | \description{ 6 | Generating random variates from a Log(p) distribution with probability 7 | mass function 8 | \deqn{p_k=\frac{p^k}{-\log(1-p)k},\ k\in\mathbf{N}, 9 | }{p_k = p^k/(-log(1-p)k), k in IN,} 10 | where \eqn{p\in(0,1)}{p in (0,1)}. The implemented algorithm is the 11 | one named \dQuote{LK} in Kemp (1981). 12 | } 13 | \usage{ 14 | rlog(n, p, Ip = 1 - p) 15 | } 16 | \arguments{ 17 | \item{n}{sample size, that is, length of the resulting vector of random 18 | variates.} 19 | \item{p}{parameter in \eqn{(0,1)}.} 20 | \item{Ip}{\eqn{= 1 - p}, possibly more accurate, e.g, when 21 | \eqn{p\approx 1}{p ~= 1}.} 22 | } 23 | \value{ 24 | A vector of positive \code{\link{integer}}s of length \code{n} containing the 25 | generated random variates. 26 | } 27 | \details{ 28 | For documentation and didactical purposes, \code{rlogR} is a pure-\R 29 | implementation of \code{rlog}. However, \code{rlogR} is not as fast as 30 | \code{rlog} (the latter being implemented in C). 31 | } 32 | %\author{Marius Hofert and Martin Maechler} 33 | \references{ 34 | Kemp, A. W. (1981), 35 | Efficient Generation of Logarithmically Distributed Pseudo-Random Variables, 36 | \emph{Journal of the Royal Statistical Society: Series C (Applied 37 | Statistics)} \bold{30}, 3, 249--253. 38 | } 39 | \note{ 40 | In the \pkg{copula} package, the Log(p) distribution is needed only 41 | for generating Frank copula observations, namely in 42 | \code{\link{copFrank}@V0()}, where \eqn{p = 1 - exp(-\theta)}, i.e., 43 | \code{p = -expm1(-theta)} and \code{Ip = exp(-theta)}. 44 | 45 | For large \eqn{\theta} it would be desirable to pass \code{-theta} 46 | to \code{rlog()} instead of \code{p}. This has not yet been implemented. 47 | } 48 | \examples{ 49 | ## Sample n random variates from a Log(p) distribution and plot a 50 | ## "histogram" 51 | n <- 1000 52 | p <- .5 53 | X <- rlog(n, p) 54 | table(X) ## distribution on the integers {1, 2, ..} 55 | ## ==> The following plot is more reasonable than a hist(X, prob=TRUE) : 56 | plot(table(X)/n, type="h", lwd=10, col="gray70") 57 | 58 | ## case closer to numerical boundary: 59 | lV <- log10(V <- rlog(10000, Ip = 2e-9))# Ip = exp(-theta) <==> theta ~= 20 60 | hV <- hist(lV, plot=FALSE) 61 | dV <- density(lV) 62 | ## Plot density and histogram on log scale with nice axis labeling & ticks: 63 | plot(dV, xaxt="n", ylim = c(0, max(hV$density, dV$y)), 64 | main = "Density of [log-transformed] Log(p), p=0.999999..") 65 | abline(h=0, lty=3); rug(lV); lines(hV, freq=FALSE, col = "light blue"); lines(dV) 66 | rx <- range(pretty(par("usr")[1:2])) 67 | sx <- outer(1:9, 10^(max(0,rx[1]):rx[2])) 68 | axis(1, at=log10(sx), labels= FALSE, tcl = -0.3) 69 | axis(1, at=log10(sx[1,]), labels= formatC(sx[1,]), tcl = -0.75) 70 | } 71 | \keyword{distribution} 72 | -------------------------------------------------------------------------------- /man/rnacModel.Rd: -------------------------------------------------------------------------------- 1 | \name{rnacModel} 2 | \alias{rnacModel} 3 | \title{Random nacopula Model} 4 | \description{ 5 | Randomly construct a nested Archimedean copula model, 6 | %% FIXME 7 | } 8 | \usage{ 9 | rnacModel(family, d, pr.comp, rtau0 = function() rbeta(1, 2,4), 10 | order=c("random", "each", "seq"), digits.theta = 2) 11 | } 12 | \arguments{ 13 | \item{family}{the Archimedean family} 14 | \item{d}{integer >=2; the dimension} 15 | \item{pr.comp}{probability of a direct component on each level} 16 | \item{rtau0}{a \code{\link{function}} to generate a (random) tau, 17 | corresponding to theta0, the outermost theta.} 18 | \item{order}{string indicating how the component IDs are selected.} 19 | \item{digits.theta}{integer specifying the number of digits to round 20 | the theta values.} 21 | } 22 | % \details{ 23 | % } 24 | \value{ 25 | an object of \code{\linkS4class{outer_nacopula}}. 26 | } 27 | %\author{Martin Maechler, 10 Feb 2012} 28 | \seealso{ 29 | \code{\link{rnacopula}} for generating \eqn{d}-dimensional 30 | observations from an (outer) \code{\linkS4class{nacopula}}, e.g., from 31 | the \emph{result} of \code{rnacModel()}. 32 | } 33 | \examples{ 34 | ## Implicitly tests the function {with validity of outer_nacopula ..} 35 | set.seed(11) 36 | for(i in 1:40) { 37 | m1 <- rnacModel("Gumbel", d=sample(20:25, 1), pr.comp = 0.3, 38 | rtau0 = function() 0.25) 39 | m2 <- rnacModel("Joe", d=3, pr.comp = 0.1, order="each") 40 | mC <- rnacModel("Clayton", d=20, pr.comp = 0.3, 41 | rtau0 = function() runif(1, 0.1, 0.5)) 42 | mF <- rnacModel("Frank", d=sample(20:25, 1), pr.comp = 0.3, order="seq") 43 | } 44 | }% Ex. 45 | \keyword{distribution} 46 | \keyword{multivariate} 47 | 48 | -------------------------------------------------------------------------------- /man/show-methods.Rd: -------------------------------------------------------------------------------- 1 | \name{show-methods} 2 | \title{Methods for 'show()' in Package 'copula'} 3 | \docType{methods} 4 | \alias{show-methods} 5 | \alias{show,normalCopula-method} 6 | \alias{show,tCopula-method} 7 | \alias{show,parCopula-method} 8 | \alias{show,fitCopula-method} 9 | \alias{show,fitMvdc-method} 10 | \description{ 11 | Methods for function \code{\link{show}} in package \pkg{copula}. 12 | } 13 | \section{Methods}{ 14 | \describe{ 15 | \item{object = "parCopula"}{see \code{\link{Copula}}. } 16 | 17 | \item{object = "fitMvdc"}{(see \code{\link{fitMvdc}}): and} 18 | \item{object = "fitCopula"}{(see \code{\link{fitCopula}}): these call the 19 | (hidden) \code{\link{print}} method, with its default argument. 20 | Using \code{\link{print}()} instead, allows to set \code{digits}, e.g.} 21 | \item{object = "fitMvdc"}{see \code{\link{fitCopula}}. } 22 | }} 23 | %\author{Marius Hofert, Ivan Kojadinovic, Martin Maechler and Jun Yan} 24 | %\examples{ 25 | %} 26 | \keyword{methods} 27 | \keyword{print} 28 | -------------------------------------------------------------------------------- /man/uranium.Rd: -------------------------------------------------------------------------------- 1 | \name{uranium} 2 | \Rdversion{1.1} 3 | \alias{uranium} 4 | \docType{data} 5 | \title{Uranium Exploration Dataset of Cook & Johnson (1986)} 6 | \description{ 7 | These data consist of log concentrations of 7 chemical elements in 655 8 | water samples collected near Grand Junction, CO (from the Montrose 9 | quad-rangle of Western Colorado). Concentrations were 10 | measured for the following elements: Uranium (U), Lithium (Li), Cobalt 11 | (Co), Potassium (K), Cesium (Cs), Scandium (Sc), And Titanium (Ti). 12 | } 13 | \usage{data(uranium, package="copula")} 14 | \format{ 15 | A data frame with 655 observations of the following 7 variables: 16 | \describe{ 17 | \item{\code{U}}{(numeric) log concentration of Uranium.} 18 | \item{\code{Li}}{(numeric) log concentration of Lithium.} 19 | \item{\code{Co}}{(numeric) log concentration of Colbalt.} 20 | \item{\code{K}}{(numeric) log concentration of Potassium.} 21 | \item{\code{Cs}}{(numeric) log concentration of Cesium.} 22 | \item{\code{Sc}}{(numeric) log concentration of Scandum.} 23 | \item{\code{Ti}}{(numeric) log concentration of Titanium.} 24 | } 25 | } 26 | %\author{Ivan Kojadinovic and Jun Yan} 27 | \references{ 28 | Cook, R. D. and Johnson, M. E. (1986) 29 | Generalized BurrParetologistic distributions with applications to a 30 | uranium exploration data set. 31 | \emph{Technometrics} \bold{28}, 123--131. 32 | } 33 | \examples{ 34 | data(uranium) 35 | } 36 | \keyword{datasets} 37 | -------------------------------------------------------------------------------- /src/An.h: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright (C) 2012 Marius Hofert, Ivan Kojadinovic, Martin Maechler, and Jun Yan 3 | 4 | This program is free software; you can redistribute it and/or modify it under 5 | the terms of the GNU General Public License as published by the Free Software 6 | Foundation; either version 3 of the License, or (at your option) any later 7 | version. 8 | 9 | This program is distributed in the hope that it will be useful, but WITHOUT 10 | ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 11 | FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 12 | details. 13 | 14 | You should have received a copy of the GNU General Public License along with 15 | this program; if not, see . 16 | */ 17 | 18 | 19 | /** 20 | * @file An.h 21 | * @author Ivan Kojadinovic 22 | * @date 2009-2012 23 | * 24 | * @brief Rank-based versions of the Pickands and CFG estimators 25 | * of the Pickands dependence function. Bivariate and 26 | * multivariate versions. 27 | * 28 | */ 29 | 30 | 31 | #ifndef ANFUN_H 32 | #define ANFUN_H 33 | 34 | #define MIN(x,y) ((x)<(y)?(x):(y)) 35 | #define MAX(x,y) ((x)>(y)?(x):(y)) 36 | 37 | double biv_invAP(int n, double *S, double *T, double t); 38 | double biv_logACFG(int n, double *S, double *T, double t); 39 | 40 | // called from R: 41 | void biv_AP(int *n, double *S, double *T, double *t, int *m, 42 | int *corrected, double *A); 43 | 44 | void biv_ACFG(int *n, double *S, double *T, double *t, int *m, 45 | int *corrected, double *A); 46 | 47 | void mult_A(double *U, int *n, int *d, double *w, int *m, 48 | double *AP, double *ACFG, double *AHT); 49 | 50 | #endif 51 | -------------------------------------------------------------------------------- /src/Makevars: -------------------------------------------------------------------------------- 1 | PKG_CPPFLAGS = -I./gsl -I./gsl/specfunc 2 | 3 | -------------------------------------------------------------------------------- /src/copula_int.h: -------------------------------------------------------------------------------- 1 | /** 2 | * @file copula_int.h 3 | * @author Martin Maechler 4 | * @date March 2014 5 | * 6 | * @brief R support for internationalized messages 7 | * which might be translated { -> gettext() } 8 | */ 9 | 10 | #define STRICT_R_HEADERS 11 | 12 | #ifdef ENABLE_NLS 13 | #include 14 | #define _(String) dgettext ("copula", String) 15 | #else 16 | #define _(String) (String) 17 | #define dngettext(pkg, String, StringP, N) (N > 1 ? StringP : String) 18 | #endif 19 | -------------------------------------------------------------------------------- /src/empcop.h: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright (C) 2012 Marius Hofert, Ivan Kojadinovic, Martin Maechler, and Jun Yan 3 | 4 | This program is free software; you can redistribute it and/or modify it under 5 | the terms of the GNU General Public License as published by the Free Software 6 | Foundation; either version 3 of the License, or (at your option) any later 7 | version. 8 | 9 | This program is distributed in the hope that it will be useful, but WITHOUT 10 | ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 11 | FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 12 | details. 13 | 14 | You should have received a copy of the GNU General Public License along with 15 | this program; if not, see . 16 | */ 17 | 18 | 19 | #ifndef EMPCOP_H 20 | #define EMPCOP_H 21 | 22 | /// Bivariate versions; used by exchTest and evTestA 23 | double bivCn(const double U[], const double V[], int n, double u, double v); 24 | double der1bivCn(const double U[], const double V[], int n, double u, double v); 25 | double der2bivCn(const double U[], const double V[], int n, double u, double v); 26 | 27 | /// Multivariate versions; used by evTestC and by the multiplier gof tests 28 | double multCn(const double U[], int n, int p, const double V[], int m, int k, double o); 29 | double der_multCn(const double U[], int n, int p, const double u[], const double v[], double denom); 30 | 31 | // called via .C(..); empirical, beta and checkerboard versions 32 | void Cn_C(double *U, int *n, int *p, double *V, int *m, double *ec, double *offset, 33 | int *type); 34 | 35 | #endif 36 | -------------------------------------------------------------------------------- /src/gof.h: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright (C) 2012 Marius Hofert, Ivan Kojadinovic, Martin Maechler, and Jun Yan 3 | 4 | This program is free software; you can redistribute it and/or modify it under 5 | the terms of the GNU General Public License as published by the Free Software 6 | Foundation; either version 3 of the License, or (at your option) any later 7 | version. 8 | 9 | This program is distributed in the hope that it will be useful, but WITHOUT 10 | ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 11 | FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 12 | details. 13 | 14 | You should have received a copy of the GNU General Public License along with 15 | this program; if not, see . 16 | */ 17 | 18 | 19 | #ifndef COPULA_GOF_H 20 | #define COPULA_GOF_H 21 | 22 | #include 23 | 24 | void cramer_vonMises(int *n, int *p, double *U, double *Ctheta, 25 | double *stat); 26 | void cramer_vonMises_grid(int *p, double *U, int *n, double *V, int *m, 27 | double *Ctheta, double *stat); 28 | 29 | void multiplier(int *p, double *u0, int *m, double *u, int *n, double *b, 30 | double *influ, double *denom, int *N, double *s0, int *verbose); 31 | 32 | void cramer_vonMises_Pickands(int n, int m, double *S, 33 | double *T, double *Atheta, 34 | double *stat); 35 | 36 | void cramer_vonMises_CFG(int n, int m, double *S, 37 | double *T, double *Atheta, 38 | double *stat); 39 | 40 | void cramer_vonMises_Afun(int *n, int *m, double *S, 41 | double *T, double *Atheta, 42 | double *stat, int *CFG); 43 | 44 | #endif 45 | -------------------------------------------------------------------------------- /src/nacopula.h: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright (C) 2012 Marius Hofert, Ivan Kojadinovic, Martin Maechler, and Jun Yan 3 | 4 | This program is free software; you can redistribute it and/or modify it under 5 | the terms of the GNU General Public License as published by the Free Software 6 | Foundation; either version 3 of the License, or (at your option) any later 7 | version. 8 | 9 | This program is distributed in the hope that it will be useful, but WITHOUT 10 | ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 11 | FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 12 | details. 13 | 14 | You should have received a copy of the GNU General Public License along with 15 | this program; if not, see . 16 | */ 17 | 18 | 19 | #ifndef NACOPULA_DEFS_H 20 | #define NACOPULA_DEFS_H 21 | 22 | #define STRICT_R_HEADERS 23 | #include 24 | #include 25 | #include "copula_int.h" 26 | 27 | SEXP sinc_c(SEXP x_); 28 | SEXP A__c(SEXP x_, SEXP alpha, SEXP I_alpha); 29 | 30 | SEXP rstable_c(SEXP n, SEXP alpha); 31 | SEXP retstable_c(SEXP V0_, SEXP h, SEXP alpha, SEXP method); 32 | 33 | SEXP rLog_vec_c(SEXP n_, SEXP p_, SEXP Ip_); 34 | SEXP rSibuya_vec_c(SEXP n_, SEXP alpha_); 35 | SEXP rF01Frank_vec_c(SEXP V0_, SEXP theta_0_, SEXP theta_1_, SEXP rej_, SEXP approx_); 36 | SEXP rF01Joe_vec_c(SEXP V0_, SEXP alpha_, SEXP approx_); 37 | 38 | SEXP gofT2stat_c(SEXP u1_, SEXP u2_); 39 | 40 | /** 41 | * C API---for "us" but maybe also other R packages 42 | * "export" it via ../inst/include/ 43 | */ 44 | SEXP polyn_eval(SEXP coef, SEXP x); 45 | 46 | double sinc_MM(double x); 47 | double A_(double x, double alpha); 48 | double BdB0(double x, double alpha); 49 | 50 | // retstable.c : 51 | double rstable0(double alpha); 52 | double rstable (double alpha); 53 | void rstable_vec(double S[], const R_xlen_t n, const double alpha); 54 | void retstable_MH(double *St, const double V0[], double h, double alpha, R_xlen_t n); 55 | void retstable_LD(double *St, const double V0[], double h, double alpha, R_xlen_t n); 56 | 57 | double rLog(double p, double Ip); 58 | double rSibuya(double alpha, double gamma_1_a /**< == Gamma(1 - alpha) */); 59 | double rSibuya_sum(R_xlen_t n, double alpha, double gamma_1_a /**< == Gamma(1 - alpha) */); 60 | void rSibuya_vec(double* V, R_xlen_t n, double alpha); 61 | double rF01Frank(double V0, double theta0, double theta1, double p0, double p1, 62 | double gamma_1_a, double rej, int approx); 63 | void rF01Frank_vec(double *V01, const double *V0, R_xlen_t n, double theta_0, 64 | double theta_1, double rej, int approx); 65 | double rF01Joe(double V0, double alpha, double gamma_1_a /**< == Gamma(1 - alpha) */, 66 | int approx); 67 | void rF01Joe_vec(double* V01, const double *V0, R_xlen_t n, double alpha, double approx); 68 | 69 | #endif 70 | -------------------------------------------------------------------------------- /src/polyn_eval.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright (C) 2012 Marius Hofert, Ivan Kojadinovic, Martin Maechler, and Jun Yan 3 | 4 | This program is free software; you can redistribute it and/or modify it under 5 | the terms of the GNU General Public License as published by the Free Software 6 | Foundation; either version 3 of the License, or (at your option) any later 7 | version. 8 | 9 | This program is distributed in the hope that it will be useful, but WITHOUT 10 | ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 11 | FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 12 | details. 13 | 14 | You should have received a copy of the GNU General Public License along with 15 | this program; if not, see . 16 | */ 17 | 18 | 19 | #include "nacopula.h" 20 | 21 | /** 22 | * Polynomial evaluation via Horner scheme 23 | * 24 | * @param coef coefficients 25 | * @param x evaluation point(s) 26 | * @return values 27 | * @author Marius Hofert 28 | */ 29 | SEXP polyn_eval(SEXP coef, SEXP x) 30 | { 31 | SEXP result; 32 | R_xlen_t n = XLENGTH(x); 33 | int m = LENGTH(coef); 34 | // deal with integer or numeric -- NULL cannot (yet?) be coerced 35 | if(isNull(x)) { result = allocVector(REALSXP, 0); return result; } 36 | if(!isNull(coef)) 37 | coef = isReal(coef) ? Rf_duplicate(coef) : coerceVector(coef, REALSXP); 38 | PROTECT(coef); 39 | PROTECT(x = isReal(x) ? Rf_duplicate(x) : coerceVector(x, REALSXP)); 40 | PROTECT(result = Rf_duplicate(x)); 41 | double *cf = REAL(coef), *xx = REAL(x), *res = REAL(result); 42 | for(R_xlen_t i = 0; i < n; i++) { 43 | double r, xi = xx[i]; 44 | if(m == 0) { 45 | r = 0.; 46 | } else { 47 | int j = m-1; 48 | r = cf[j]; 49 | for (j--; j >= 0; j--) 50 | r = cf[j] + r * xi; 51 | } 52 | res[i] = r; 53 | } 54 | UNPROTECT(3); 55 | return result; 56 | } 57 | -------------------------------------------------------------------------------- /src/set_utils.h: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright (C) 2012 Marius Hofert, Ivan Kojadinovic, Martin Maechler, and Jun Yan 3 | 4 | This program is free software; you can redistribute it and/or modify it under 5 | the terms of the GNU General Public License as published by the Free Software 6 | Foundation; either version 3 of the License, or (at your option) any later 7 | version. 8 | 9 | This program is distributed in the hope that it will be useful, but WITHOUT 10 | ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 11 | FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 12 | details. 13 | 14 | You should have received a copy of the GNU General Public License along with 15 | this program; if not, see . 16 | */ 17 | 18 | #ifndef SET_UTILS_H 19 | #define SET_UTILS_H 20 | 21 | /** 22 | * @file set_utils.h 23 | * @author Michel Grabisch and Ivan Kojadinovic 24 | * @date May 2007 25 | * 26 | * @brief Set function utilities adapted from the R package kappalab 27 | * 28 | * 29 | */ 30 | 31 | int card(int n); 32 | double sum_binom(int n, int k); 33 | void k_power_set(int *n, int *k, int *power_set); 34 | void k_power_set_char(int *n, int *k, int *k_power_set, char **subset); 35 | void natural2binary(int *n, double *sf, int *power_set, double *sf_out); 36 | 37 | #endif 38 | -------------------------------------------------------------------------------- /tests/dC-dc-ex.R: -------------------------------------------------------------------------------- 1 | ## Copyright (C) 2012 Marius Hofert, Ivan Kojadinovic, Martin Maechler, and Jun Yan 2 | ## 3 | ## This program is free software; you can redistribute it and/or modify it under 4 | ## the terms of the GNU General Public License as published by the Free Software 5 | ## Foundation; either version 3 of the License, or (at your option) any later 6 | ## version. 7 | ## 8 | ## This program is distributed in the hope that it will be useful, but WITHOUT 9 | ## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 10 | ## FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | ## details. 12 | ## 13 | ## You should have received a copy of the GNU General Public License along with 14 | ## this program; if not, see . 15 | 16 | require(copula) 17 | source(system.file("Rsource", "utils.R", package="copula", mustWork=TRUE)) 18 | ##-> assertError(), assert.EQ(), ... showProc.time() + comparederiv() 19 | showProc.time() 20 | 21 | (doExtras <- copula:::doExtras()) 22 | 23 | m <- 10 # number of random points 24 | tau <- 0.5 25 | set.seed(47) 26 | 27 | ## bivariate comparisons 28 | d <- 2 29 | u <- pobs(matrix(runif(d * m), m, d)) 30 | 31 | ## (Warnings suppressed now via default may.warn=FALSE) 32 | cDer <- rbind( 33 | clayton = comparederiv(claytonCopula (iTau(claytonCopula(), tau)), u), 34 | gumbel = comparederiv(gumbelCopula (iTau(gumbelCopula(), tau)), u), 35 | frank = comparederiv(frankCopula (iTau(frankCopula(), tau)), u), 36 | plackett= comparederiv(plackettCopula(iTau(plackettCopula(),tau)), u), 37 | normal = comparederiv(normalCopula (iTau(normalCopula(), tau)), u), 38 | tC.fixed= comparederiv(tCopula (iTau(tCopula(), tau), df.fixed = TRUE), u)) 39 | cDer 40 | stopifnot(cDer[,"dCdu" ] <= 0.004, # max: normal = 0.002166 41 | #cDer[,"dCdtheta" ] <= 11e-14,# max: tC.fixed = 5.537e-14 42 | cDer[,"dCdtheta" ] <= 1e-8, # max: normal = 4.86e-9 43 | cDer[,"dlogcdu" ] <= 15e-8, # max: normal = 7.51e-8 44 | cDer[,"dlogcdtheta"]<= 6e-9) # max: normal = 2.92e-9 45 | showProc.time() 46 | 47 | 48 | if (doExtras) 49 | { 50 | ## d-dimensional 51 | d <- 4 ; set.seed(44) 52 | u <- pobs(matrix(runif(d * m), m, d)) 53 | 54 | nC4 <- normalCopula(rep(iTau(normalCopula(), tau), d * (d-1)/2), dim=d, dispstr = "un") 55 | tC4 <- tCopula (rep(iTau(tCopula(), tau), d * (d-1)/2), dim=d, dispstr = "un", 56 | df.fixed = TRUE) 57 | cD <- rbind(comparederiv(nC4, u), 58 | comparederiv(tC4, u)) 59 | print(cD, digits = 5) 60 | stopifnot(apply(cD, 2, max) < c(0.42, 0.18, 2.1e-07, 1.6e-08)) 61 | showProc.time() 62 | } 63 | 64 | -------------------------------------------------------------------------------- /tests/ggraph-tst.R: -------------------------------------------------------------------------------- 1 | require(copula) 2 | doX <- FALSE # no "doExtras" -- be fast 3 | 4 | if(!dev.interactive(orNone=TRUE)) pdf("ggraph-tst.pdf") 5 | 6 | demo(gof_graph) 7 | 8 | dev.off() 9 | -------------------------------------------------------------------------------- /tests/retstable-ex.R: -------------------------------------------------------------------------------- 1 | ## Copyright (C) 2012 Marius Hofert, Ivan Kojadinovic, Martin Maechler, and Jun Yan 2 | ## 3 | ## This program is free software; you can redistribute it and/or modify it under 4 | ## the terms of the GNU General Public License as published by the Free Software 5 | ## Foundation; either version 3 of the License, or (at your option) any later 6 | ## version. 7 | ## 8 | ## This program is distributed in the hope that it will be useful, but WITHOUT 9 | ## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 10 | ## FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 11 | ## details. 12 | ## 13 | ## You should have received a copy of the GNU General Public License along with 14 | ## this program; if not, see . 15 | 16 | 17 | ### Generating Exponentially Tilted Stable Random Vars (r ET stable) 18 | ### ================================================================ 19 | ### Experiments with retstable*() versions 20 | ### 21 | ### More (computer intensive) experiments are in 22 | ### ../demo/retstable.R 23 | ### ~~~~~~~~~~~~~~~~~~~ 24 | 25 | require(copula) 26 | source(system.file("Rsource", "utils.R", package="copula")) 27 | ##--> tryCatch.W.E(), canGet() 28 | 29 | ## it works for 0-length V0 as well: 30 | .N <- numeric(0) ; stopifnot(identical(.N, retstable(1/4, .N))) 31 | 32 | ## This is from "next version of Matrix" test-tools-1.R: 33 | showSys.time <- function(expr) { 34 | ## prepend 'Time' for R CMD Rdiff 35 | st <- system.time(expr) 36 | writeLines(paste("Time", capture.output(print(st)))) 37 | invisible(st) 38 | } 39 | 40 | ### using both retstableR() and retstable() 41 | set.seed(1) 42 | alpha <- .2 43 | V0 <- rgamma(2^12, 1) 44 | set.seed(17); showSys.time(rET <- retstable (alpha, V0)) ## method = default: here takes 45 | ## 983 times "MH", 17 x "LD" 46 | set.seed(17); showSys.time(rET.H <- retstable (alpha, V0, method= "MH")) 47 | set.seed(17); showSys.time(rET.D <- retstable (alpha, V0, method= "LD")) 48 | set.seed(17); showSys.time(rET.R <- retstableR(alpha, V0)) 49 | T <- function(r) r^(1/8) # log() is too much 50 | bp <- boxplot(T(rET), T(rET.H), T(rET.D), T(rET.R), 51 | notch=TRUE, col = "thistle") 52 | (meds <- bp$stats[3,]) 53 | 54 | ## "H0": The 4 groups are not different -- here for the medians: 55 | stopifnot(bp$conf[1,] < meds & meds < bp$conf[2,], 56 | bp$stats > 0, 57 | abs(bp$stats[2,] - 0.4035) < 0.007, ## first Quartiles 58 | abs(bp$stats[4,] - 0.8085) < 0.006) ## 3rd Quartiles 59 | -------------------------------------------------------------------------------- /vignettes/AC_Liouville.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: Archimedean Liouville Copulas 3 | author: Marius Hofert 4 | date: '`r Sys.Date()`' 5 | output: 6 | html_vignette: 7 | css: style.css 8 | vignette: > 9 | %\VignetteEngine{knitr::rmarkdown} 10 | %\VignetteIndexEntry{Archimedean Liouville Copulas} 11 | --- 12 | ```{r prelim, echo=FALSE} 13 | ## lower resolution - less size (default dpi = 72): 14 | knitr::opts_chunk$set(dpi = 48) 15 | ```{r pkg+sourc, message=FALSE} 16 | require(copula) 17 | source(system.file("Rsource", "AC-Liouville.R", package="copula")) 18 | set.seed(271) 19 | ``` 20 | 21 | ## Archimedean-Simplex copulas 22 | 23 | ```{r rACsimp} 24 | n <- 1000 25 | theta <- 0.59 26 | d <- 3 27 | U <- rACsimplex(n, d=d, theta=theta, Rdist="Gamma") 28 | cor(U, method="kendall") 29 | ``` 30 | 31 | ```{r pairs-rACsimp, fig.align="center", fig.width=6, fig.height=6} 32 | par(pty="s") 33 | pairs(U, gap=0, pch=".") # or cex=0.5 34 | ``` 35 | 36 | 37 | ## Liouville copulas 38 | 39 | See McNeil, Neslehova (2010, Figure 3) 40 | 41 | ```{r Liouville} 42 | n <- 2000 43 | theta <- 0.6 44 | alpha <- c(1, 5, 20) 45 | U <- rLiouville(n, alpha=alpha, theta=theta, Rdist="Gamma") 46 | cor(U, method="kendall") 47 | ``` 48 | 49 | ```{r pairs-Liouville, fig.align="center", fig.width=6, fig.height=6} 50 | par(pty="s") 51 | pairs(U, gap=0, pch=".") # or cex=0.5 52 | ``` 53 | 54 | 55 | ## Archimedean-Liouville copulas 56 | 57 | See McNeil, Neslehova (2010, Figure 4) 58 | 59 | ```{r ACLiou} 60 | n <- 1000 61 | theta <- 0.59 62 | alpha <- c(1, 3, 4) 63 | U <- rACLiouville(n, alpha=alpha, theta=theta, family="Clayton") 64 | cor(U, method="kendall") 65 | ``` 66 | 67 | ```{r pairs-ACLiou, fig.align="center", fig.width=6, fig.height=6} 68 | par(pty="s") 69 | pairs(U, gap=0, pch=".") # or cex=0.5 70 | ``` 71 | 72 | --------------------------------------------------------------------------------