[Rd] Question lattice SplomT

[Christian Hoffmann]

Dear Deepayan Sarkar,

I have (again) a question concerning "panel" and my function "SplomT", 
see attachments. Some time ago you helped me to write this function, 
thanks again. I have used it to great advantage in my statistics 
instructions. Now the problem I encounter is that the .pdf figure 
generated in Sweave consists of

one extra empty page at the start.

This prevents it from showing up in the final .pdf document. I am not 
sure whether this has any thing to do with Sweave. (If the statement is 
executed on the command line, the plot in the Quartz window looks allright.)

Since I have no full version of Adobe Acrobat I cannot eliminate the 
empty first page. I tried to fiddle around with the panel functions, but 
was not table to mimic my function.

Thanks for your attention and for looking at my problem.

Christian Hoffmann

PS: for *r-devel*: Could this be an Sweave problem?

Files attached:
SplomT.Rnw  : File containing the Functiond and an example,
SplomT.tex   : Result from Sweave of .Rnw,
SplomT.pdf  : Result from TeXing the .tex,
Fig_A.pdf    : Resulting figure from Sweave
SplomT.png  : Screenshot of Fig_A.pdf

sessionInfo()
R version 2.15.1 (2012-06-22)
Platform: x86_64-apple-darwin9.8.0/x86_64 (64-bit)

locale:
[1] C

attached base packages:
  [1] tools     tcltk     stats4    splines   parallel  datasets compiler
  [8] graphics  grDevices stats     grid      utils     methods base

other attached packages:
  [1] survival_2.36-14  spatial_7.3-3     rpart_3.1-53 nnet_7.3-1
  [5] nlme_3.1-104      mgcv_1.7-18       foreign_0.8-50 codetools_0.2-8
  [9] cluster_1.14.2    class_7.3-3       boot_1.3-4 Matrix_1.0-6
[13] MASS_7.3-18       KernSmooth_2.23-7 cwhmisc_3.0 lattice_0.20-6
 >

-- 
Christian W. Hoffmann,
CH - 8915 Hausen am Albis, Switzerland
Rigiblickstrasse 15 b, Tel.+41-44-7640853
c-w.hoffmann at sunrise.ch,
christian at echoffmann.ch,
www.echoffmann.ch

-------------- next part --------------
%% Test SplomT
\documentclass[a4paper,11pt,leqno]{scrbook}
\usepackage[OT2,OT1]{fontenc}
\usepackage[russian,ngerman,english]{babel}
%% \usepackage[displaymath]{lineno}
\usepackage{graphicx}
\usepackage{textcomp}  % special symbols
\usepackage{geometry}
\geometry{verbose,a4paper,tmargin=2.4cm,bmargin=2.5cm,lmargin=2.5cm,rmargin=2cm}
\usepackage{amsmath}
\usepackage{amssymb}
\usepackage{longtable}
\usepackage{psfrag}  % for greek letters etc.
\usepackage{Sweave} %% /Users/hoffmann/R/Rtest/Sweave


\begin{document}
\SweaveOpts{prefix.string=fig/Fig}

\title{\textbf{Test SplomT}
 }
\author{Christian W. Hoffmann}
\maketitle
<<O,fig=TRUE>>=
plot(0,xlab="This is for test purposes only")
@ 
<<A,fig=TRUE>>=
SplomT <- function (data, mainL = deparse(substitute(data)), xlabL = "", 
    hist = "h", adjust = 1, hist.col = trellis.par.get("strip.background")$col[5], cex.diag = 1, h.diag=0.4, colYonX = "red", colXonY = "blue", ...) {
  stopifnot (hist %in% c("h", "d", "b")) 
  data  <- data.frame(data)
  mxnam <- max(nchar(names(data)))
  lnam  <- ncol(data)
  ce    <- 100*cex.diag*get.gpar()$cex/lnam
  cexd  <- ce/mxnam
  cexn  <- ce/5
  print(splom(~data, as.matrix = TRUE, main = mainL, xlab = xlabL,
    upper.panel = function(x, y, breaks = NULL, ...) {
      minS <- 0.05
      ccr <- cor(x, y, use = "complete.obs")
      ccq <- sqrt(max(abs(ccr), minS))
      if (is.na(ccr)) {ccr <- 0; ccq <- sqrt(minS)}
      grid.text(round(ccr, 2), gp = gpar(cex = cexn*ccq))
    },
    lower.panel = function(x, y, ...) {
      options(show.error.messages = FALSE)
      try(panel.xyplot(x, y, type = c("p", "smooth"), col.line = colYonX, 
          pch = 3, cex = 1.5/dim(data)[2], ...))
      lo <- try(loess.smooth(y, x, ...))
      if (!inherits(lo,"try-error")) panel.lines(lo$y, lo$x, col.line = colXonY, ...)
      options(show.error.messages = TRUE)
    },
    diag.panel = function(x, varname, limits, ...) {
      d <- density(x[!is.na(x)])
      yrng <- range(d$y)
      ylim <- yrng + 0.07 * c(-1, 1) * diff(yrng)
      xlim <- current.panel.limits()$xlim
      pushViewport(viewport(xscale = xlim, yscale = ylim))
      if (hist %in% c("h", "b")) {
        panel.histogram(x[!is.na(x)], breaks = NULL, col = hist.col, type = "density", ...)
      }
      if (hist %in% c("d", "b")) {
        llines(d)
      }
      grid.text(varname,  y=unit(h.diag,"npc"), gp = gpar(cex = cexd))
      popViewport()
    }, varnames = abbreviate(names(data)), pscales = 0 )
  )
}  ## end SplomT  2012-09-24, 16:25

  nr <- 100; nc <- 8;
  data <- as.data.frame(matrix(rnorm(nr*nc),nrow=nr,ncol=nc))
  data[,nc]   <- data[,nc-2] + 0.3*data[,nc-1] #generate higher correlations
  data[,nc-1] <- data[,nc-1] + 0.9*data[,nc]
  colnames(data)<-paste("vw",letters[1:nc],sep="")
  SplomT(data,mainL="",hist="d",cex.diag=0.6,hist.col="green")
@

\end{document}
-------------- next part --------------
A non-text attachment was scrubbed...
Name: Fig-A.pdf
Type: application/pdf
Size: 97743 bytes
Desc: not available
URL: <https://stat.ethz.ch/pipermail/r-devel/attachments/20120924/72d3c347/attachment.pdf>
-------------- next part --------------
A non-text attachment was scrubbed...
Name: SplomT0.pdf
Type: application/pdf
Size: 57365 bytes
Desc: not available
URL: <https://stat.ethz.ch/pipermail/r-devel/attachments/20120924/72d3c347/attachment-0001.pdf>
-------------- next part --------------
A non-text attachment was scrubbed...
Name: SplomT.png
Type: image/png
Size: 154910 bytes
Desc: not available
URL: <https://stat.ethz.ch/pipermail/r-devel/attachments/20120924/72d3c347/attachment.png>