[Vinecopula-commits] r97 - in pkg: . R inst man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Mi Mai 27 20:06:14 CEST 2015


Author: etobi
Date: 2015-05-27 20:06:14 +0200 (Wed, 27 May 2015)
New Revision: 97

Modified:
   pkg/DESCRIPTION
   pkg/R/RVineCopSelect.r
   pkg/R/pairs.R
   pkg/inst/ChangeLog
   pkg/man/VineCopula-package.Rd
   pkg/man/pairs.copuladata.Rd
Log:
Preparation for new CRAN version
+ RVineCopSelect: RVM object now uses variable names as provided by data

Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION	2015-04-20 08:36:00 UTC (rev 96)
+++ pkg/DESCRIPTION	2015-05-27 18:06:14 UTC (rev 97)
@@ -2,8 +2,8 @@
 Type: Package
 Title: Statistical Inference of Vine Copulas
 Version: 1.5
-Date: 2015-01-26
-Author: Ulf Schepsmeier, Jakob Stoeber, Eike Christian Brechmann, Benedikt Graeler
+Date: 2015-05-27
+Author: Ulf Schepsmeier, Jakob Stoeber, Eike Christian Brechmann, Benedikt Graeler, Thomas Nagler
 Maintainer: Tobias Erhardt <tobias.erhardt at tum.de>
 Depends: R (>= 2.11.0)
 Imports: MASS, mvtnorm, igraph, methods, copula, ADGofTest, lattice

Modified: pkg/R/RVineCopSelect.r
===================================================================
--- pkg/R/RVineCopSelect.r	2015-04-20 08:36:00 UTC (rev 96)
+++ pkg/R/RVineCopSelect.r	2015-05-27 18:06:14 UTC (rev 97)
@@ -22,6 +22,11 @@
         stop("Selection criterion not implemented.")
     if (level < 0 & level > 1) 
         stop("Significance level has to be between 0 and 1.")
+    
+    ## set variable names and trunclevel if not provided 
+    if (is.null(colnames(data))) 
+        colnames(data) <- paste("V", 1:n, sep = "")
+    varnames <- colnames(data)
     if (is.na(trunclevel)) 
         trunclevel <- n
     
@@ -118,7 +123,6 @@
     }
     
     ## return results
