`g12.10` <-
function(device="", cv1=tissue.mfB.cv, cv2=rtissue.mfB.cv,
           badcv1=tissue.mfB.badcv, badcv2=rtissue.mfB.badcv, nseq=NULL){
    if(device!="") hardcopy(width=5.25, height=2.75, trellis=F,
                            color=TRUE, pointsize=8, device=device)
    oldpar <- par(mar=c(4.1, 3.1, 2.6, 0.1), mgp=c(2.5,0.5,0), mfrow=c(1,2),
                  oma=c(0,0.6,0,1.1))
    on.exit(par(oldpar))
    ## attach(golub.info)
    ## subsetB <- cancer=="allB" & tissue.mf%in%c("BM:f","BM:m","PB:m")
    ## tissue.mfB <- factor(tissue.mf[subsetB])
    ## dsetB <- Golub[,subsetB]
    ## tissue.mfB.badcv <- defectiveCVdisc(dsetB, cl=tissue.mfB,
    ##                                nfeatures=1:26)
    ## tissue.mfB.cv <- cvdisc(dsetB, cl=tissue.mfB, nfeatures=1:26)
    ## Accuracy measures are cv: tissue.mfB.cv$acc.cv
    ## Resubstitution (red points): tissue.mfB.badcv$acc.resub
    ## "Select once" (gray):  tissue.mfB.badcv$acc.sel1
    ## detach(golub.info)
    ## rdsetB <- matrix(rnorm(prod(dim(dsetB))), nrow=dim(dsetB)[1])
    ## rtissue.mfB.cv <- cvdisc(rdsetB, cl=tissue.mfB, nfeatures=1:26)
    ## rtissue.mfB.badcv <- defectiveCVdisc(rdsetB, cl=tissue.mfB,
    ##                                nfeatures=1:26)

    plot.acc <- function(cv=cv1, badcv=badcv1, nseq=NULL, badnseq=NULL,
                         AB="", ylab="Predictive accuracy",
                         add.legend=TRUE){
      maxg <- min(c(length(badcv$acc.resub), length(cv$acc.cv)))
      if(is.null(nseq))nseq <- 1:maxg
      plot(nseq, badcv$acc.resub[1:maxg], ylim=c(0,1), type="n", yaxs="i",
           xlab="Number of features selected", ylab=ylab)
      par(xpd=T)
      points(nseq, badcv$acc.resub[1:maxg], col=2, type="b", lty=2, pch=0,
             cex=0.8)
      par(xpd=FALSE)
      points(nseq, badcv$acc.sel1[1:maxg], col="gray40", pch=3, cex=0.8)
      lines(lowess(nseq, badcv$acc.sel1[1:maxg], f=.325, iter=0), col="gray40",
            lty=2)
      points(nseq, cv$acc.cv[1:maxg], col="blue", pch=1, cex=0.8)
      lines(lowess(nseq, cv$acc.cv[1:maxg], f=.325, iter=0), col="blue",lwd=2)
      xy <- par()$usr[c(1,3)]
      if(add.legend)
        legend(xy[1], xy[2], xjust=0, yjust=0,
               legend=c("Resubstitution accuracy",
                 "Defective cross-validation",
                 "Cross-validation - select at each fold"),
               lty=c(1,2,1), lwd=c(1,1,2), pch=c(0,3,1),
               col=c("red","gray40","blue"), cex=0.875)
      mtext(side=3,line=0.35, AB, adj=0)
    }
    plot.acc(cv1, badcv1, AB="A: Golub data (as for Figure 12.9)")
    plot.acc(cv2, badcv2, ylab="", AB="B: Random data", add.legend=FALSE)
    if(device!="")dev.off()
  }

`g12.11` <-
function(device=""){
    if(device!="") hardcopy(width=5.25, height=2.75, trellis=F,
                            color=TRUE, pointsize=8, device=device)
    oldpar <- par(mar = c(4.1, 3.6, 2.6, 0.1), mgp = c(2.25, 0.5,        
         0), mfrow = c(1, 2), oma = c(0, 0.6, 0, 1.1), pty="s")       
    on.exit(par(oldpar))
    attach(golubInfo)
    ##  tissue.mfB.cv <- cvdisc(dsetB, cl=tissue.mfB, nf.use=1:27)
    ##  tissue.mfB.scores <-                                      
    ##      cvscores(cvlist = tissue.mfB.cv,                     
    ##               nfeatures = 3, ndisc = NULL, cl.other = NULL)
    scoreplot(scorelist = tissue.mfB.scores, cl.circle=NULL,
           prefix="A: B-cell subset -", xlab="Discriminant function 1",
           ylab="Discriminant function 2",
           adj.title=0)
    ##    BMonly.scores <-
    ##        cvscores(cvlist=BMonly.cv, nfeatures=11, cl.other=NULL)
    scoreplot(scorelist=BMonly.scores, cl.circle=tissue.mfB, 
           circle=tissue.mfB%in%c("BM:f","BM:m"),
           params=list(circle=list(cex=1.3, col=c("pink","cyan")),
             points=list(cex=0.65)), xlab="Discriminant function 1",
              ylab="",
           prefix="B: BM samples -", adj.title=0)
    detach(golubInfo)
    if(device!="")dev.off()
  }

