[R] panel.arrows problem in custom panel function

[Gavin Simpson]

On Thu, 2008-08-07 at 14:11 -0700, Deepayan Sarkar wrote:
> On Thu, Aug 7, 2008 at 7:55 AM, Gavin Simpson <gavin.simpson at ucl.ac.uk> wrote:
> > Dear List,
<snip />
> 
> You need to use the proper subset of rows of X:

[Apologies for the delay in responding --- I have been offline for
several days]

Thank you very much Deepayan. I thought that was the problem, but was
not aware of the correct incantation to select the relevant subsets.

All the best,

G

> 
> `panel.procrustes` <-
>     function(x, y, kind, choices, rotation, X,
>              ar.col, length = 0.05, ..., subscripts)
> {
>     tp <- trellis.par.get()
>     if(missing(ar.col))
>         ar.col <- tp$superpose.symbol$col[1]
>     if(kind == 1) {
>         panel.abline(h = 0, lty = "dashed")
>         panel.abline(v = 0, lty = "dashed")
>         if(ncol(rotation) == 2) {
>             ## Sometimes rotation[1,1] is 2.2e-16 above one
>             rotation[1,1] <- min(rotation[1,1], 1)
>             panel.abline(0, tan(acos(rotation[1, 1])), lty = "solid")
>             panel.abline(0, 1/tan(acos(-rotation[1, 1])), lty = "solid")
>         } else {
>             Y <- cbind(x,y) %*% t(rotation)
>             for (k in seq_len(ncol(Y))) {
>                 tmp <- matrix(0, nrow = 2, ncol = ncol(Y))
>                 tmp[, k] <- range(Y[, k])
>                 tmp <- tmp %*% rotation
>                 panel.lines(tmp[, choices], lty = 1)
>                 panel.text(tmp[2, choices[1]], tmp[2, choices[2]],
>                            as.character(k))
>             }
>         }
>         panel.xyplot(x, y, type = "p", ...)
>         panel.arrows(x0 = x, y0 = y,
>                      x1 = X[subscripts ,1], y1 = X[subscripts, 2],
>                      length = length, col = ar.col, ends = "last", ...)
>     } else if(kind == 2) {
>         quant <- quantile(y)
>         panel.xyplot(x, y, type = "h", ...)
>         panel.abline(h = quant[2:4], lty = c(2,1,2))
>     }
> }
> 
> `prepanel.procrustes` <- function(x, y, X, choices, kind, ..., subscripts) {
>     if(kind == 1) {
>         xlim <- range(x, X[subscripts, choices[1]])
>         ylim <- range(y, X[subscripts, choices[2]])
>     } else {
>         xlim <- range(x)
>         ylim <- range(y)
>     }
>     list(ylim = ylim, xlim = xlim)
> }
> 
> -Deepayan
-- 
%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%
 Dr. Gavin Simpson             [t] +44 (0)20 7679 0522
 ECRC, UCL Geography,          [f] +44 (0)20 7679 0565
 Pearson Building,             [e] gavin.simpsonATNOSPAMucl.ac.uk
 Gower Street, London          [w] http://www.ucl.ac.uk/~ucfagls/
 UK. WC1E 6BT.                 [w] http://www.freshwaters.org.uk
%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%