-    varnames <- paste("V", 1:n, sep = "")
     print(Types)
     RVM <- RVineMatrix(Mold, 
                        family = Types,

Modified: pkg/R/pairs.R
===================================================================
--- pkg/R/pairs.R	2015-04-20 08:36:00 UTC (rev 96)
+++ pkg/R/pairs.R	2015-05-27 18:06:14 UTC (rev 97)
@@ -1,111 +1,100 @@
-pairs.copuladata <- function(x, 
+pairs.copuladata <- function(x,
                              labels = names(x),
-                             ..., 
+                             ...,
+                             lower.panel = lp.copuladata,
+                             upper.panel = up.copuladata,
+                             diag.panel = dp.copuladata,
                              label.pos = 0.85, 
                              cex.labels = 1,
-                             gap = 0,
-                             axes = FALSE,
-                             pch = ".",
-                             col = "grey",
-                             cex.points = 1, 
-                             method.cor = "kendall",
-                             col.cor = "red", 
-                             digits.cor = 2,
-                             cex.cor = 1, 
-                             bw = 2, 
-                             size = 100, 
-                             levels = seq(0.01, 0.2, length.out = 30), 
-                             margins = "norm", 
-                             margins.par = 0, 
-                             xylim = NA, 
-                             col.contour = terrain.colors(length(levels)), 
-                             col.hist = "grey") {
-    ## pairs plot for 'copuladata'
-    
-    ## labeling of axes
-    if (axes) {
-        xaxt <- "s"
-        yaxt <- "s"
-    } else {
-        xaxt <- "n"
-        yaxt <- "n"
-    }
-    
-    ## lower panel: empirical contour plot
-    lower.panel.copuladata <- function(x,
-                                       y, 
-                                       lower.bw = bw, 
-                                       lower.size = size, 
-                                       lower.levels = levels,
-                                       lower.margins = margins,
-                                       lower.margins.par = margins.par, 
-                                       lower.xylim = xylim,
-                                       col = col.contour,
-                                       ...) {
-        op <- par(usr = c(-3, 3, -3, 3), new = TRUE)
-        BiCopMetaContour(x,
-                         y, 
-                         bw = lower.bw, 
-                         size = lower.size, 
-                         levels = lower.levels, 
-                         axes = FALSE,
-                         margins = lower.margins, 
-                         margins.par = lower.margins.par, 
-                         xylim = lower.xylim, 
-                         col = col, 
-                         drawlabels = FALSE, 
-                         ...)
-        on.exit(par(op))
-    }
-    
-    ## upper panel: scatter plot (copula data) and correlation
-    upper.panel.copuladata <- function(x,
-                                       y, 
-                                       method = method.cor,
-                                       upper.pch = pch, 
-                                       upper.col = col, 
-                                       upper.col.text = col.cor, 
-                                       upper.cex = cex.points, 
-                                       upper.digits = digits.cor,
-                                       upper.cex.cor = cex.cor,
-                                       ...) {
-        op <- par(usr = c(0, 1, 0, 1), new = TRUE)
-        plot(x,
-             y, 
-             pch = upper.pch, 
-             cex = upper.cex, 
-             col = upper.col, 
-             axes = FALSE, 
-             ...)
-        r <- cor(x, y, method = method)
-        txt <- format(r, digits = upper.digits, nsmall = upper.digits)[1]
-        text(0.5, 0.5, txt, cex = upper.cex.cor + abs(r) * 3, col = upper.col.text)
-        on.exit(par(op))
-    }
-    
-    ## diagonal panel: histograms (copula data)
-    diag.panel.copuladata <- function(x, diag.col = col.hist, ...) {
-        op <- par(usr = c(0, 1, 0, 1.6), new = TRUE)
-        hist(x, 
-             freq = FALSE,
-             add = TRUE,
-             col = diag.col,
-             border = "black", 
-             main = "")
-        abline(h = 1, col = "black", lty = 3)
-        on.exit(par(op))
-    }
-    
-    ## pairs plot (with panel functions as defined above)
-    pairs.default(x,
+                             gap = 0) {
+  ## pairs plot for 'copuladata'
+  
+  # provide input data and set default labels, panel functions, etc.
+  default <- list(x = as.matrix(x),
                   labels = labels,
-                  ..., 
-                  lower.panel = lower.panel.copuladata, 
-                  upper.panel = upper.panel.copuladata, 
-                  diag.panel = diag.panel.copuladata, 
-                  label.pos = label.pos,
+                  lower.panel = lower.panel,
+                  upper.panel = upper.panel,
+                  diag.panel = diag.panel,
+                  label.pos = label.pos, 
                   cex.labels = cex.labels,
-                  gap = gap,
-                  xaxt = xaxt, 
-                  yaxt = yaxt)
-}
\ No newline at end of file
+                  gap = gap
+                  )
+  
+  # pairs plot (with panel functions as defined below or as provided by user)
+  pars <- modifyList(list(xaxt = "n", yaxt = "n"), list(...))
+  op <- do.call(par, pars)
+  do.call(pairs, modifyList(default, list(...)))
+  on.exit(par(op))
+}
+
+
+## lower panel: empirical contour plot
+lp.copuladata <- function(x, y, ...) {
+  # set default parameters
+  pars <- list(u1 = x,
+               u2 = y,
+               bw = 2, 
+               size = 100, 
+               levels = seq(0.01, 0.2, length.out = 30),
+               margins = "norm", 
+               margins.par = 0, 
+               xylim = NA, 
+               col = terrain.colors(30),
+               axes = FALSE,
+               drawlabels = FALSE)
+  # get non-default parameters
+  pars <- modifyList(pars, list(...))
+  op <- par(usr = c(-3, 3, -3, 3), new = TRUE)
+  # call BiCopMetaContour
+  do.call(BiCopMetaContour, pars)
+  on.exit(par(op))
+}
+
+
+## upper panel: scatter plot (copula data) and correlation
+up.copuladata <- function(x, y, ...) {
+  # set default parameters
+  pars <- list(x = x,
+               y = y,
+               pch = ".",
+               cex = 1,
+               col = "grey"
+  )
+  # get non-default parameters
+  pars <- modifyList(pars, list(...))
+  op <- par(usr = c(0, 1, 0, 1), new = TRUE)
+  # call points (to produce scatter plot)
+  do.call(points, pars)
+  r <- cor(x = x, y = y, method = "kendall")
+  txt <- format(x = r, digits = 2, nsmall = 2)[1]
+  # call text
+  do.call(text, modifyList(list(x = 0.5,
+                                y = 0.5,
+                                labels = txt,
+                                cex = 1 + abs(r) * 3,
+                                col = "red"),
+                           list(...)
+                           )
+  )
+  on.exit(par(op))
+}
+
+
+## diagonal panel: histograms (copula data)
+dp.copuladata <- function(x, ...) {
+  # set default parameters
+  pars <- list(x = x,
+               freq = FALSE,
+               add = TRUE,
+               col = "grey",
+               border = "black", 
+               main = "")
+  # get non-default parameters
+  pars <- modifyList(pars, list(...))
+  op <- par(usr = c(0, 1, 0, 1.6), new = TRUE)
+  # call hist
+  do.call(hist, pars)
+  if (pars$freq == FALSE)
+    abline(h = 1, col = "black", lty = 3)
+  on.exit(par(op))
+}

Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2015-04-20 08:36:00 UTC (rev 96)
+++ pkg/inst/ChangeLog	2015-05-27 18:06:14 UTC (rev 97)
@@ -5,11 +5,34 @@
 Maintainer: Tobias Erhardt <tobias.erhardt at tum.de> and Thomas Nagler <thomas.nagler at tum.de>
 
 
+Version 1.5 (May 27, 2015)
+
+- New functionality:
+  * as.copuladata: coerce to class copuladata
+  * pairs.copuladata: pairs plots for objects of class copuladata
+  * RVinePDF: PDF of an R-Vine Copula Model
+  * BiCopSelect, RVineCopSelect, RVineStructureSelect: add option "rotations = TRUE" which augments the familyset with all rotations to a given family
+  * RVineMatrix, RVineStructureSelect: allow upper triangular matrices as input (output remains lower triangular)
+  * 'BiCop' objects for bivariate copulas:
+    . add constructor 'BiCop' and plotting generic 'plot.BiCop'
+    . define results of 'BiCopEst'/'BiCopSelect' as 'BiCop' objects
+    . add compatibility with other BiCopXyz functions (BiCopPDF, BiCopPar2Tau, etc.)
+
+- Bug fix:
+  * BiCopEst: extend search interval for Tawn MLE to avoid optim-errors
+  * BiCopEst: fix for optim error ('non-finite value supplied')
+  * RVineSim: reorder U so that it corresponds to the order of RVM
+  * RVineCor2pcor: include normalization step for a more intuitive behavior
+  * RVinePcor2cor: bug fixes for d=2 and d>9
+  * RVineCopSelect: RVM object now uses variable names as provided by data
+
+
 Version 1.4 (January 26, 2015)
 
 - New functionality:
   * BiCopTau2Par and BiCopPar2Tau: fully vectorized (parameter/tau input), and sanity checks extendend. Before vector input was not prohibited. However, both functions were not intended to be used for vectorized input.
 
+
 Version 1.3-2 (January 19, 2015)
 
 - New author: Thomas Nagler
@@ -29,6 +52,7 @@
   * Package 'ADGofTest' removed from Suggests (see 'Writing R Extensions' for usage of Suggests)
   * Import of function 'ad.test' from 'ADGofTest' for 'gof_PIT.r'
 
+
 Version 1.3-1 (September 10, 2014)
 
 - Bug fix:
@@ -38,15 +62,18 @@
 	Second, forget to permute vdirect and vindirect according to the permutation of data.
   * BiCopSelect: For the rotated BB7 and BB8 (family=37, 38) the limiting cases were incorrect for very small parameters (copy&paste error) (Reported by Radek Solnicky. Thanks!)
 
+
 Version 1.3 (March 26, 2014)
 
 - Maintainer changed from Ulf Schepsmeier to Tobias Erhardt (tobias.erhardt at tum.de)
 
+
 Version 1.2-1 (March 21, 2014)
 
 - Moved copula from depends to the more appropriate import field
 - Added tests generated from example code
 
+
 Version 1.2-1 (March 4, 2014)
 
 - New functionality:

Modified: pkg/man/VineCopula-package.Rd
===================================================================
--- pkg/man/VineCopula-package.Rd	2015-04-20 08:36:00 UTC (rev 96)
+++ pkg/man/VineCopula-package.Rd	2015-05-27 18:06:14 UTC (rev 97)
@@ -79,18 +79,18 @@
 \tabular{ll}{
 Package: \tab VineCopula\cr
 Type: \tab Package\cr
-Version: \tab 1.4\cr
-Date: \tab 2015-01-26\cr
+Version: \tab 1.5\cr
+Date: \tab 2015-05-27\cr
 License: \tab GPL (>=2)\cr
 Depends: \tab R (\eqn{\geq 2.11.0}{>= 2.11.0})\cr
-Imports: \tab MASS, mvtnorm, igraph, methods, copula, ADGofTest\cr
+Imports: \tab MASS, mvtnorm, igraph, methods, copula, ADGofTest, lattice\cr
 Suggests: \tab CDVine, TSP\cr
 LazyLoad: \tab yes
 }
 }
 
 \author{
-Ulf Schepsmeier, Jakob Stoeber, Eike Christian Brechmann, Benedikt Graeler
+Ulf Schepsmeier, Jakob Stoeber, Eike Christian Brechmann, Benedikt Graeler, Thomas Nagler
 }
 
 \references{ 
@@ -167,9 +167,9 @@
 Preprint
 \url{http://arxiv.org/abs/1306.0818}
 
-Schepsmeier, U. (2013)
-Efficient goodness-of-fit tests in multi-dimensional vine copula models. 
-\url{http://arxiv.org/abs/1309.5808}
+Schepsmeier, U. (2015)
+Efficient information based goodness-of-fit tests for vine copula models with fixed margins. 
+Journal of Multivariate Analysis 138, 34–52.
 
 Stoeber, J. and U. Schepsmeier (2013).
 Estimating standard errors in regular vine copula models. Computational Statistics, 28 (6), 2679-2707

Modified: pkg/man/pairs.copuladata.Rd
===================================================================
--- pkg/man/pairs.copuladata.Rd	2015-04-20 08:36:00 UTC (rev 96)
+++ pkg/man/pairs.copuladata.Rd	2015-05-27 18:06:14 UTC (rev 97)
@@ -4,61 +4,30 @@
 \title{Pairs Plot of Copula Data}
 
 \description{
-  This function provides pair plots for copula data. It plots bivariate contour plots on the lower panel, scatter plots and correlations on the upper panel and histograms on the diagonal panel.
+  This function provides pair plots for copula data. Using default setting it plots bivariate contour plots on the lower panel, scatter plots and correlations on the upper panel and histograms on the diagonal panel.
 }
 
 \usage{
 \method{pairs}{copuladata}(x, labels = names(x), ...,
-                  label.pos = 0.85, cex.labels = 1, gap = 0, axes = FALSE,
-                  pch = ".", col = "grey", cex.points = 1,
-                  method.cor = "kendall", col.cor = "red", digits.cor = 2, cex.cor = 1,
-                  bw = 2, size = 100, levels = seq(0.01, 0.2, length.out = 30),
-                  margins = "norm", margins.par = 0, xylim = NA,
-                  col.contour = terrain.colors(length(levels)),
-                  col.hist = "grey")
+      lower.panel = lp.copuladata,
+      upper.panel = up.copuladata,
+      diag.panel = dp.copuladata,
+      label.pos = 0.85, cex.labels = 1, gap = 0)
 }
 
 \arguments{
   \item{x}{\code{copuladata} object.}
   \item{labels}{variable names/labels.}
   \item{\dots}{other graphical parameters (see \code{\link[graphics]{par}}).}
+  \item{lower.panel}{panel function to be used on the lower diagonal panels}
+  \item{upper.panel}{panel function to be used on the upper diagonal panels}
+  \item{diag.panel}{panel function to be used on the diagonal panels}
   \item{label.pos}{y position of labels in the diagonal panel; default: \code{label.pos = 0.85}.}
   \item{cex.labels}{magnification to be used for the labels of the diagonal panel; default: \code{cex.labels = 1}.}
   \item{gap}{distance between subplots, in margin lines; default: \code{gap = 0}.}
-  \item{axes}{a logical value indicating whether both axes should be drawn on the plot; default: \code{axes = FALSE}.}
-  \item{pch}{plotting characters/symbols to be used for the points of the scatter plots; default: \code{pch = "."}.}
-  \item{col}{colour to be used for the points of the scatter plots; default: \code{col = "grey"}.}
-  \item{cex.points}{magnification to be used for the points of the scatter plots; default: \code{cex.points = 1}.}
-  \item{method.cor}{a character string indicating which correlation coefficients are computed. One of \code{pearson}, \code{kendall} (default), or \code{spearman}}
-  \item{col.cor}{colour to be used for the correlation coefficients in the scatter plots; default: \code{col.cor = "red"}.}
-  \item{digits.cor}{digits to be used for the correlation coefficients in the scatter plots; default: \code{digits.cor = 2}.}
-  \item{cex.cor}{magnification to be used for the correlation coefficients in the scatter plots; default: \code{cex.cor = 1}.}
-  \item{bw}{bandwidth to be used for the contour plots (smoothing factor; default: \code{bw = 1}).}
-  \item{size}{number of grid points to be used for the contour plots; default: \code{size = 100}.}
-  \item{levels}{vector of contour levels to be used for the contour plots.
-                For Gaussian, Student t or exponential margins the default value (\code{levels = seq(0.01, 0.2, length.out = 30)}) typically is a good choice.
-                For uniform margins we recommend\cr
-                \code{levels = seq(0.1, 1.5, length.out = 30)}\cr
-                and for Gamma margins\cr
-                \code{levels = seq(0.005, 0.09, length.out = 30)}.}
-  \item{margins}{character; margins for the contour plots. Possible margins are:\cr
-                 \code{"norm"} = standard normal margins (default)\cr
-                 \code{"t"} = Student t margins with degrees of freedom as specified by \code{margins.par}\cr
-                 \code{"gamma"} = Gamma margins with shape and scale as specified by \code{margins.par}\cr
-                 \code{"exp"} = Exponential margins with rate as specified by \code{margins.par}\cr
-                 \code{"unif"} = uniform margins}
-  \item{margins.par}{parameter(s) of the distribution of the margins (of the contour plots) if necessary (default: \code{margins.par = 0}), i.e., 
-                     \itemize{
-                       \item a positive real number for the degrees of freedom of Student t margins (see \code{\link{dt}}),
-                        \item a 2-dimensional vector of positive real numbers for the shape and scale parameters of Gamma margins (see \code{\link{dgamma}}),
-                        \item a positive real number for the rate parameter of exponential margins (see \code{\link{dexp}}). 
-                     }}
-  \item{xylim}{2-dimensional vector of the x- and y-limits to be used for the contour plots.
-               By default (\code{xylim = NA}) standard limits for the selected margins are used.} 
-  \item{col.contour}{colour to be used for the contour plots; default: \code{col.contour = terrain.colors(length(levels))}.}
-  \item{col.hist}{colour to be used for histograms of the diagonal panel; default: \code{col.hist = "grey"}.}
 }
 
+
 \author{Tobias Erhardt}
 
 \seealso{\code{\link[graphics]{pairs}}, \code{\link{as.copuladata}}, \code{\link{BiCopMetaContour}}}
@@ -73,11 +42,41 @@
 
 ## pairs plot with custom settings
 nlevels <- 20
-pairs(data[1:5], cex.labels = 2, gap = 1,
-      pch = 20, col = "black", cex.points = 0.5,
-      method.cor = "spearman", col.cor = "green",
-      digits.cor = 3, cex.cor = 1.5,
-      bw = 1.5, levels = seq(0.01, 0.2, length.out = nlevels),
-      margins = "t", margins.par = 5, xylim = c(-1,2),
-      col.contour = heat.colors(nlevels), col.hist = "white")
+pairs(data[1:5], cex = 2, pch = 1,
+      diag.panel = NULL, label.pos = 0.5,
+      cex.labels = 2.5, gap = 1)
+      
+## pairs plot with own panel functions
+up.copuladata <- function(x, y) {
+  # lower panel: empirical contour plot
+  op <- par(usr = c(-3, 3, -3, 3), new = TRUE)
+  BiCopMetaContour(x, y, bw = 2, levels = c(0.01, 0.05, 0.1, 0.15, 0.2),
+                    # exponential margins
+                    margins = "exp", margins.par = 1,
+                    axes = FALSE)
+  on.exit(par(op))
 }
+
+lp.copuladata <- function(x, y) {
+  # upper panel: scatter plot (copula data) and correlation
+  op <- par(usr = c(0, 1, 0, 1), new = TRUE)
+  points(x, y, pch = 1, col = "black")
+  r <- cor(x, y, method = "spearman") # Spearman's rho
+  txt <- format(x = r, digits = 3, nsmall = 3)[1]
+  text(x = 0.5, y = 0.5, labels = txt, cex = 1 + abs(r) * 2, col = "blue")
+  on.exit(par(op))
+}
+
+dp.copuladata <- function(x) {
+  # diagonal panel: histograms (copula data)
+  op <- par(usr = c(0, 1, 0, 1.5), new = TRUE)
+  hist(x, freq = FALSE, add = TRUE, col = "brown", border = "white", main = "")
+  abline(h = 1, col = "black", lty = 2)
+  on.exit(par(op))
+}
+
+nlevels <- 20
+pairs(data[1:5],
+      lower.panel = lp.copuladata, upper.panel = up.copuladata,
+      diag.panel = dp.copuladata, gap = 0.5)
+}



Mehr Informationen über die Mailingliste Vinecopula-commits