https://github.com/cran/nacopula
Tip revision: 5bc804b03d066ef4a2ab9cf3af6f4f2df5bcda4e authored by Martin Maechler on 23 September 2011, 00:00:00 UTC
version 0.7-9-1
version 0.7-9-1
Tip revision: 5bc804b
graphics.R
## Copyright (C) 2010 Marius Hofert and Martin Maechler
##
## This program is free software; you can redistribute it and/or modify it under
## the terms of the GNU General Public License as published by the Free Software
## Foundation; either version 3 of the License, or (at your option) any later
## version.
##
## This program is distributed in the hope that it will be useful, but WITHOUT
## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
## FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
## details.
##
## You should have received a copy of the GNU General Public License along with
## this program; if not, see <http://www.gnu.org/licenses/>.
##' @title A scatter plot matrix with nice variable names
##' @param data numeric matrix or as.matrix(.)able
##' @param varnames variable names, typically unspecified
##' @param Vname character string to become "root variable name"
##' @param col.mat matrix of colors
##' @param bg.col.mat matrix of background colors
##' @param ... further arguments to splom()
##' @return a splom() object
##' @author Martin Maechler
splom2 <- function(data, varnames=NULL, Vname="U", xlab="",
col.mat=NULL, bg.col.mat=NULL, ...)
{
stopifnot(require(lattice),
is.numeric(data <- as.matrix(data)),
(d <- ncol(data)) >= 1)
if(is.null(varnames)) {
varnames <- do.call(expression,
lapply(1:d, function(i)
substitute(italic(A[I]), list(A = as.name(Vname), I=0+i))))
}
n <- nrow(data)
if(is.null(col.mat))
col.mat <- matrix(trellis.par.get("plot.symbol")$col, n,d)
if(is.null(bg.col.mat))
bg.col.mat <- matrix(trellis.par.get("background")$col, n,d)
## From Deepayan Sarkar, working around missing feature
## (which should be in next release) of lattice
my.diag.panel <- function(x, varname, ...)
diag.panel.splom(x, varname=parse(text=varname), ...)
## splom
splom(~data[,1:d], varnames=varnames, diag.panel=my.diag.panel, xlab="",
panel = function(x, y, i, j, ...) {
panel.fill(bg.col.mat[i,j])
panel.splom(x, y, col=col.mat[i,j], ...)
}, ...)
}