Oops, forgot the attachment. On Friday 05 September 2003 12:45 pm, Deepayan Sarkar wrote:
> The prepanel function returns separate limits for x and y axes. This does > not translate to splom, since each limit is used on both the x and y axes. > However, it is natural to add a new optional argument, which would be a > function that would decide on the limits for each variable in the data > frame, to be used as both x and y limits. This feature was missing till > now, but I have added something for the next release (source() the attached > file to use it), which will allow you to do: > > splom(log(1+DF), > prepanel.limits = function(x) c(0, 15), > panel = function(x, y, ... ) { > panel.xyplot(x, y, ...) > })
panel.pairs <- function(z, panel = "panel.splom", groups = NULL, panel.subscripts, subscripts, pscales = 5, panel.number = 0, ## should always be supplied prepanel.limits = function(x) extend.limits(range(as.numeric(x), na.rm = TRUE)), ...) { panel <- if (is.function(panel)) panel else if (is.character(panel)) get(panel) else eval(panel) axis.line <- trellis.par.get("axis.line") axis.text <- trellis.par.get("axis.text") n.var <- ncol(z) if(n.var>0) { ## there must be a better way to do the foll: lim <- list(1:n.var) for(i in 1:n.var) { lim[[i]] <- prepanel.limits(z[,i]) } ## should be further complicated by allowing for customization by ## prepanel functions --- prepanel(z[i], z[j]) etc } ## maybe (ideally) this should be affected by scales draw <- is.list(pscales) || (is.numeric(pscales) && pscales!=0) # whether axes to be drawn splom.layout <- grid.layout(nrow=n.var, ncol=n.var) if (n.var > 0 && any(subscripts)) { push.viewport(viewport(layout=splom.layout)) for(i in 1:n.var) for(j in 1:n.var) { push.viewport(viewport(layout.pos.row = n.var-i+1, layout.pos.col = j, clip = TRUE, ##gp = gpar(fontsize = fontsize.small), xscale = lim[[j]], yscale = lim[[i]])) if(i == j) { if (!is.null(colnames(z))) grid.text(colnames(z)[i]) ##gp = gpar(fontsize = 10)) if (draw) { ## plot axes if (is.factor(z[,i])) { axls <- 1:nlevels(z[,i]) nal <- length(axls)/2+.5 for(tt in seq(along=axls)) { if(tt <= nal) { grid.lines(y = unit(rep(axls[tt],2), "native"), x = unit(c(1,1),"npc") - unit(c(0,.25), "lines"), gp = gpar(col = axis.line$col)) grid.text(label = levels(z[,i])[tt], x = unit(1,"npc") - unit(.5, "lines"), y = unit(axls[tt], "native"), just = c("right", "centre")) grid.lines(x = unit(rep(axls[tt],2), "native"), y = unit(c(0,.25), "lines"), gp = gpar(col = axis.line$col)) grid.text(label = levels(z[,i])[tt], rot = 90, y = unit(0.5, "lines"), x = unit(axls[tt], "native"), just = c("left", "centre")) } if(tt >=nal) { grid.lines(y = unit(rep(axls[tt],2), "native"), x = unit(c(0,0.25), "lines"), gp = gpar(col = axis.line$col)) grid.text(label = levels(z[,i])[tt], x = unit(0.5, "lines"), y = unit(axls[tt], "native"), just = c("left", "centre")) grid.lines(x = unit(rep(axls[tt],2), "native"), y = unit(c(1,1),"npc") - unit(c(0,.25), "lines"), gp = gpar(col = axis.line$col)) grid.text(label = levels(z[,i])[tt], rot = 90, y = unit(1,"npc") - unit(.5, "lines"), x = unit(axls[tt], "native"), just = c("right", "centre")) } } } else { axls <- if (is.list(pscales) && !is.null(pscales[[i]]$at)) pscales[[i]]$at else lpretty(lim[[i]], n = pscales) labels <- if (is.list(pscales) && !is.null(pscales[[i]]$lab)) pscales[[i]]$lab ## should be rendered like factors ? else as.character(axls) axid <- axls>lim[[i]][1] & axls <lim[[i]][2] axls <- axls[axid] labels <- labels[axid] nal <- length(axls)/2+.5 for(tt in seq(along=axls)) { if(tt <= nal) { grid.lines(y = unit(rep(axls[tt],2), "native"), x = unit(c(1,1),"npc") - unit(c(0,.25), "lines"), gp = gpar(col = axis.line$col)) grid.text(label = labels[tt], x = unit(1,"npc") - unit(.5, "lines"), y = unit(axls[tt], "native"), just = c("right", "centre")) grid.lines(x = unit(rep(axls[tt],2), "native"), y = unit(c(0,.25), "lines"), gp = gpar(col = axis.line$col)) grid.text(label = labels[tt], y = unit(0.5, "lines"), x = unit(axls[tt], "native"), just = c("centre", "bottom")) } if(tt >=nal) { grid.lines(y = unit(rep(axls[tt],2), "native"), x = unit(c(0,0.25), "lines"), gp = gpar(col = axis.line$col)) grid.text(label = labels[tt], x = unit(0.5, "lines"), y = unit(axls[tt], "native"), just = c("left", "centre")) grid.lines(x = unit(rep(axls[tt],2), "native"), y = unit(c(1,1),"npc") - unit(c(0,.25), "lines"), gp = gpar(col = axis.line$col)) grid.text(label = labels[tt], y = unit(1,"npc") - unit(.5, "lines"), x = unit(axls[tt], "native"), just = c("centre", "top")) } } } } grid.rect() } else { pargs <- if (!panel.subscripts) c(list(x = as.numeric(z[subscripts, j]), y = as.numeric(z[subscripts, i]), panel.number = panel.number), list(...)) else c(list(x = as.numeric(z[subscripts, j]), y = as.numeric(z[subscripts, i]), groups = groups, subscripts = subscripts, panel.number = panel.number), list(...)) if (!("..." %in% names(formals(panel)))) pargs <- pargs[names(formals(panel))] do.call("panel", pargs) grid.rect() } pop.viewport() } pop.viewport() } }
______________________________________________ [EMAIL PROTECTED] mailing list https://www.stat.math.ethz.ch/mailman/listinfo/r-help