`g12.7` <-
function(df.all=Golub, info=golubInfo, test="f", use=NULL,
           m=15, device="", seed=57, new=F, offleft = -0.25,
           texfrac = 0.225, colr=c("red","blue","gray40", "magenta")){
    if(device!="") hardcopy(width=4.5, height=2.5, trellis=F,
                            color=T, pointsize=7, device=device)
    library(MASS)
    attach(golubInfo)
    ## Identify allB samples for that are BM:f or BM:m or PB:m
    subsetB <- cancer=="allB" & tissue.mf%in%c("BM:f","BM:m","PB:m")
    tissue.mfB <- tissue.mf[subsetB, drop=TRUE]
    GolubB <- Golub[, subsetB]
    G.PBf <- Golub[, tissue.mf=="PB:f" 
                                    & cancer=="allB", drop=FALSE]
    detach(golubInfo)
    set.seed(41)
    rGolubB <- matrix(rnorm(prod(dim(GolubB))), nrow=dim(GolubB)[1])
    rownames(rGolubB) <- rownames(Golub)
    rG.PBf <- matrix(rnorm(prod(dim(G.PBf))), nrow=dim(G.PBf)[1])
    oldpar <- par(mar=c(4.1, 3.6, 2.6, 0.1), mgp=c(2.5,0.5,0), mfrow=c(1,2),
                  oma=c(0,0.6,0,1.1), pty="s")    
    on.exit(par(oldpar))
    if(!is.null(seed))set.seed(seed)
    
    plot2 <- function(x = GolubB, cl=cl,
                      x.omit=Golub.PBf,
                      cl.omit="PB:f", ncol = length(cl), 
                      nfeatures=12, device = "", seed = 37,
                      pretext="", colr=1:3,
                      levnames = NULL,
                      ylab="2nd discriminant function"){
      cl <- factor(cl)
      if(!is.null(levnames))levels(cl) <- levnames
      ord15 <- orderFeatures(x, cl=cl)[1:m]
      dfB <- t(x[ord15, ])
      dfB.lda <-  lda(dfB, grouping=cl)
      scores <- predict(dfB.lda, dimen=2)$x
      df.PBf <- data.frame(t(x.omit[ord15, drop=FALSE]))
      colnames(df.PBf) <- colnames(dfB)
      scores.other <- predict(dfB.lda, newdata=df.PBf)$x
      scoreplot(list(scores=scores, cl=cl, other=scores.other,
                     cl.other=cl.omit, nfeatures=nfeatures),
                prefix.title=pretext, adj.title=0,
                params=list(other=list(pch=4, cex=1.5)),
                xlab="1st discriminant function", ylab=ylab)
##      mtext(side=3, line=1, paste(pretext,
##                      nf.use, "features"), adj=0)
      
    }
    plot2(x = GolubB, cl = tissue.mfB, x.omit=G.PBf, cl.omit="PB:f",
          nfeatures=m, device = "", seed = 37,
          ylab="2nd discriminant function",
          colr=colr,
          pretext="A: ALL B-cell:")
    plot2(x = rGolubB, cl = tissue.mfB,
            x.omit=rG.PBf, cl.omit="Gp 4",
          nfeatures=m, device = "", seed = 37,
          colr=colr,
          levnames = c("Gp 1", "Gp 2", "Gp 3"),
          pretext="B: Random data:", ylab="")
    if(device!="")dev.off()
  }

