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, ...)
}
)
}
