R Graphics for the Web
Paul Murrell
and Simon Potter
paul@stat.auckland.ac.nz
The University of Auckland
```{r echo=FALSE}
opts_chunk$set(tidy=FALSE, highlight=TRUE)
blue <- hcl(240, 80, 60)
thrublue <- adjustcolor(blue, alpha=.2)
```
R Graphics for the Web
======================
Problem Statement: *Generate an R plot for the Web*
```{r results="hide", message=FALSE}
library(lattice)
```
```{r results="hide"}
latticePlot <- xyplot(mpg ~ disp, mtcars, pch=21, cex=1.5,
main="Motor Trend Car Road Tests",
col=blue, fill=thrublue,
par.settings=list(background=list(col="grey90")))
```
PNG Graphics
============
```{r results="hide"}
png("plot.png")
print(latticePlot)
dev.off()
```
![PNG circle](plot.png)
PNG Graphics
============
<img src="plot.png"/>
Pros
: * You can produce **any** R plot
Cons
: * The graphic is **static**
* Raster graphics **do not scale**
SVG Graphics
============
```{r results="hide"}
svg("plot.svg")
print(latticePlot)
dev.off()
```
```{r echo=FALSE, results="hide"}
svg("plot.svg", width=7, height=7)
print(latticePlot)
dev.off()
```
![SVG plot](graphic.svg)
SVG Graphics
============
<img src="plot.svg"/>
Pros
: * You can produce **any** R plot
* Vector graphics **scale**
Cons
: * The graphic is **static**
* You are **limited to R graphics concepts**
gridSVG Graphics
================
```{r results="hide", message=FALSE}
library(gridSVG)
```
```{r results="hide"}
gridsvg("gridsvg-plot.svg", prefix="gridsvg-")
print(latticePlot)
dev.off()
```
```{r echo=FALSE, results="asis"}
library(XML)
cat(saveXML(xmlParse("gridsvg-plot.svg")))
```
gridSVG Graphics
================
<img src="gridsvg-plot.svg"/>
Cons
: * You can only produce **graphics based on grid**
Pros
: * Vector graphics **scale**
* You have access to **SVG concepts**
R Graphics
==========
```{r eval=FALSE, echo=FALSE, results="hide", warning=FALSE, message=FALSE}
# No longer used
svg("r-graphics.svg")
library(gridGraphviz)
nodes <- c("ggplot2", "lattice", "grid", "graphics", "grDevices",
"gridSVG", "PNG", "SVG")
gnel <- new("graphNEL",
nodes=nodes,
edgeL=list(ggplot2=list(edges="grid"),
lattice=list(edges="grid"),
grid=list(edges=c("grDevices", "gridSVG")),
graphics=list(edges="grDevices"),
grDevices=list(edges=c("PNG", "SVG")),
gridSVG=list(edges="SVG"),
PNG=list(),
SVG=list()),
edgemode="directed")
shapes <- rep(c("circle", "box"), c(6, 2))
names(shapes) <- nodes
colours <- rep(c("black", "white"), c(6, 2))
names(colours) <- nodes
fills <- rep(c("grey", "black"), c(6, 2))
names(fills) <- nodes
arrows <- rep("normal", 8)
names(arrows) <- edgeNames(gnel)
rag <- agopen(gnel, "",
attrs=list(graph=list(fixedsize="false")),
nodeAttrs=list(shape=shapes, fontcolor=colours, fillcolor=fills),
edgeAttrs=list(arrowhead=arrows))
grid.newpage()
grid.graph(rag)
dev.off()
```
![R Graphics](Rgraphics.svg)
gridSVG: Only grid-based output
================
```{r results="hide"}
png("graphics.png")
plot(mpg ~ disp, mtcars)
dev.off()
```
```{r echo=FALSE, results="hide"}
png("graphics.png")
plot(mpg ~ disp, mtcars, pch=16)
grid.rect(gp=gpar(fill=NA))
dev.off()
```
![PNG circle](graphics.png)
gridSVG: Only grid-based output
================
```{r results="hide", warning=FALSE}
gridsvg("graphics.svg")
plot(mpg ~ disp, mtcars)
dev.off()
```
```{r echo=FALSE, results="hide"}
gridsvg("base.svg", prefix="base-")
grid.rect()
plot(mpg ~ disp, mtcars)
dev.off()
```
```{r echo=FALSE, results="asis"}
cat(saveXML(xmlParse("base.svg")))
```
gridSVG: The grid Display List
=======
```{r results="hide"}
gridsvg("gridsvg-plot.svg", prefix="gridsvg-")
print(latticePlot)
dev.off()
```
gridSVG: The grid Display List
=======
A grid-based plot ...
```{r fig.keep="none", comment=NA}
print(latticePlot)
grid.ls()
```
gridSVG: The grid Display List
=======
```{r results="hide"}
gridsvg("grid-edit.svg", prefix="grid-edit-")
print(latticePlot)
grid.edit("lab", grep=TRUE, global=TRUE, gp=gpar(col="grey60"))
grid.remove("top|right", grep=TRUE, global=TRUE)
dev.off()
```
```{r echo=FALSE, results="asis"}
library(XML)
cat(saveXML(xmlParse("grid-edit.svg")))
```
gridSVG Graphics
================
<img src="gridsvg-plot.svg"/>
Cons
: * You can only produce **graphics based on grid**
Pros
: * Vector graphics **scale**
* You have access to **SVG concepts**
R Graphics
==========
![R Graphics](Rgraphics.svg)
SVG concepts: Tooltips
================
```{r results="hide"}
gridsvg("tooltip.svg", prefix="tooltip-")
print(latticePlot)
grid.garnish("points", grep=TRUE, group=FALSE,
title=paste("x =", mtcars$disp, " y =", mtcars$mpg))
dev.off()
```
```{r echo=FALSE, results="asis"}
library(XML)
cat(saveXML(xmlParse("tooltip.svg")))
```
SVG concepts: Hyperlinks
========
```{r results="hide"}
gridsvg("hyperlink.svg", prefix="hyperlink-")
print(latticePlot)
grid.hyperlink("plot_01.main", href="mtcars.html")
dev.off()
```
```{r echo=FALSE, results="asis"}
cat(saveXML(xmlParse("hyperlink.svg")))
```
SVG concepts: Hyperlinks
========
SVG concepts: Hyperlinks
========
SVG concepts: Animation
========
```{r eval=FALSE}
gridsvg("animate.svg", prefix="animate-")
print(latticePlot)
grid.animate("plot_01.xyplot.points.panel.1.1", group=FALSE,
"stroke-opacity"=0:1,
"fill-opacity"=c(0, .2),
duration=mtcars$mpg)
dev.off()
```
```{r echo=FALSE}
# Slightly more complex variation that works a bit better
# but the code looks worse
gridsvg("animate.svg", prefix="animate-")
print(latticePlot)
grid.animate("plot_01.xyplot.points.panel.1.1",
group=FALSE,
"stroke-opacity"=0:1,
"fill-opacity"=c(0, .2),
duration=1 + (mtcars$mpg - min(mtcars$mpg))/5)
dev.off()
```
```{r echo=FALSE, results="asis"}
cat(saveXML(xmlParse("animate.svg")))
```
SVG concepts: Animation
============
```{r echo=FALSE, results="asis"}
cat(saveXML(xmlParse("gapminderMultiPanel.svg")))
```
SVG concepts: Gradient Fills
========
```{r results="hide"}
gridsvg("gradient-demo.svg", prefix="gradient-demo-")
grid.circle(r=.4, name="circ")
gradient <- radialGradient(c("white", "blue", "black"), fx=.3, fy=.7)
grid.gradientFill("circ", gradient)
dev.off()
```
```{r echo=FALSE, results="asis"}
cat(saveXML(xmlParse("gradient-demo.svg")))
```
SVG concepts: Gradient Fills
========
```{r results="hide"}
gridsvg("gradient.svg", prefix="gradient-")
print(latticePlot)
registerGradientFill("specular", gradient)
grid.gradientFill("points", grep=TRUE, group=FALSE,
label=rep("specular", nrow(mtcars)))
dev.off()
```
```{r echo=FALSE, results="asis"}
cat(saveXML(xmlParse("gradient.svg")))
```
SVG concepts: Gradient Fills
========
SVG concepts: Gradient Fills
========
SVG concepts: Pattern Fills
========
```{r results="hide"}
gridsvg("pattern-demo.svg", prefix="pattern-demo-")
grid.circle(r=.4, gp=gpar(fill="grey"))
dev.off()
```
```{r echo=FALSE, results="asis"}
cat(saveXML(xmlParse("pattern-demo.svg")))
```
SVG concepts: Pattern Fills
========
```{r results="hide"}
barplot <- barchart(table(mtcars$gear),
par.settings=list(background=list(col="grey90")))
```
```{r echo=FALSE}
gridsvg("barchart.svg", prefix="barchart-")
print(barplot)
dev.off()
```
```{r echo=FALSE, results="asis"}
cat(saveXML(xmlParse("barchart.svg")))
```
SVG concepts: Pattern Fills
========
```{r results="hide"}
gridsvg("pattern.svg", prefix="pattern-")
print(barplot)
pattern <- pattern(circleGrob(r=.4, gp=gpar(fill="grey")),
width=.05, height=.05)
registerPatternFill("circles", pattern)
grid.patternFill("rect", grep=TRUE, group=FALSE,
label=rep("circles", 3))
dev.off()
```
```{r echo=FALSE, results="asis"}
cat(saveXML(xmlParse("pattern.svg")))
```
SVG concepts: Pattern Fills
========
SVG concepts: Filters
========
```{r results="hide"}
gridsvg("filter.svg", prefix="filter-")
print(latticePlot)
blur <- filterEffect(feGaussianBlur(sd=1))
grid.filter("main|lab|tick|border", grep=TRUE, global=TRUE, blur)
dev.off()
```
```{r echo=FALSE, results="asis"}
cat(saveXML(xmlParse("filter.svg")))
```
SVG concepts: Filters
========
SVG concepts: Clipping Paths
============
```{r echo=FALSE}
set.seed(1)
```
```{r results="hide"}
circles <- circleGrob(r=c(.45, .2),
gp=gpar(col=NA, fill=c("grey", "white")))
```
```{r echo=FALSE}
gridsvg("circles.svg", prefix="circles-")
grid.draw(circles)
dev.off()
```
```{r echo=FALSE, results="asis"}
cat(saveXML(xmlParse("circles.svg")))
```
SVG concepts: Clipping Paths
============
```{r results="hide"}
gridsvg("plot-clip.svg", prefix="clip-")
cp <- clipPath(circles)
pushClipPath(cp)
print(latticePlot, newpage=FALSE)
dev.off()
```
```{r echo=FALSE, results="asis"}
cat(saveXML(xmlParse("plot-clip.svg")))
```
SVG concepts: Clipping Paths
============
SVG concepts: Clipping Paths
============
SVG concepts: Clipping Paths
============
SVG concepts: Masks
============
```{r echo=FALSE, results="asis"}
cat(saveXML(xmlParse("circles.svg")))
```
SVG concepts: Masks
============
```{r results="hide"}
gridsvg("plot-masked.svg", prefix="clip-")
mask <- mask(circles)
pushMask(mask)
print(latticePlot, newpage=FALSE)
dev.off()
```
```{r echo=FALSE, results="asis"}
cat(saveXML(xmlParse("plot-masked.svg")))
```
SVG concepts: Masks
============
SVG concepts: Masks
============
SVG concepts: Masks
============
SVG concepts: Masks
============
SVG concepts: Javascript
============
```{r results="hide"}
gridsvg("plot-js.svg", prefix="js-")
print(latticePlot, newpage=FALSE)
grid.garnish("points", grep=TRUE, group=FALSE,
onclick=paste("alert('x =", mtcars$disp,
"y =", mtcars$mpg, "')"))
dev.off()
```
```{r echo=FALSE, results="asis"}
cat(saveXML(xmlParse("plot-js.svg")))
```
SVG concepts: Javascript
============
SVG concepts: Javascript
============
SVG concepts: Javascript
============
Playing
=======
```{r results="hide"}
gridsvg("leaf.svg", prefix="leaf-")
library(grImport)
leaf <- readPicture("fall12.xml")
grid.picture(leaf)
dev.off()
```
```{r echo=FALSE, results="asis"}
cat(saveXML(xmlParse("leaf.svg")))
```
Playing
=======
Playing
=======
Playing
=======
```{r eval=FALSE, echo=FALSE, results="hide"}
outline <- leaf[1]@paths[[1]]
exp <- .05
range <- range(leaf@summary@xscale, leaf@summary@yscale)
xrange <- range + exp*c(-1, 1)*diff(range)
yrange <- xrange
leafvp <- viewport(xscale=xrange, yscale=yrange, name="lvp")
leafGrob <- function(name="leaf", ...) {
pathGrob(x=outline@x, y=outline@y, default="native",
vp=leafvp, name=name, ...)
}
drawLeaf <- function(...) {
grid.draw(leafGrob(...))
}
veinsGrob <- function(name="veins", ...) {
pictureGrob(leaf[-1], exp=0,
xscale=xrange, yscale=yrange,
name=name)
}
drawVeins <- function(...) {
grid.draw(veinsGrob(...))
}
blurAlpha <- feGaussianBlur(input="SourceAlpha",
sd=5, result="blur")
offset <- feOffset(input="blur",
unit(3, "mm"), unit(-3, "mm"))
drop <- filterEffect(list(blurAlpha, offset))
fill <- linearGradient(c("black", "red", "yellow"))
leaf1 <- gradientFillGrob(leafGrob("leaf-1"), fill)
fill2 <- radialGradient(c(rgb(1,0,0,.2), rgb(1,1,0,.4)),
stops=c(0, .7))
pg <- polygonGrob(c(.7, 0, 0, 1, 1),
c(0, .7, 1, 1, 0))
cp <- clipPath(pg)
leaf2 <- clipPathGrob(gradientFillGrob(leafGrob("leaf-2"), fill2), cp)
blur <- filterEffect(feGaussianBlur(sd=1))
veins <- filterGrob(veinsGrob("veins"), blur)
leafTreeChildren <- gList(leaf1, leaf2, veins)
emboss <- filterEffect(list(feConvolveMatrix(kernelMatrix=
rbind(c(1,0,0),
c(0,1,0),
c(0,0,-1)))))
leafTree <- filterGrob(gTree(children=leafTreeChildren), emboss)
shadow <- filterGrob(gradientFillGrob(leafGrob("leaf-shadow"), fill), drop)
leafPattern <- pattern(gTree(children=gList(shadow, leafTree)),
width=.05, height=.05)
registerPatternFill("leaf", leafPattern)
gridsvg("barchart-silly.svg", prefix="silly-")
print(barplot)
grid.patternFill("rect", grep=TRUE, group=FALSE,
label=rep("leaf", 3))
dev.off()
```
```{r eval=FALSE}
gridsvg("barchart-silly.svg", prefix="silly-")
print(barplot)
grid.patternFill("rect", grep=TRUE, group=FALSE,
label=rep("leaf", 3))
dev.off()
```
```{r echo=FALSE, results="asis"}
cat(saveXML(xmlParse("barchart-silly.svg")))
```
Summary
=======
* Web publishing (HTML) is hot
* SVG is cool
* gridSVG shows potential
* bringing SVG goodness to R
* bringing R goodness to SVG
Acknowledgements
================
* Many of the new features in 'gridSVG' were implemented by Simon Potter
as part of his Masters Thesis
* The hyperlinked scatterplot example was from Yale's
Environmental Performance Index
* The "Price Kaleidoscope" and "linked map" examples were
produced by David Banks as part of his BSc Honours Project
* The 'lattice' plot with checkboxes and tooltips was
produced by David Banks as part of his Masters Project
* The
leaf image
was created by
OpenClipArt
user
Aungkarn
Sugcharoun