`g12.8` <-
function(device=""){
    if(device!="") hardcopy(width=4.15, height=2.25, trellis=F,
                            color=T, pointsize=8, device=device)
    library(MASS)
    ## library(multtest)
    ## GolubB.maxT <- mt.maxT(GolubB,unclass(tissue.mfB)-1,test="f", B=100000)
    ## Compare calculated F-statistics with permutation distribution
    oldpar <- par(mar=c(4.1,4.1,1.6,0.6), mgp=c(2.5,.75,0),
                  mfrow=c(1,2), pty="s")
    qqthin(qf(1-GolubB.maxT$rawp,2,28), GolubB.maxT$teststat,
           xlab="Quantiles of permutation F-values",
           ylab="Observed F-statistics", adj.xlab=0.55)
    mtext(side=3, line=0.5, "A", adj=0)
    abline(0, 1, lty=2)
    ## Compare calculated F-statistics with theoretical F-distribution
    qqthin(qf(ppoints(7129),2,28), GolubB.maxT$teststat,
           xlab="Quantiles of F - theoretical", adj.xlab=0.55,
           ylab="Observed F-statistics")
    mtext(side=3, line=0.5, "B", adj=0)
    abline(0, 1, lty=2)
    if(device!="")dev.off()
  }

`g12.9` <-
function(device="",  x=Golub.BM, nseq=NULL, cl=cancer.BM,
           seed=29, nfeatures=c(14,10), colr = c("red", "blue", "magenta")){
    oldpar <- par(mar=c(3.6, 3.6, 2.6, 0.1), mgp=c(2.25,0.5,0), mfrow=c(1,2),
                  oma=c(0,0.6,0,0.1), pty="s")    
    on.exit(par(oldpar))
    if(device!="")hardcopy(width = 4.5, height = 2.5, trellis = F,
                           color=T, pointsize=7, device=device)
    gp.id <- divideUp(cl, nset=2, seed=seed)
    plotTrainTest(x=x, nfeatures=nfeatures, cl=cl, ylab="",
                    traintest=gp.id)
    if(device!="")dev.off()
  }

`gdump` <-
function(fnam=NULL, prefix="~/r-book/ed2/figures/figs",
           splitchar="/ch", xtras=c("hardcopy",
                              "renum.fun","renum.files")){
    if(is.null(fnam)){
      path <- getwd()
      pathtag <- strsplit(path, "/ch", fixed=TRUE)[[1]]
      fnam <- paste(prefix, pathtag[length(pathtag)],
                    ".R", sep="")
    }
    else fnam <- paste(prefix, fnam, sep="/")
    objnames <- c(objects(pattern="^g", envir=sys.frame(0)), xtras)
    cat("\nDump to file:", fnam, "\n")
    print(objnames)
    dump(objnames, fnam)
  }

