################################################### ## Section 1: Introduction ################################################### # Data set up chess <- read.table("chessmod.txt", sep = ":", quote = "", col.names = c("player1", "player2", "result", "moves", "year", "place", "openingDetailed")) chess$result <- factor(ifelse(chess$result == "1-1", "draw", ifelse((chess$result == "1-0" & chess$player1 == "La Bourdonnais") | (chess$result == "0-1" & chess$player2 == "La Bourdonnais"), "win", "loss")), levels = c("win", "draw", "loss")) chess$opening <- reorder(factor(gsub("^... |, .+$", "", chess$openingDetailed)), chess$moves, FUN = median) chess$draw <- ifelse(chess$result == "draw", "draw", "result") chess.tab <- xtabs( ~ moves + result, chess) chess.tab.df <- as.data.frame(chess.tab) chess.tab.df$nmoves <- as.numeric(as.character(chess.tab.df$moves)) chess.df <- subset(chess.tab.df, Freq > 0) # Fiddle to force y-scale to include 0 chess.df <- rbind(chess.df, data.frame(moves = NA, result = "win", Freq = 0, nmoves = 1000)) # Import the pawn library("grImport") PostScriptTrace("chess_game_01.fromInkscape.eps") chessPicture <- readPicture("chess_game_01.fromInkscape.eps.xml") pawn <- chessPicture[205:206] grid.newpage() grid.picture(pawn) library("lattice") # Figure 1: xyplot # One tiny hidden fiddle to control y-axis labels xyplot(Freq ~ nmoves | result, data = chess.df, type = "h", layout = c(1, 3), xlim = c(0, 100), scales = list(y = list(at = seq(0, 6, 2)))) # Figure 2: xyplot plus chess pawns # Fiddle to force y-scale to include 0 xyplot(Freq ~ nmoves | result, data = chess.df, type = "h", layout = c(1, 3), xlim = c(0, 100), scales = list(y = list(at = seq(0, 6, 2))), panel = function(...) { panel.xyplot(...) grid.symbols(pawn, .05, .5, use.gc = FALSE, size = unit(.5, "npc"), gp = gpar(fill = switch(which.packet(), "white", "grey", "black"))) }) ################################################### ## Section 2.1: PostScript to XML ################################################### # Petal PostScriptTrace("petal.ps") petal <- readPicture("petal.ps.xml") grid.newpage() grid.picture(petal) # Flower PostScriptTrace("flower.ps") PSflower <- readPicture("flower.ps.xml") grid.newpage() grid.picture(PSflower) # Modified flower flowerRGML <- xmlParse("flower.ps.xml") xpathApply(flowerRGML, "//path//rgb", 'xmlAttrs<-', value = c(r = .3, g = .6, b = .8)) saveXML(flowerRGML, "blueflower.ps.xml") blueflower <- readPicture("blueflower.ps.xml") grid.picture(blueflower) ################################################### ## Section 2.2: XML to R ################################################### petal <- readPicture("petal.ps.xml") str(petal) PSflower <- readPicture("flower.ps.xml") str(PSflower@summary) # Subsetting flower picture petals <- PSflower[2:3] str(petals@summary) grid.newpage() grid.picture(petals) ################################################### ## Section 2.3: R to grid ################################################### petal@summary@xscale petal@summary@yscale # Figure 3: xyplot with flower data symbols library("cluster") trellis.device(width = 6, height = 4, color = FALSE) xyplot(V8 ~ V7, data = flower, xlab = "Height", ylab = "Distance Apart", panel = function(x, y, ...) { grid.symbols(PSflower, x, y, units = "native", size = unit(5, "mm")) }) dev.off() # Tiger PostScriptTrace("tiger.ps") tiger <- readPicture("tiger.ps.xml") grid.newpage() grid.picture(tiger[-1]) ################################################### ## Section 3.2: Text ################################################### # Hollow hello PostScriptTrace("hello.ps") hello <- readPicture("hello.ps.xml") grid.newpage() grid.picture(hello) # Filled hello grid.newpage() grid.picture(hello, fillText = TRUE) # Text hello PostScriptTrace("hello.ps", "hellotext.xml", charpath = FALSE) hellotext <- readPicture("hellotext.xml") grid.newpage() grid.picture(hellotext) ################################################### ## Section 3.4: Graphical parameters ################################################### # Flower outline grid.newpage() grid.picture(PSflower, use.gc = FALSE, gp = gpar(fill = NA, col = "black")) # Figure 5: xyplot with flower data symbols with white outlines trellis.device(width = 6, height = 4, color = FALSE) xyplot(V8 ~ V7, data = flower, xlab = "Height", ylab = "Distance Apart", panel=function(x, y, ...) { grid.symbols(PSflower, x, y, units = "native", size = unit(5, "mm"), use.gc = FALSE, gp = gpar(col = "white", fill = "black", lwd = .5)) }) dev.off() ################################################### ## Section 3.6: The Picture class ################################################### slotNames(petal) str(petal@paths[[1]]) str(hellotext@paths[[1]]) str(petal@summary) ################################################### ## Section 3.7: Picture objects to grid grobs ################################################### source("blueshade.R") source("blueify.R") # Blue tiger grid.newpage() grid.picture(tiger[-1], FUN = blueify) ################################################### ## Section 3.8: Complex paths ################################################### # GNU logo PostScriptTrace("GNU.ps") GNU <- readPicture("GNU.ps.xml") grid.newpage() grid.picture(GNU) # GNU logo paths grid.newpage() picturePaths(GNU, nr = 1, nc = 2, label = FALSE) # Exploded GNU paths brokenGNU <- explodePaths(GNU) grid.newpage() picturePaths(brokenGNU, nr = 3, nc = 5, label = FALSE, freeScales = TRUE) GNUlogo <- function() { xscale <- GNU@summary@xscale yscale <- GNU@summary@yscale grid.picture(brokenGNU[2], xscale = xscale, yscale = yscale) grid.picture(brokenGNU[11:14], use.gc = FALSE, gp = gpar(fill = "white"), xscale = xscale, yscale = yscale) grid.picture(brokenGNU[3:10], xscale = xscale, yscale = yscale) } # Fixed GNU grid.newpage() GNUlogo() ################################################### ## Section 4: Applications and examples ################################################### # Set up data cit <- c("1998"=4, "1999"=15, "2000"=17, "2001"=39, "2002"=119, "2003"=276, "2004"=523, "2005"=945, "2006"=1475, "2007"=2015) # Figure 6 trellis.device(height = 4, color = TRUE) barchart(~ cit, main = "Number of Citations per Year", xlab = "", panel = function(...) { GNUlogo() grid.rect(gp = gpar(fill = rgb(1, 1, 1, .9))) panel.barchart(...) }) dev.off() ################################################### ## Section 4.1: Scraping data from images ################################################### PostScriptTrace("page27.ps") page27 <- readPicture("page27.ps.xml") survivalPlot <- page27[c(3:16, 18, 27)] # Survival plot grid.newpage() pushViewport(viewport(gp = gpar(lex = .2))) grid.picture(survivalPlot) popViewport() # Scale calculations zeroY <- survivalPlot@paths[[9]]@y[1] zeroY unitY <- (survivalPlot@paths[[14]]@y[1] - zeroY)/100 unitY greenY <- (survivalPlot@paths[[15]]@y - zeroY)/unitY head(round(unname(greenY), 1), n = 20) # Comparison with original data library("survival") sfit <- survfit(Surv(time, status) ~ trt, data = veteran) originalGreenY <- sfit$surv[1:sfit$strata[1]] head(round(originalGreenY*100, 1), n = 9)