### R code from vignette source 'gridsvg.Rnw' ################################################### ### code chunk number 1: gridsvg.Rnw:88-89 ################################################### options(prompt="R> ", continue="R+ ", useFancyQuotes=FALSE) ################################################### ### code chunk number 2: gridsvg.Rnw:261-262 ################################################### library("grid") ################################################### ### code chunk number 3: gridscene ################################################### topvp <- viewport(y=1, just="top", name="topvp", height=unit(1, "lines")) botvp <- viewport(y=0, just="bottom", name="botvp", height=unit(1, "npc") - unit(1, "lines")) grid.rect(gp=gpar(fill="grey"), vp=topvp, name="toprect") grid.rect(vp=botvp, name="botrect") ################################################### ### code chunk number 4: gridsvg.Rnw:287-288 ################################################### library("gridSVG") ################################################### ### code chunk number 5: gridsceneweb (eval = FALSE) ################################################### ## gridToSVG("gridscene.svg") ################################################### ### code chunk number 6: gridsvg.Rnw:295-297 ################################################### topvp <- viewport(y=1, just="top", name="topvp", height=unit(1, "lines")) botvp <- viewport(y=0, just="bottom", name="botvp", height=unit(1, "npc") - unit(1, "lines")) grid.rect(gp=gpar(fill="grey"), vp=topvp, name="toprect") grid.rect(vp=botvp, name="botrect") gridToSVG("gridscene.svg") ################################################### ### code chunk number 7: gridsvg.Rnw:331-333 ################################################### widthValues <- unit(c(1, 1), c("npc", "in")) widthValues ################################################### ### code chunk number 8: gridanimate (eval = FALSE) ################################################### ## grid.animate("toprect", width=widthValues, duration=3) ## grid.animate("botrect", width=widthValues, duration=3) ################################################### ### code chunk number 9: gridanimateweb (eval = FALSE) ################################################### ## gridToSVG("gridanim.svg") ################################################### ### code chunk number 10: gridsvg.Rnw:350-354 ################################################### grid.newpage() topvp <- viewport(y=1, just="top", name="topvp", height=unit(1, "lines")) botvp <- viewport(y=0, just="bottom", name="botvp", height=unit(1, "npc") - unit(1, "lines")) grid.rect(gp=gpar(fill="grey"), vp=topvp, name="toprect") grid.rect(vp=botvp, name="botrect") grid.animate("toprect", width=widthValues, duration=3) grid.animate("botrect", width=widthValues, duration=3) gridToSVG("gridanim.svg") ################################################### ### code chunk number 11: gridhyper (eval = FALSE) ################################################### ## grid.text("take me there", vp=topvp, name="hypertext") ## grid.hyperlink("hypertext", "http://www.r-project.org") ################################################### ### code chunk number 12: gridhyperweb (eval = FALSE) ################################################### ## gridToSVG("gridhyper.svg") ################################################### ### code chunk number 13: gridsvg.Rnw:392-396 ################################################### grid.newpage() topvp <- viewport(y=1, just="top", name="topvp", height=unit(1, "lines")) botvp <- viewport(y=0, just="bottom", name="botvp", height=unit(1, "npc") - unit(1, "lines")) grid.rect(gp=gpar(fill="grey"), vp=topvp, name="toprect") grid.rect(vp=botvp, name="botrect") grid.text("take me there", vp=topvp, name="hypertext") grid.hyperlink("hypertext", "http://www.r-project.org") gridToSVG("gridhyper.svg") ################################################### ### code chunk number 14: gridmouse (eval = FALSE) ################################################### ## grid.garnish("botrect", ## onmousedown="alert('ouch!')", ## "pointer-events"="all") ################################################### ### code chunk number 15: gridmouseweb (eval = FALSE) ################################################### ## gridToSVG("gridmouse.svg") ################################################### ### code chunk number 16: gridsvg.Rnw:431-436 ################################################### grid.newpage() topvp <- viewport(y=1, just="top", name="topvp", height=unit(1, "lines")) botvp <- viewport(y=0, just="bottom", name="botvp", height=unit(1, "npc") - unit(1, "lines")) grid.rect(gp=gpar(fill="grey"), vp=topvp, name="toprect") grid.rect(vp=botvp, name="botrect") grid.text("take me there", vp=topvp, name="hypertext") grid.hyperlink("hypertext", "http://www.r-project.org") grid.garnish("botrect", onmousedown="alert('ouch!')", "pointer-events"="all") gridToSVG("gridmouse.svg") ################################################### ### code chunk number 17: gridscript (eval = FALSE) ################################################### ## grid.garnish("toprect", ## onmousedown="allblack()", ## "pointer-events"="all") ## grid.script(" ## allblack = function() { ## rect = document.getElementById('toprect.1'); ## rect.setAttribute('style', 'fill:black'); ## }") ################################################### ### code chunk number 18: gridscriptweb (eval = FALSE) ################################################### ## gridToSVG("gridscript.svg") ################################################### ### code chunk number 19: gridsvg.Rnw:480-486 ################################################### grid.newpage() topvp <- viewport(y=1, just="top", name="topvp", height=unit(1, "lines")) botvp <- viewport(y=0, just="bottom", name="botvp", height=unit(1, "npc") - unit(1, "lines")) grid.rect(gp=gpar(fill="grey"), vp=topvp, name="toprect") grid.rect(vp=botvp, name="botrect") grid.text("take me there", vp=topvp, name="hypertext") grid.hyperlink("hypertext", "http://www.r-project.org") grid.garnish("botrect", onmousedown="alert('ouch!')", "pointer-events"="all") grid.garnish("toprect", onmousedown="allblack()", "pointer-events"="all") grid.script(" allblack = function() { rect = document.getElementById('toprect.1'); rect.setAttribute('style', 'fill:black'); }") gridToSVG("gridscript.svg") ################################################### ### code chunk number 20: gridsvg.Rnw:515-516 ################################################### library("lattice") ################################################### ### code chunk number 21: xyplot ################################################### xyplot(Sepal.Length ~ Sepal.Width | Species, iris) ################################################### ### code chunk number 22: latticehyperlink ################################################### grid.hyperlink("plot_01.textr.strip.1.1", "http://en.wikipedia.org/wiki/Iris_flower_data_set") grid.hyperlink("plot_01.textr.strip.1.2", "http://en.wikipedia.org/wiki/Iris_virginica") grid.hyperlink("plot_01.textr.strip.2.1", "http://en.wikipedia.org/wiki/Iris_versicolor") ################################################### ### code chunk number 23: lh ################################################### gridToSVG("latticehyper.svg") ################################################### ### code chunk number 24: latticehyper ################################################### xyplot(Sepal.Length ~ Sepal.Width | Species, iris) grid.hyperlink("plot_01.textr.strip.1.1", "http://en.wikipedia.org/wiki/Iris_flower_data_set") grid.hyperlink("plot_01.textr.strip.1.2", "http://en.wikipedia.org/wiki/Iris_virginica") grid.hyperlink("plot_01.textr.strip.2.1", "http://en.wikipedia.org/wiki/Iris_versicolor") gridToSVG("latticehyper.svg") ################################################### ### code chunk number 25: gridls (eval = FALSE) ################################################### ## grid.ls(viewports=TRUE, fullNames=TRUE, print=grobPathListing) ################################################### ### code chunk number 26: gridscenels ################################################### grid.newpage() topvp <- viewport(y=1, just="top", name="topvp", height=unit(1, "lines")) botvp <- viewport(y=0, just="bottom", name="botvp", height=unit(1, "npc") - unit(1, "lines")) grid.rect(gp=gpar(fill="grey"), vp=topvp, name="toprect") grid.rect(vp=botvp, name="botrect") grid.ls(viewports=TRUE, fullNames=TRUE, print=grobPathListing) ################################################### ### code chunk number 27: gridscenetosvg (eval = FALSE) ################################################### ## gridToSVG("gridscene.svg") ################################################### ### code chunk number 28: gridscenesvg ################################################### topvp <- viewport(y=1, just="top", name="topvp", height=unit(1, "lines")) botvp <- viewport(y=0, just="bottom", name="botvp", height=unit(1, "npc") - unit(1, "lines")) grid.rect(gp=gpar(fill="grey"), vp=topvp, name="toprect") grid.rect(vp=botvp, name="botrect") gridToSVG("gridscene.svg") ################################################### ### code chunk number 29: gridsvg.Rnw:616-617 ################################################### library("XML") ################################################### ### code chunk number 30: gridsvg.Rnw:620-630 ################################################### presentationAttributes <- c("stroke", "stroke-opacity", "fill", "fill-opacity", "opacity", "font-weight", "font-style", "font-family", "fonts-size", "stroke-dasharray", "stroke-width", "stroke-linecap", "stroke-linejoin", "stroke-miterlimit") removePresentation <- function(node) { removeAttributes(node, .attrs=presentationAttributes) } ################################################### ### code chunk number 31: gridsvg.Rnw:631-640 ################################################### gridscenesvg <- xmlParse("gridscene.svg") toprect <- getNodeSet(gridscenesvg, "//svg:rect[@id='toprect.1']", c(svg="http://www.w3.org/2000/svg"))[[1]] removePresentation(toprect) botrect <- getNodeSet(gridscenesvg, "//svg:rect[@id='botrect.1']", c(svg="http://www.w3.org/2000/svg"))[[1]] removePresentation(botrect) ################################################### ### code chunk number 32: textgrob ################################################### grid.text("take me there", name="sampleText") ################################################### ### code chunk number 33: textgrobsvg ################################################### grid.text("take me there", name="sampleText") gridToSVG("textgrob.svg") ################################################### ### code chunk number 34: gridsvg.Rnw:688-696 ################################################### textgrobsvg <- xmlParse("textgrob.svg") gsvg <- getNodeSet(textgrobsvg, "//svg:g[@id='sampleText.1']", c(svg="http://www.w3.org/2000/svg"))[[1]] textsvg <- getNodeSet(gsvg, "svg:g/svg:text", c(svg="http://www.w3.org/2000/svg"))[[1]] devnull <- removePresentation(textsvg) cat(saveXML(gsvg)) ################################################### ### code chunk number 35: pointsgrob ################################################### pushViewport(viewport()) grid.points(1:2/3, 1:2/3, pch=c(1, 10), name="symbols") ################################################### ### code chunk number 36: pointsgrobsvg ################################################### pushViewport(viewport()) grid.points(1:2/3, 1:2/3, pch=c(1, 10), name="symbols") gridToSVG("pointsgrob.svg") ################################################### ### code chunk number 37: gridsvg.Rnw:738-759 ################################################### pointsgrobsvg <- xmlParse("pointsgrob.svg") circlesvg <- getNodeSet(pointsgrobsvg, "//svg:circle[@id='symbols.1']", c(svg="http://www.w3.org/2000/svg"))[[1]] removePresentation(circlesvg) symbolsvg <- getNodeSet(pointsgrobsvg, "//svg:g[@id='symbols.2']", c(svg="http://www.w3.org/2000/svg"))[[1]] poly1svg <- getNodeSet(pointsgrobsvg, "//svg:polyline[@id='symbols.2.1']", c(svg="http://www.w3.org/2000/svg"))[[1]] devnull <- removePresentation(poly1svg) poly2svg <- getNodeSet(pointsgrobsvg, "//svg:polyline[@id='symbols.2.2']", c(svg="http://www.w3.org/2000/svg"))[[1]] devnull <- removePresentation(poly2svg) circle2svg <- getNodeSet(pointsgrobsvg, "//svg:circle[@id='symbols.2.3']", c(svg="http://www.w3.org/2000/svg"))[[1]] devnull <- removePresentation(circle2svg) cat(saveXML(symbolsvg)) ################################################### ### code chunk number 38: arrowgrobsrc ################################################### grid.segments(0, 0, 1, 1, arrow=arrow(), name="lineWithArrow") ################################################### ### code chunk number 39: arrowgrob ################################################### pushViewport(viewport(width=.8, height=.8)) grid.segments(0, 0, 1, 1, arrow=arrow(), name="lineWithArrow") ################################################### ### code chunk number 40: arrowgrobsvg ################################################### grid.segments(0, 0, 1, 1, arrow=arrow(), name="lineWithArrow") gridToSVG("arrowgrob.svg") ################################################### ### code chunk number 41: gridsvg.Rnw:786-812 ################################################### # Function to break a long line of SVG code # 'text' is the SVG text (possibly containing newlines) # 'element' gives the name of the element whose line we want to break # This is used to find the line to break # 'attribs' gives one or more attribute names that want to break on # 'anchor' gives the attribute name that the new lines should line up with breakLongLine <- function(text, element, attribs, anchor, perl=FALSE) { text <- strsplit(text, "\n")[[1]] line <- grep(element, text, perl=perl) for (l in line) { newline <- text[l] indent <- regexpr(anchor, newline, perl=perl) for (i in attribs) { # Wrap attrib names in parentheses so can use \\1 in replacement text # This allows regular expression in attrib name newline <- gsub(paste("(", i, ")", sep=""), paste("\n", paste(rep(" ", indent - 1), collapse=""), "\\1", sep=""), newline, perl=perl) } text[l] <- newline } paste(text, collapse="\n") } ################################################### ### code chunk number 42: gridsvg.Rnw:815-829 ################################################### arrowgrobsvg <- xmlParse("arrowgrob.svg") markersvg <- getNodeSet(arrowgrobsvg, "//svg:defs", c(svg="http://www.w3.org/2000/svg"))[[1]] devnull <- removeChildren(markersvg, kids=list(1)) markerpathsvg <- getNodeSet(markersvg, "//svg:path", c(svg="http://www.w3.org/2000/svg"))[[1]] devnull <- removePresentation(markerpathsvg) polylinesvg <- getNodeSet(arrowgrobsvg, "//svg:polyline", c(svg="http://www.w3.org/2000/svg"))[[1]] devnull <- removePresentation(polylinesvg) cat(breakLongLine(saveXML(markersvg), " element the only child of the gridsvg element devnull <- removeChildren(gridsvg, kids=xmlChildren(gridsvg)) devnull <- addChildren(gridsvg, kids=list(toprect)) cat(gsub(", ", ",", gsub("", "\n", gsub("( + 0) lapply(children, removeStyle) invisible() } invisible(lapply(xmlChildren(gridscenesvg), removeStyle)) cat(breakLongLine(saveXML(gridscenesvg), " 0) lapply(children, removeStyle) } invisible() } invisible(lapply(xmlChildren(gridinteractsvg), removeStyle)) cat(breakLongLine(saveXML(gridinteractsvg), " 0) lapply(children, removeStyle) invisible() } invisible(lapply(xmlChildren(gridscenesvg), removeStyle)) cat(breakLongLine(breakLongLine(saveXML(gridscenesvg), " below panel-3-3) # BEFORE we replace that with the one from fancyWide.svg! panelBg <- getNodeSet(normalPlotSVG, ".//svg:rect", c(svg="http://www.w3.org/2000/svg"))[[1]] # Do same thing for x-axis normalAxisSVG <- getNodeSet(normalSVG, "//svg:g[@id='axis_h-5-3.1']", c(svg="http://www.w3.org/2000/svg"))[[1]] wideAxisSVG <- getNodeSet(wideSVG, "//svg:g[@id='axis_h-5-3.1']/svg:g[@id='axis_h-5-3']", c(svg="http://www.w3.org/2000/svg"))[[1]] removeChildren(normalAxisSVG, "g") addChildren(normalAxisSVG, wideAxisSVG) # Set a clip region for the x-axis on the top plot axisClipRectAttrs <- xmlAttrs(panelBg)[c("x", "y", "width", "height")] axisClipRectAttrs["height"] <- axisClipRectAttrs["y"] axisClipRectAttrs["y"] <- 0 addChildren(normalAxisSVG, newXMLNode("clipPath", newXMLNode("rect", attrs=axisClipRectAttrs), attrs=c(id="axis_h-5-3.1-clip"))) addAttributes(normalAxisSVG, "clip-path"="url(#axis_h-5-3.1-clip)") ################################################### ### code chunk number 141: gridsvg.Rnw:2542-2545 ################################################### removeChildren(normalPlotSVG, "g") addChildren(normalPlotSVG, widePlotSVG) saveXML(normalSVG, file="customplot.svg") ################################################### ### code chunk number 142: gridsvg.Rnw:2548-2551 ################################################### system("inkscape --export-png=normalplotsvg.png --export-dpi=300 normalplot.svg") system("inkscape --export-png=wideplotsvg.png --export-dpi=300 wideplot.svg") system("inkscape --export-png=customplotsvg.png --export-dpi=300 customplot.svg")