############################################################
#################### 60 Characters Wide ####################
############################################################
# Walton A. Green
# Department of Geology
# Yale Unversity
# P. O. Box 208109 Yale Station
# New Haven, Connecticut 06520
# walton.green@yale.edu
#
# John W. Emerson
#
############################################################
#################### 60 Characters Wide ####################
############################################################
#
# plots panels of sparklines at arbitrary
# locations (all panels must have data of the same
# shape; multiple calls are needed if the shape of the
# data varies).
#
############################################################
# sparkmat()
############################################################
sparkmat <- function(x,
locs = NULL,
w = NULL,
h = NULL,
lcol = NULL,
yscales = NULL,
tile.shading = NULL,
tile.margin = unit(c(0,0,0,0), 'points'),
tile.pars = NULL,
just = c('right', 'top'),
new = TRUE,
...) {
if (new) grid.newpage()
### Walton, why would x[[1]] ever be NULL? Trap elsewhere?
###
if (!is.null(x[[1]]) && is.null(yscales)) {
yscales <- vector(mode="list", length=length(x[[1]]))
for (i in 1:length(x)) { # Over the panels
for (j in 1:length(x[[1]])) { # Over the sparklines in a panel
yscales[[j]] <- c(min(yscales[[j]][1], min(x[[i]][,j], na.rm=TRUE)),
max(yscales[[j]][2], max(x[[i]][,j], na.rm=TRUE)))
}
}
}
# A little function that takes two vectors of, for instance, the x and y
# values at which a regular grid of points should be drawn and
# returns a data frame with the ordered pairs at which to plot all the
# points as two columes of a data frame.
vectorize <- function(x,y){
x.v <- rep(x, length(y))
y.v <- as.numeric(matrix(y, nrow = length(x),
ncol = length(y), byrow = TRUE))
return(data.frame(x = x.v, y = y.v))
}
# if locs is NULL, set up a regular grid for the sparkmats
if (is.null(locs)) {
mats.down <- floor(sqrt(length(x)))
mats.across <- ceiling(length(x) / mats.down)
locs <- vectorize(x = (1:mats.across) / mats.across,
y = (mats.down:1) / mats.down)
locs$x <- unit(locs$x, 'npc')
locs$y <- unit(locs$y, 'npc')
if (is.null(w)) w <- unit(1/mats.across, 'npc')
if (is.null(h)) h <- unit(1/mats.down, 'npc')
} else { ############ Added by Jay 11/3/06
if (new) {
pushViewport(viewport(x=0.15, y=0.1, width=0.75, height=0.75,
just=c("left", "bottom"),
xscale=range(pretty(locs[,1])),
yscale=range(pretty(locs[,2]))))
grid.xaxis()
grid.yaxis()
}
}
if (!is.unit(w)) w <- unit(w, "native")
if (!is.unit(h)) h <- unit(h, "native")
for (i in 1:length(x)) {
if (is.unit(locs[i,1])) xloc <- locs[i,1]
else xloc <- unit(locs[i,1], "native")
if (is.unit(locs[i,2])) yloc <- locs[i,2]
else yloc <- unit(locs[i,2], "native")
sparklines.viewport <- viewport(x=xloc, y=yloc,
just=just, width=w, height=h)
pushViewport(sparklines.viewport)
if (!is.null(tile.pars)) grid.rect(gp=tile.pars)
sparklines(x[[i]], new=FALSE, lcol=lcol, yscale=yscales,
outer.margin=tile.margin,
outer.margin.pars = gpar(fill = tile.shading[i],
col=tile.shading[i]), xaxis = FALSE, yaxis = FALSE)
popViewport(1)
}
} # End of function
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.