`genelist` <-
structure(c("M58459_at", "U91327_at", "X54870_at", "M58459_at", 
"X54870_at", "U91327_at", "M58459_at", "U91327_at", "X54870_at", 
"M58459_at", "L08666_at", "U91327_at", "M58459_at", "X00437_s_at", 
"X62654_rna1_at", "U29195_at", "U49395_at", "X82494_at", "S74221_at", 
"M58459_at", "U91327_at", "M58459_at", "X54870_at", "U91327_at", 
"M58459_at", "X54870_at", "X62654_rna1_at", "M58459_at", "X54870_at", 
"X53416_at", "M58459_at", "U91327_at", "X54870_at", "M58459_at", 
"U91327_at", "X54870_at", "M58459_at", "X00437_s_at", "X62654_rna1_at", 
"U29195_at", "U49395_at", "X82494_at", "M58459_at", "X54870_at", 
"X53416_at", "M58459_at", "L08666_at", "U91327_at", "S74221_at", 
"M58459_at", "U91327_at", "M58459_at", "X54870_at", "X62654_rna1_at", 
"M58459_at", "X54870_at", "U91327_at", "M58459_at", "X54870_at", 
"U91327_at", "S74221_at", "M58459_at", "U91327_at", "U29195_at", 
"U49395_at", "X82494_at", "M58459_at", "L08666_at", "U91327_at", 
"M58459_at", "U91327_at", "X54870_at", "M58459_at", "X54870_at", 
"U91327_at", "M58459_at", "X54870_at", "X62654_rna1_at", "M58459_at", 
"X54870_at", "X53416_at", "M58459_at", "U91327_at", "X54870_at", 
"M58459_at", "X54870_at", "U91327_at", "M58459_at", "X00437_s_at", 
"X62654_rna1_at", "M58459_at", "U91327_at", "X54870_at", "U29195_at", 
"U49395_at", "X82494_at", "M58459_at", "X54870_at", "U91327_at", 
"M58459_at", "L08666_at", "U91327_at", "M58459_at", "U91327_at", 
"X54870_at", "M58459_at", "X54870_at", "U91327_at", "M58459_at", 
"X54870_at", "X62654_rna1_at", "S74221_at", "M58459_at", "U91327_at", 
"M58459_at", "X54870_at", "X53416_at", "M58459_at", "X00437_s_at", 
"X62654_rna1_at"), .Dim = c(3L, 40L))
`golubInfo` <-
structure(list(Samples = c(39L, 40L, 42L, 47L, 48L, 49L, 41L, 
43L, 44L, 45L, 46L, 70L, 71L, 72L, 68L, 69L, 67L, 55L, 56L, 59L, 
52L, 53L, 51L, 50L, 54L, 57L, 58L, 60L, 61L, 65L, 66L, 63L, 64L, 
62L, 1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 12L, 13L, 
14L, 15L, 16L, 17L, 18L, 19L, 20L, 21L, 22L, 23L, 24L, 25L, 26L, 
27L, 34L, 35L, 36L, 37L, 38L, 28L, 29L, 30L, 31L, 32L, 33L), 
    BM.PB = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 2L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L), .Label = c("BM", "PB"), class = "factor"), Gender = structure(c(1L, 
    1L, 1L, 2L, 1L, 2L, 1L, 1L, 1L, 2L, 1L, 1L, NA, NA, 2L, 2L, 
    2L, 1L, 1L, 1L, NA, NA, NA, NA, 1L, 1L, NA, 2L, NA, 2L, 2L, 
    1L, 2L, 2L, 2L, 2L, 2L, NA, NA, 2L, 1L, 1L, 2L, 2L, 2L, 1L, 
    1L, 2L, 1L, 2L, 2L, 1L, NA, NA, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 
    NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA), .Label = c("F", 
    "M"), class = "factor"), Source = structure(c(3L, 3L, 3L, 
    3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 4L, 
    4L, 4L, 1L, 1L, 1L, 1L, 4L, 4L, 4L, 4L, 4L, 2L, 2L, 2L, 2L, 
    2L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 
    3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 1L, 1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L), .Label = c("CALGB", 
    "CCG", "DFCI", "St-Jude"), class = "factor"), tissue.mf = structure(c(2L, 
    2L, 2L, 3L, 2L, 3L, 2L, 2L, 2L, 3L, 2L, 5L, 4L, 4L, 6L, 6L, 
    6L, 2L, 2L, 2L, 4L, 1L, 1L, 1L, 2L, 2L, 1L, 3L, 1L, 3L, 3L, 
    5L, 6L, 6L, 3L, 3L, 3L, 1L, 1L, 3L, 2L, 2L, 3L, 3L, 3L, 2L, 
    2L, 3L, 2L, 3L, 3L, 2L, 1L, 1L, 3L, 3L, 3L, 3L, 3L, 2L, 2L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L), .Label = c("BM:NA", 
    "BM:f", "BM:m", "PB:NA", "PB:f", "PB:m"), class = "factor"), 
    cancer = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 1L, 1L, 1L, 3L, 3L, 3L, 3L, 
    3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 1L, 2L, 2L, 1L, 1L, 
    2L, 1L, 1L, 2L, 2L, 2L, 1L, 1L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 2L, 1L, 1L, 1L, 1L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 
    3L, 3L, 3L), .Label = c("allB", "allT", "aml"), class = "factor")), .Names = c("Samples", 
"BM.PB", "Gender", "Source", "tissue.mf", "cancer"), row.names = c("39", 
"40", "42", "47", "48", "49", "41", "43", "44", "45", "46", "70", 
"71", "72", "68", "69", "67", "55", "56", "59", "52", "53", "51", 
"50", "54", "57", "58", "60", "61", "65", "66", "63", "64", "62", 
"1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", 
"13", "14", "15", "16", "17", "18", "19", "20", "21", "22", "23", 
"24", "25", "26", "27", "34", "35", "36", "37", "38", "28", "29", 
"30", "31", "32", "33"), class = "data.frame")
`gp.id` <-
c(1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 2L, 
1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 1L, 2L, 1L, 2L, 1L, 2L, 2L, 
1L, 1L, 2L, 1L, 2L, 1L, 2L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 1L, 
2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L)
`gsave` <-
function(fnam=NULL, prefix="~/r-book/ed2/figures/figs",
           splitchar="/ch", xtras=c("hardcopy", "renum.fun","renum.files")){
    if(is.null(fnam)){
      path <- getwd()
      pathtag <- strsplit(path, "/ch", fixed=TRUE)[[1]]
      fnam <- paste(prefix, pathtag[length(pathtag)],
                    ".RData", sep="")
    }
    else fnam <- paste(prefix, fnam, sep="/")
    objnames <- c(objects(pattern="^g", envir=sys.frame(0)), xtras)
    cat("\nDump to file:", fnam, "\n")
    print(objnames)
    save(list=objnames, file=fnam)
  }

