[Rd] Lattice: panel.superpose function does not pass subscripts and groups arguments (PR#2377)
volker.franz@tuebingen.mpg.de
volker.franz@tuebingen.mpg.de
Mon Dec 16 14:32:03 2002
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