Chapter 15: Graphs in R
Packages required: “DAAG”, “latticeExtra”, “grid”

The script that follows is designed to be executed as it stands. It sets up
functions that create Ch 15 graphs, then runs those functions. If executed by
clicking on the RStudio “Compile Notebook …” command, it will be processed
through R Markdown, generating a document that includes code, output and
graphs generated by executing the functions. If some needed packages are
missing, warning messages will appear. See further:
http://rmarkdown.rstudio.com/r_notebook_format.html

g15.1 <-
function(device="",new=F, ycol = -2.1-(0:9)*2.1){
    if(device!="")hardcopy(width=5.4, height=4.25,
                           device=device)
    else if(new)x11(width=6.0, height=9)
    ftype <- c("plain","bold","italic","bold italic","symbol")
    yline <- 4.2
    ypmax <- 20
    farleft <- -6
    oldpar <- par(mar=c(0,0,0.5,0))     
    on.exit(par(oldpar))
    plot(c(-8,31), c(3.5, ypmax), type="n", xlab="", ylab="", axes=F)
    chh <- par()$cxy[2]
    text(0:25, rep(ypmax+0.8*chh,26), paste(0:25), srt=90, cex=0.75, xpd=T)
    text(-1.5, ypmax+0.8*chh, "pch =", cex=0.75, xpd=T)
    points(0:25, rep(ypmax,26), pch=0:25)
    letterfont <- function(ypos=ypmax, font=2){
      par(font=font)
      text(-1.35, ypos, "64-76", cex=0.75, adj=1, xpd=TRUE)
      text(19-1.35, ypos, "96-108", cex=0.75, adj=1)
      points(c(0:12), rep(ypos,13), pch=64:76)
      points(19:31, rep(ypos,13), pch=96:108)
      text(farleft, ypos, paste(font),
           xpd=T)
      text(farleft, ypos-0.5, ftype[font], cex=0.75)
    }
    plotfont <- function(xpos=0:31, ypos=ypmax, font=1, sel32=2:4,
                         showfont=TRUE){
      par(font=font)
      i <- 0
      for (j in sel32){
        i <- i+1
        text(-1.35, ypos-i+1, paste((j-1)*32,"-", j*32-1, sep=""), 
             cex=0.75, adj=1, xpd=TRUE)
        points(xpos, rep(ypos-i+1,32), pch=(j-1)*32+(0:31))

      }
      lines(rep(-1.05,2),c(ypos-length(sel32)+1, ypos)+c(-.4, .4),
            xpd=T, col="grey40")
      if(showfont){
        text(farleft, ypos, paste("font =", font), xpd=T)
        text(farleft, ypos-0.5, ftype[font], cex=0.75, xpd=T)
      }
    }
    plotfont(ypos=ypmax-1.5, font=1, sel32=2:4)
    for(j in 2:4)letterfont(ypos=ypmax-2.1-1.4*j, font=j)
    plotfont(ypos=ypmax-9.1, font=5, sel32=3)
    plotfont(xpos=c(-0.5,1:31), ypos=ypmax-10.1, font=5, sel32=4,
             showfont=FALSE)
    par(font=1)
    ltypes <- c("blank","solid","dashed","dotted","dotdash",
                "longdash","twodash")
    lcode <- c("","","44","13","1343","73","2262")
    for(i in 0:6){lines(c(4,31), c(yline+4.5-0.8*i,yline+4.5-0.8*i),
                        lty=i, lwd=2, xpd=T)
                  if(i==0)numchar <- paste("lty =", i) else numchar <- i
                  text(farleft, yline+4.5-0.8*i, numchar, xpd=TRUE)
                  text(farleft+3.5, yline+4.5-0.8*i, ltypes[i+1], cex=0.85,
                       xpd=TRUE)
                  text(farleft+6.5, yline+4.5-0.8*i, lcode[i+1], cex=0.85,
                       xpd=TRUE)
                }
    if(device!="")dev.off()
  }

g15.2 <-
function(device="", col="gray70"){
    if (device != "")                                      
      hardcopy(width = 5.25, height = 1.25, pointsize=c(7,4), device = device)
    oldpar <- par(mar=c(4.6,4.6,1.1,1.1))
    on.exit(par(oldpar))
 seps <- c(-12.5, -10.523, -8.523, -6.85, -6.6, -3.523, -1, 1, 2.5)
 plot(range(10^seps), c(0, 1), axes=FALSE, xlab="Wavelength (m)",
      ylab="", type="n", xaxs="i", yaxs="i", log="x")
 log10ticks <- pretty(seps,6)
 log10ticks <- log10ticks[log10ticks > seps[1]]
 ticklabs <- lapply(round(log10ticks,2), 
                    function(x)substitute(10^a, list(a=x)))
 axis(1, at=10^log10ticks, labels=as.expression(ticklabs))
 ## Use rect() to divide the axis a/c to types of radiation
 len <- length(seps)
 rect(xleft=10^seps[-len], ybottom=rep(0, len-1),   
      xright=10^seps[-1], ytop=rep(1, len-1),
      border=c(NA, rep(1,len-3), NA),
      col=c(rep(col,3), "white", rep("gray70",4)))
 radtypes <- c("gamma ray","X-ray","ultraviolet", "visible",
               "infra-red", "microwave", "radio, TV", "long-wave")
 mid <- 0.5*(seps[-1]+seps[-len])
 text(10^mid, rep(0.08, len), radtypes, adj=c(0,0.5), srt=90)    
    if(device!="")dev.off()
  }

