[R] subscripts for panel.superpose in lattice

[László Sándor]

Hi,

I am trying to superimpose (overlay) regression lines to scatter plots
by groups with xyplot (dysfunctional code below). However, my call of
panel.superpose breaks down because of the subscripts requirement. I
tried to research the documentation and examples, but I cannot figure
out how to make xyplot plug subscripts to a panel... call. Could you
have a look? It would be greatly appreciated.

Thank you,

Laszlo

scatter_contrast <- function(depvar,bins,cutvar,cutvarname = NULL,
		yvarlab = NULL,xvarlab =
NULL,nbins=20,maxbins=100,yrange=c(0,99999),plottitle=NULL,legendtitle=NULL)
 {
			library('lattice')
			library('grid')
	trellis.par.set(
		plot.symbol = list(cex = 1.5,col=rgb(26,71,111,max=255)),
		superpose.symbol = list(cex = rep(1,
times=7),pch=c(15:21),col=c(rgb(26,71,111,max=255),
rgb(144,53,59,max=255),rgb(85,117,47,max=255),"#ff0000","orange","#00ff00","brown"),fill=c(rgb(26,71,111,max=255),
  rgb(144,53,59,max=255),rgb(85,117,47,max=255),"#ff0000","orange","#00ff00","brown")),
		plot.line = list(cex = 1,lwd=2,col=rgb(26,71,111,max=255)),
		superpose.line = list(cex = rep(1,
times=7),lwd=rep(2,times=7),col=c(rgb(26,71,111,max=255),
rgb(144,53,59,max=255),rgb(85,117,47,max=255),"#ff0000","orange","#00ff00","brown")),
		reference.line = list(col=rgb(234,242,243,max=255)),
		add.line = list(rgb(85,117,47,max=255),lwd=2),
		grid.pars = list(col="black"),#rgb(234,242,243,max=255)),
		superpose.polygon = list(col="black"),#rgb(234,242,243,max=255)),
		fontsize = list(text=16),	
		par.xlab.text = list(cex = 0.8),
		par.ylab.text = list(cex = 0.8),
		)
	if (length(unique(bins))>maxbins) bins <- binning(bins,nbins)
	temp <- summary(cutvar)
	cut <- 1*(cutvar > temp[3])
	if (length(unique(!is.na(cutvar)))<6) cut <- cutvar
	legval1 <- names(data.frame(cutvar))
	xl <- names(data.frame(bins))
	leg <- paste(unique(sort(cut)))
	legval2 <- leg[1:(length(unique(leg))-1)]
	if (length(na.omit(cutvar)) == length(cutvar)) legval2 <- leg
	ht <- depvar[[1]]
	if (is.na(ht)) ht <- 0
	if (ht == "hist") {
		bins <- replace(bins,bins>quantile(bins,0.99),quantile(bins,0.99))
		bins <- replace(bins,bins<quantile(bins,0.05),quantile(bins,0.05))
		mes <- aggregate(matrix(1,length(bins),1),list(bins,cut),sum,na.rm = TRUE)
		cnt <- aggregate(matrix(1,length(bins),1),list(cut),sum,na.rm = TRUE)
		mes$x <- mes$V1
		mes$V1 <- NULL
		mes <- merge(mes,cnt,by.x = "Group.2",by.y = "Group.1")
		mes$x <- mes$x/mes$V1 }
	else {mes <- aggregate(depvar,list(bins,cut),mean,na.rm = TRUE)}
	if (yrange[2] == 99999) {
			ran <- (max(mes$x)- min(mes$x))*0.1
			yrange = c(min(mes$x)-ran,max(mes$x)+ran)}
	xyplot(x ~ Group.1,groups = Group.2,data = mes, subscripts =TRUE,type = "p",
		auto.key = list(cex=0.7,cex.title=0.7,title=legendtitle,space =
"bottom",points = FALSE,lines=TRUE,columns=2),
#		key = simpleKey(paste(cutvarname,leg),points = FALSE,lines=TRUE ),
		xlab = xvarlab, ylab = yvarlab,ylim=yrange,
					aspect="fill",
			panel = function(...) {
				panel.grid(h = -1, v = 0)
				panel.xyplot(...)
#				panel.abline(lm(depvar ~ bins))
				panel.superpose(bins,depvar,subscripts,groups = cutvar,type="nr")
				panel.axis(side = "left", outside = TRUE,tck = -1, line.col = 1)
				panel.axis(side = "bottom", outside = TRUE,tck = -1, line.col = 1)},
			main = plottitle,
			par.settings = list(axis.line = list(col = "transparent")),
			axis = function(side, ...) {
				if (side == "left") {
					grid.lines(x = c(0, 0), y = c(0, 1),default.units =
"npc",gp=gpar(col='black')) }

				else if (side == "bottom") {
					grid.lines(x = c(0, 1), y = c(0, 0),default.units =
"npc",gp=gpar(col='black')) }
				axis.default(side = side, ...)
				}
		)
		}