graphics.off() df <- data.frame(time=as.numeric(time(Nile)), flow=as.numeric(Nile)) library(ggplot2) library(gridSVG) library(XML) thePlot <- ggplot(df, aes(x=time, y=flow)) + geom_line() # The basic plot layout doplot <- function() { grid.newpage() pushViewport(viewport(layout=grid.layout(2, 1, heights=c(4, 1)))) pushViewport(viewport(layout.pos.row=1, name="topvp")) print(thePlot, newpage=FALSE) upViewport() pushViewport(viewport(layout.pos.row=2, name="bottomvp")) print(thePlot, newpage=FALSE) upViewport() } # Scale factor: W/w # The *plotRegion* in the top plot is this factor times the # plotRegion in the bottom plot scale <- 4 # SVG version plotWidth <- 7 pdf("fancy.pdf", width=plotWidth, height=plotWidth) doplot() # Determine the width of the margins in the main plot # Does not matter which "panel-3-3" I get because they are both the same downViewport("panel-3-3") plotRegionWidth <- convertWidth(unit(1, "npc"), "inches", valueOnly=TRUE) marginWidth <- plotWidth - plotRegionWidth # Add semitrasparent "thumb" rect # Need to get the right "panel-3-3" this time upViewport(0) downViewport("bottomvp") downViewport("panel-3-3") rg <- rectGrob(x=0, width=1/scale, just="left", gp=gpar(col=rgb(0,0,1,.5), fill=rgb(0,0,1,.2)), name="thumb") # Thumb ONLY captures mouseDown events # MouseUp and mouseMove events are capture anywhere on the image # (see below) thumb <- garnishGrob(rg, onmousedown="thumbDown(evt)") # MouseUp and mouseMove events are also captured anywhere on the image grid.set("plot.background.rect", garnishGrob(grid.get("plot.background.rect", grep=TRUE), onmouseup="mUp(evt)", onmousemove=paste("mMove(evt, ", scale, ")", sep="")), grep=TRUE) grid.draw(thumb) grid.script(filename="fancy.js") gridToSVG("fancy.svg") dev.off() # Wide version pdf("fancyWide.pdf", width=plotRegionWidth*scale + marginWidth) doplot() gridToSVG("fancyWide.svg") dev.off() # Read in both SVG files, extract the top plot region from # the wide version and use that to replace the plot region # in the main version normalSVG <- xmlParse("fancy.svg") wideSVG <- xmlParse("fancyWide.svg") normalPlotSVG <- getNodeSet(normalSVG, "//svg:g[@id='panel-3-3.1']", c(svg="http://www.w3.org/2000/svg"))[[1]] widePlotSVG <- getNodeSet(wideSVG, "//svg:g[@id='panel-3-3.1']/svg:g[@id='panel-3-3']", c(svg="http://www.w3.org/2000/svg"))[[1]] # To set clip attribute for axis viewport, # need the x, y, width, height from background rect for panel-3-3 # (which is first 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]] # Replace panel-3-3 in original plot with wide version removeChildren(normalPlotSVG, "g") addChildren(normalPlotSVG, widePlotSVG) # 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)") # Set event handling for entire image addAttributes(getNodeSet(normalSVG, "/svg:svg", c(svg="http://www.w3.org/2000/svg"))[[1]], onmouseup="mUp(evt)", onmousemove=paste("mMove(evt, ", scale, ")", sep="")) saveXML(normalSVG, file="fancyModified.svg")