g15.3 <-
function(device=""){
    if(!require(lattice))return("Package 'lattice' must be installed.")  
    if(!require(DAAG))return("Package 'DAAG' must be installed.")        
    if (device != "")                                      
      hardcopy(width = 4, height = 2.5, pointsize=c(7,5),
               trellis=TRUE, color=FALSE, device = device)
    grogplot <- xyplot(Beer+Spirit+Wine ~ Year | Country, data=grog,
                       outer=FALSE, auto.key=list(columns=3))
    ## Enhance, and print enhanced code
    print(update(grogplot, ylim=c(0,5.5), aspect=1,
                 scales=list(tck=0.5),
           xlab="", ylab="Amount consumed (per person)",
           par.settings=simpleTheme(pch=c(1,3,4))))
    if(device!="")dev.off()
  }

g15.4 <-
function(width=3.75, height=2.5, pointsize=c(7,5), device=""){
    if(!require(lattice))return("Package 'lattice' must be installed.")  
    if(!require(grid))return("Package 'grid' must be installed.")      
    if(device!="") hardcopy(width=width, height=height, trellis=TRUE,
                            color=FALSE, pointsize=pointsize, device=device)
        if(!require(DAAG))return("Package 'DAAG' must be installed.")  
    trellis.par.set(simpleTheme(pch = c(1:3), lty=1:3, lwd=1.5,
                                col.line=c("gray40","black","black"))) 
    aisBS <- subset(ais, sport %in% c("B_Ball", "Swim", "Tennis"))
    aisBS$sport <- factor(aisBS$sport)
    gph2 <- xyplot(hc ~ rcc | sex, groups=sport, data=aisBS,
                   type=c("p","r"), aspect=1,
                   xlab=expression("Red cell count (10"^{12}*"."*L^{-1}*")"),
                   layout=c(2,1),
                   ylab="Blood cell to plasma ratio (%)",
                   auto.key=list(columns=3, lines=TRUE),
                   scale=list(tck=0.5))
    print(gph2)
    if(device!="")dev.off()
  }

g15.5 <-
function(device="",width=5.25, height=2){
    if(device!="")hardcopy(width=width, height=height, 
                           color=FALSE, device=device)
    if(!require(DAAG))return("Package 'DAAG' must be installed.")  
    if(!require(ggplot2))return("Package 'ggplot2' must be installed.")      
    theme_set(theme_gray(base_size=8)) # Gray theme
    update_geom_defaults("point", aes(cex=1.5))
    print(quickplot(Year, seRain, data=bomregions, geom=c("point","smooth"),
              colour=I("gray40"), span=0.1,
              xlab="", ylab="Av. rainfall, M-D basin"))
    if(device!="")dev.off()
  }

g15.6 <-
function(device="",width=4.4, height=2.25){
        if(device!="")hardcopy(width=width, height=height, 
                               color=FALSE, device=device)
        if(!require(DAAG))return("Package 'DAAG' must be installed.")  
        if(!require(ggplot2))return("Package 'ggplot2' must be installed.")     
        old <- theme_set(theme_bw(base_size=8)) # Gray theme
#        update_geom_defaults("point", aes(size=1.3, shape=2))
#        update_geom_defaults("density2d", aes(size=0.8, colour="gray"))
        gg <- quickplot(wt, ht, xlab="Weight (kg)", ylab="Height (cm)", data=ais,
                        facets = . ~ sex) +
          geom_boxplot(outlier.size=1.75, outlier.colour="gray", color="gray") +
          geom_point(shape=2, size=1) +
          geom_density2d(color="gray")         
        print(gg)
        theme_set(old)
        if(device!="")dev.off()
    }

pkgs <- c("DAAG", "latticeExtra", "grid")
z <- sapply(pkgs, require, character.only=TRUE, warn.conflicts=FALSE, quietly=TRUE)
if(any(!z)){
  notAvail <- paste(names(z)[!z], collapse=", ")
  warning(paste("The following packages should be installed:", notAvail))
} 

g15.1()
## Warning: font width unknown for character 0x7f
## Warning: font metrics unknown for character 0x7f
## Warning: font width unknown for character 0x7f
## Warning: font metrics unknown for character 0x7f

plot of chunk unnamed-chunk-1

g15.2()

plot of chunk unnamed-chunk-2

g15.3()

plot of chunk unnamed-chunk-3

g15.4()

plot of chunk unnamed-chunk-4

g15.5()
## Loading required package: ggplot2
## 
## Attaching package: 'ggplot2'
## 
## The following object is masked from 'package:latticeExtra':
## 
##     layer
## 
## geom_smooth: method="auto" and size of largest group is <1000, so using loess. Use 'method = x' to change the smoothing method.

plot of chunk unnamed-chunk-5

g15.6()

plot of chunk unnamed-chunk-6