R devel - Dec 2002 - Lattice: panel.superpose function does not pass subscripts and groups arguments (PR#2377)

Full_Name: Volker Franz
Version: 1.5.1
OS: Debian-Linux
Submission from: (NULL) (134.176.77.64)


Hi,

working with the panel.superpose function, I found out that this
function does not pass the subscripts and groups arguments to
panel.groups functions.

In my view, this seems an unnecessary restriction, because the
subscripts-mechanism which allows to access the original data should
also work if we use the panel.superpose function. (see, "A Tour of
Trellis Graphics": "the subscripts argument is a numeric vector that
tells which observation in the original data is associated with the x-
and y- values"; section 3.2).

The following patch is for the panel.superpose function of the lattice
library.  It ensures that the subscripts and the groups arguments are
passed correctly to panel.groups functions.

For illustration, I append an example which only works with the
patch...

Best
Volker

######################################################################
##Patch
##(this is patched against /usr/lib/R/library/lattice/R/lattice in
##Debian; in the .tar.gz version, the target file is: panels.R)
##
##Description: 
##   Package: lattice
##   Version: 0.5-3
##   Date: 2002/05/30
##   Priority: recommended
##   Title: Lattice Graphics
##   Author: Deepayan Sarkar <deepayan@stat.wisc.edu>
##   Maintainer: Deepayan Sarkar <deepayan@stat.wisc.edu>
##   Description: Implementation of Trellis Graphics
##   Depends: R (>= 1.5.0), grid (>= 0.6), modreg
##   License: GPL version 2 or later
##   Built: R 1.5.1; i386-pc-linux-gnu; Mon Jul 15 21:40:24 CDT 2002
##
##Note: I just checked: the problem also exists in version, 0.6-6)
######################################################################
--- lattice.orig	Tue Jul 16 04:40:24 2002
+++ lattice	Sun Dec 15 22:46:18 2002
@@ -3995,6 +3995,8 @@
             id <- (groups[subscripts] == vals[i])
             if (any(id)) {
                 args <- list(x=x[id], 
+                             subscripts = subscripts[id],
+                             groups = groups,
                              pch = pch[i], cex = cex[i],
                              col.line = col.line[i],
                              col.symbol = col.symbol[i],
######################################################################
##Example: This is the patched panel.superpose function:
######################################################################
panel.superpose <-
    function(x, y = NULL, subscripts, groups,
             panel.groups = "panel.xyplot",
             col,
             col.line = superpose.line$col,
             col.symbol = superpose.symbol$col,
             pch = superpose.symbol$pch,
             cex = superpose.symbol$cex, 
             lty = superpose.line$lty,
             lwd = superpose.line$lwd,
             ...)
{
    if (length(x)>0) {

        if (!missing(col)) {
            if (missing(col.line)) col.line <- col
            if (missing(col.symbol)) col.symbol <- col
        }

        superpose.symbol <- trellis.par.get("superpose.symbol")
        superpose.line <- trellis.par.get("superpose.line")

        x <- as.numeric(x)
        if (!is.null(y)) y <- as.numeric(y)

        vals <- sort(unique(groups))
        nvals <- length(vals)
        col.line <- rep(col.line, length=nvals)
        col.symbol <- rep(col.symbol, length=nvals)
        pch <- rep(pch, length=nvals)
        lty <- rep(lty, length=nvals)
        lwd <- rep(lwd, length=nvals)
        cex <- rep(cex, length=nvals)

        panel.groups <- 
            if (is.function(panel.groups)) panel.groups
            else if (is.character(panel.groups)) get(panel.groups)
            else eval(panel.groups)

        for (i in seq(along=vals)) {
            id <- (groups[subscripts] == vals[i])
            if (any(id)) {
                args <- list(x=x[id], 
                             subscripts = subscripts[id],
                             groups = groups,
                             pch = pch[i], cex = cex[i],
                             col.line = col.line[i],
                             col.symbol = col.symbol[i],
                             lty = lty[i],
                             lwd = lwd[i], ...)
                if (!is.null(y)) args$y=y[id]

                do.call("panel.groups", args)
            }
        }
    }
}
######################################################################
##Example: Draw a nice figure with errorbars/conf.intervalls...:
######################################################################
library(lattice)
data(barley)
barley$variety  <- as.numeric(barley$variety)
barley$yield.se <- abs(rnorm(length(barley$yield),sd=3))#Simulate standard
errors
print(xyplot(yield ~ variety | site,
             data = barley,
             groups = year,
             ses = barley$yield.se,
             type="p",
             panel  = function(x,y, ...) {
               panel.superpose(x,y, ...)
               panel.superpose(x,y,
                                
panel.groups=function(x,y,subscripts,groups,ses,col.symbol,...){
                                   cat("Call to selfdefined panel.groups
function by panel.superpose:\n")
                                   cat("  length(x)=         
",length(x),"
x=",x,"\n")
                                   cat("  length(y)=         
",length(y),"
y=",y,"\n")
                                   cat("  length(groups)=    
",length(groups),"
groups=",groups,"\n")
                                   cat("  length(ses)=       
",length(ses),"
ses=",ses,"\n")
                                   cat(" 
length(subscripts)",length(subscripts),"
subscripts=",subscripts,"\n")
                                   cat(" 
groups[subscripts]",groups[subscripts],"\n")
                                   cat("  ses[subscripts]=   
",ses[subscripts],"\n")
                                  
larrows(x,y,x,y+ses[subscripts],col=col.symbol,angle=90,proportion=0.05)
                                  
larrows(x,y,x,y-ses[subscripts],col=col.symbol,angle=90,proportion=0.05)
                                 },...)
             }))
######################################################################

--please do not edit the information below--

Version:
 platform = i386-pc-linux-gnu
 arch = i386
 os = linux-gnu
 system = i386, linux-gnu
 status = 
 major = 1
 minor = 5.1
 year = 2002
 month = 06
 day = 17
 language = R

Search Path:
 .GlobalEnv, package:ctest, package:lattice, package:grid, package:nlme,
package:nls, Autoloads, package:base

I've added this in the development version.
-Deepayan

On Monday 16 December 2002 07:32 am, volker.franz@tuebingen.mpg.de
wrote:
> Full_Name: Volker Franz
> Version: 1.5.1
> OS: Debian-Linux
> Submission from: (NULL) (134.176.77.64)
>
>
> Hi,
>
> working with the panel.superpose function, I found out that this
> function does not pass the subscripts and groups arguments to
> panel.groups functions.
>
> In my view, this seems an unnecessary restriction, because the
> subscripts-mechanism which allows to access the original data should
> also work if we use the panel.superpose function. (see, "A Tour of
> Trellis Graphics": "the subscripts argument is a numeric vector
that
> tells which observation in the original data is associated with the x-
> and y- values"; section 3.2).
>
> The following patch is for the panel.superpose function of the lattice
> library.  It ensures that the subscripts and the groups arguments are
> passed correctly to panel.groups functions.
>
> For illustration, I append an example which only works with the
> patch...
>
> Best
> Volker
[...]