[R] lattice xyplot with bty="l"

László Sándor sandorl at gmail.com
Wed Jul 7 22:58:04 CEST 2010


Thank you, this has been really helpful, I think I have managed to
produce the desired effect.

However, I am having trouble with generating and passing subscripts
from the main xyplot call to panel.superpose. My code resembles the
examples (e.g. pp 71-73) in your 2008 book --- though I cannot refer
to generic variable names "x", "y" or "groups" in panel (and panel.
functions) within xyplot either, so the problem need not be with
subscripts.

If you could have a look, I paste my entire function below to be
"almost functional," but the problem is relatively straightforward,
around the end in the panel call.

Thank you again,

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),
		xlab = xvarlab, ylab = yvarlab,ylim=yrange,
					aspect="fill",
			panel = function(..., subscripts) {
				panel.grid(h = -1, v = 0)
				panel.xyplot(...)
				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, ...)
				}
		)
		}

2010/7/7 Deepayan Sarkar <deepayan.sarkar at gmail.com>:
> 2010/7/5 László Sándor <sandorl at gmail.com>:
>> Hi all,
>>
>> Back in 2007, Deepayan and Patrick had an exchange about how to modify
>> axes for lattice plots (pasted below). I need something similar, but I
>> also need to produce ticks on the axes. Deepayan quickly coded up
>> substitute gridlines because they needed to make the default box
>> transparent. The code works, but it lacks the ticks, and I could not
>> google up how to add them.
>>
>> (I would be taken aback if you could even help me but this option into
>> a theme for the latticeExtra package -- the grid options there do not
>> seem to allow left and bottom axes at the same time. Not even
>> asTheEconomist command, though I thought I have seen plot with
>> "bty="l" " in The Economist...)
>>
>> I understand that panels in lattice were not intended for such use
>> originally, but for many advanced features of the lattice package, my
>> team wants to use this. The specific goal would be to produce graphs
>> in R like those here:
>> http://obs.rc.fas.harvard.edu/chetty/denmark_adjcost_slides.pdf  .
>>
>> Any help would be greatly appreciated.
>
> The first step would be
>
> xyplot(1:10 ~ 1:10, par.settings=list(axis.line = list(col = "transparent")),
>        scales = list(col = "black", tck = c(1, 0)))
>
> You can then add the sides in the panel function (or axis function).
>
> -Deepayan
>



More information about the R-help mailing list