The SVGAnnotation package is an approach to using the cairo-based SVG graphics device in R and then post-processing the results to add tooltips, hyperlinks, animation and other SVG effects. Here are some simple-minded examples.
svg("pairs_link.svg", 14, 10) pairs(mtcars[,1:3], cex = 2) dev.off() doc = xmlParse("pairs_link.svg") linkPlots(doc) saveXML(doc, "pairs_link.svg")
# Create the basic plot svg("axes_tips.svg") plot(mpg ~ wt, mtcars, main = "The title") text(median(mtcars$wt), median(mtcars$mpg), "the medians") dev.off() # Post process it doc = xmlParse("axes_tips.svg") addCSS(doc) # Add tooltips to the ax = getAxesLabelNodes(doc) tips = c("1974 Motor Trend US magazine fuel consumption data", "Weight in units of lb/1000", "Miles per US gallon") invisible(sapply(seq(along = ax), function(i) addToolTips(ax[[i]], tips[[i]]))) # tooltips for the points. The text is the name = value sequence for all the variables for that point. addToolTips(doc, apply(mtcars, 1, function(x) paste(names(mtcars), x, sep = " = ", collapse = ", ")), doc = doc) saveXML(doc, "axes_tips.svg")
In this example, we draw two density curves on the same plot. Then we put two checkboxes on the right of the plot. When one toggles either of these (by clickin on it), the corresponding series is made visible/invisible.
The code to do this is
x = rnorm(100) y = rnorm(200, 1, .5)
svg('densities.svg') plot(density(x), ylim = c(0, 1)) lines(density(y), col = "red") dev.off() radioShowHide("densities.svg")Of course, the real action is in both the function radioShowHide() in the SVGAnnotation package and the SVG GUI components. But the steps in radioShowHide() are quite straightforward manipulation of the existing SVG plot generated by R.
The code for creating this is:
eu = read.csv("~/Downloads/eurofxref-hist.csv", header = TRUE, na.strings = "N/A") eu$Date = as.POSIXct(strptime(eu$Date, "%Y-%m-%d")) # Discard currencies that are mostly missing eu = eu[ , sapply(eu, function(x) sum(is.na(x)))/nrow(eu)################################## # Draw the plot, using a log scale for exchange rate. svg("euSeries.svg") matplot(eu[,1], as.data.frame(lapply(eu[,-1], log)), type = "l", xlab = "Date", ylab = "log(exchange rate)", main = "European Exchange Rate") abline(h = 1, col = "gray") dev.off() radioShowHide("euSeries.svg", within = TRUE, labels = currency.names[ match(names(eu)[-1], names(currency.names))])We would like to be able to do much better. For example, we'd like that
The code is divided into two steps: arranging the data, and then creating and post-processing the SVG plot.
eu = read.csv("~/Downloads/eurofxref-hist.csv", header = TRUE, na.strings = "N/A") eu$Date = as.POSIXct(strptime(eu$Date, "%Y-%m-%d")) eu.sub = eu[as.POSIXlt(eu$Date)$year >= 105, c("Date", "GBP", "USD", "CAD", "CHF")] st = data.frame(Date = rep(eu.sub$Date, ncol(eu.sub) - 1), rate = unlist(eu.sub[-1]), currency = rep(names(eu.sub)[-1], each = nrow(eu.sub)))
# Create the plot, but don't print it. We'll do that next. plt = xyplot( log(rate) ~ as.POSIXlt(st$Date)$yday | as.POSIXlt(st$Date)$year, st , group = currency, auto.key = list(columns = length(unique(st$currency))), type = "l") svg('euSeries4.svg') print(plt) dev.off() # Now put in the JavaScript code, change the width of the viewBox, add checkboxes, etc. # But don't set the id's on the series within the panels. We'll do that ourselves. doc = radioShowHide("euSeries4.svg", within = NA, labels = levels(st$currency), save = FALSE, id.prefix = "", numPanels = length(unique(as.POSIXlt(st$Date)$year))) # Put the currency.names[ .... ] back tmp = o = getPlotRegionNodes(doc) # Just getting the plot regions includes the tick marks, etc. so # we have to be more specific isPlotRegion = sapply(o, function(x) xmlSize(x) == 4 && nrow(as(x[[1]], "SVGPath")) > 100) o = o[ isPlotRegion ] annotatePanel = function(i, o) { # for this plot region els = xmlChildren(o[[i]]) sapply(seq(along = els), function(k) { addAttributes(els[[k]], id = paste("panel", i, k, sep = "-")) newXMLNode("title", levels(st$currency)[k], parent = els[[k]]) }) TRUE } sapply( seq(along = o), annotatePanel, o) saveXML(doc, docName(doc))The post-processing step involves finding the plot region nodes for a lattice plot. Here we just check the length of the path to ignore regions which are just tick marks or the panel rectangle. After that we do essentially
The code to create and process the plot is
library(vcd) svg('ternaryplot.svg') ternaryplot( Hitters[,2:4], pch = as.character(Positions), col = colors[as.numeric(Positions)], main = "Baseball Hitters Data") dev.off() doc = xmlParse('ternaryplot.svg') pts = getNodeSet(doc, "//x:g[@clip-path='url(#clip1)']/x:g", "x") pts = pts[ sapply(pts, xmlSize) == 1 ] numberVars = sapply(Hitters, is, "numeric") Hitters[sapply(Hitters, is, "factor")] = sapply(Hitters[sapply(Hitters, is, "factor")], as.character) invisible( sapply(seq(along = pts), function(i) { els = Hitters[i, ] els[numberVars] = sapply(els[numberVars], formatC, 4) newXMLNode("title", paste(names(Hitters), els, sep = " = ", collapse = ", "), parent = pts[[i]]) })) # Under #clip plotRegion = getNodeSet(doc, "//x:g[@clip-path='url(#clip1)']", "x")[[1]] if(names(plotRegion)[1] == "g") titleNode = plotRegion[[1]] labelNodes = plotRegion[3:5] tips = c( putouts = "A play in which a batter or a baserunner is retired", assists = "A fielding and throwing of a baseball in such a way that enables a teammate to put out a runner", errors = "A defensive fielding or throwing misplay by a player when a play normally should have resulted in an out or prevented an advance by a base runner") urls = c(putouts = "http://www.thefreedictionary.com/putout", assists = "http://en.wikipedia.org/wiki/Assist_(baseball)", error = "http://www.thefreedictionary.com/error" ) sapply(seq(along = labelNodes), function(i) { #addToolTips(labelNodes[[i]], tips[i]) addLink(labelNodes[[i]], urls[i]) }) addLink(plotRegion[[1]], "http://bm2.genes.nig.ac.jp/RGM2/R_current/library/vcd/man/Hitters.html") # addCSS(doc) saveXML(doc, docName(doc))
How is this done? In the "obvious" way! We compute the curve for all combinations of α and β in the range we consider, discretized of course! We hide all but the first one. When the viewer moves the slider, we find the corresponding curve, make the current one invisible, and the new one visible. We have 900 curves in this display. It takes some time to load these, but then the interactive response is relatively rapid.
The R code is
alpha = seq(.01, by = 0.05, length = 30) beta = seq(.01, by = 0.05, length = 30) grid = expand.grid(alpha, beta) f = 'beta.svg' svg(f) plot(0, type = "n", xlim = c(0, 1), ylim = c(0, 1.5), xlab = "X", ylab = "density", main = "Density of beta distribution") apply(grid, 1, function(p) curve(dbeta(x, p[1], p[2]), 0, 1, n = 300, add = TRUE)) #curve(dbeta(x, .3, .7), 0, 1, add = TRUE) #curve(dbeta(x, .7, .3), 0, 1, add = TRUE, col = "red") dev.off() ####### # Now post-process. doc = xmlParse(f) box = getViewBox(doc) p = getPlotRegionNodes(doc)[[1]] grid = expand.grid(seq(along = alpha), seq(along = beta)) ids = paste("curve", grid[,1], grid[,2], sep = "-") invisible( sapply(seq(along = ids), function(i) addAttributes(p[[i]], .attrs = c(id = ids[i], visibility = "hidden")))) addAttributes(p[[1]], .attrs = c(visibility = "visible")) ########## svg = xmlRoot(doc) enlargeSVGViewBox(doc, y = 100, svg = svg) newXMLNode("g", attrs = c(id = "slider-alpha"), parent = svg) newXMLNode("g", attrs = c(id = "slider-beta"), parent = svg) newXMLNode("text", attrs = c(x = "20", y = box[2, 2], id = "statusText"), "", parent = svg) addAttributes(svg, onload = sprintf("init(evt, %d, %d);", length(alpha), length(beta))) addECMAScripts(doc, findJScripts(c("mapApp.js", "helper_functions.js", "slider.js", "betaSlider.js")), FALSE) addCSS(doc) defs = getNodeSet(doc, "//x:defs", "x")[[1]] newXMLNode("symbol", attrs = c(id = "sliderSymbol", overflow = "visible"), newXMLNode("line", attrs = c(x1 = "0", y1 = "-10", x2 = "0", y2 = "10", stroke = "dimgray", 'stroke-width' = "5", 'pointer-events' = "none")), parent = defs) saveXML(doc, docName(doc))The callbacks for the slider that determine which curves to make visible and invisible is in betaSlider.js. It is quite simple.
As you mouse over the nodes, the edges from that node to the other nodes are higlighted and the color of the other edges are changed to a light grey. When we move out of the node, we restore the original view.
Note that you have to put the mouse precisely on the pixels of a point, not just in a point.
This illustrates how we can dynamically construct SVG elements within the ECMA/JavaScript code rather than creating all possible lines first.
groups
parameter,
then different points in different panels do have a
correspondence, i.e. being part of the same group.
So we add interactive capabilities to the plot to allow the
viewer mouse over a lable in the key/legend of the plot.
This highlights the corresponding element in the panels.
In our first example, we have an xyplot with three panels
and four groups.
In our second example, we have a densityplot() with a single
panel and multiple groups. These data inllustrate the
distribution of the size of functions in elements of my search
path.
As the viewer mouses over the key/legend labels, the
corresponding density plot is highlighted by increasing its
stroke-width. We have also added a tooltip to indicate the
number of observations in the particular group.