`hardcopy` <-
function(width=3.75, height=3.75, color=FALSE, trellis=FALSE,
           device=c("","pdf","ps"), path="~/r-book/ed2/Art/", file=NULL,
           format=c("nn-nn", "name"), split="\\.", pointsize=c(8,4),
           fonts=NULL,
           horiz=FALSE, ...){
    if(!trellis)pointsize <- pointsize[1]
    funtxt <- sys.call(1)
    nam <- strsplit(as.character(funtxt), "(", fixed=TRUE)[[1]][1]
    suffix <- switch(device, ps=".eps", pdf=".pdf")
    if(is.character(path) & nchar(path)>1 & substring(path, nchar(path))!="/")
      path <- paste(path, "/", sep="")
    if(is.null(file)) if(format[1]=="nn-nn"){
      if(!is.null(split))dotsplit <- strsplit(nam, split)[[1]] else
      dotsplit <- nam
      if(length(dotsplit)==1)dotsplit <- c("", dotsplit)
      nn2 <- paste(if(nchar(dotsplit[2])==1)"0" else "", dotsplit[2],
                   sep="")
      if(nchar(dotsplit[1])>0){
        numstart <- which(unlist(strsplit(dotsplit[1], "")) %in% paste(0:9))[1]
        nn1 <- substring(dotsplit[1], numstart)
        nn1 <- paste(if(nchar(nn1) == 1) "0" else "", nn1, "-", sep="")
      } else nn1 <- ""
      file <- paste(nn1, nn2, sep="")
    } else file <- nam
    if(nchar(file)>4 & substring(file, nchar(file)-nchar(suffix)+1)==suffix)
      suffix <- ""
    file <- paste(path, file, suffix, sep="")
    print(paste("Output will be directed to file:", file))
    dev.out <- device[1]
    dev.fun <- switch(dev.out, pdf=pdf, ps=postscript)
    if(trellis){
      library(lattice)
      if(device=="ps")
        trellis.device(file=file, device=dev.fun,
                       color = color, horiz=horiz, fonts=fonts,
                       width=width, height=height, ...) else
      trellis.device(file=file, device=dev.fun, fonts=fonts,
                     color = color, width=width, height=height, ...)

      trellis.par.set(list(fontsize=list(text=pointsize[1], points=pointsize[2])))
    } else
    if (dev.out!=""){
      print(c(width, height))
      if(device=="ps")
        dev.fun(file=file, paper="special",  horiz=horiz, fonts=fonts,
                width=width, height=height, pointsize=pointsize[1], ...) else
      dev.fun(file=file, paper="special", fonts=fonts,
              width=width, height=height, pointsize=pointsize[1], ...)      
    }
    if(trellis)trellis.par.set(list(fontsize=list(text=pointsize[1],
                                      points=pointsize[2])))
  }

`renum.fun` <-
function(from.prefix="g", to.prefix="g",from=20:7, to=21:8, doit=F){
          path <- getwd()
    pathtag <- strsplit(path, "/ch", fixed=TRUE)[[1]]
    endbit <- pathtag[length(pathtag)]
    from.prefix <- paste(from.prefix, endbit, sep="")
    to.prefix <- paste(to.prefix, endbit, sep="")
    for(i in 1:length(to))
      {txt<-paste(to.prefix,".",to[i]," <- ", from.prefix,".",from[i],sep="")
       if(doit)eval(parse(text=txt),envir=sys.frame(0))
       print(txt)
     }
  }

`renum.files` <-
function(from.prefix="~/r-book/ed2/Art/", to.prefix="~/r-book/ed2/Art/",
           from=20:7, to=21:8, doit=F){
    path <- getwd()
    pathtag <- strsplit(path, "/ch", fixed=TRUE)[[1]]
    endbit <- pathtag[length(pathtag)]
    if(nchar(endbit)==2)chap <- paste(endbit) else
    chap <- paste("0",endbit,sep="")
    from.prefix <- paste(from.prefix, chap, "-", sep="")
    to.prefix <- paste(to.prefix, chap, "-", sep="")
    for(i in 1:length(from)){
      if (from[i]<=9) ltext <- paste("0",from[i],sep="")
      else ltext <- paste(from[i])
      if (to[i]<=9) rtext <- paste("0",to[i],sep="")
      else rtext <- paste(to[i])            
      txt<-paste("mv ", from.prefix, ltext, ".eps", " ",
                 to.prefix, rtext, ".eps", sep="")
      backup<-paste("cp ", from.prefix, ltext, ".eps", " ",
                    "archive", sep="")
      if(doit)system(backup)
      if(doit)system(txt)
      print(backup)
      print(txt)
    }
  }