.packageName <- "RbcBook1"
bcStangle =
function(files = .RbcBook1Files(), outfile= "bioCSpringer.R") {
  con = file(outfile, open="w") 

  chunkfun = function(name, start, end, eva) {
    c("\n", name,
      paste(c("##", "")[1+eva], txt[(start+1):(end-1)]))
  }
  seplin = "##################################################"
  
  for(f in files) {
    ## find chunks
    txt = readLines (f)
    i1 = grep("^<<.*>>=", txt)
    i2 = grep("^@", txt)
    if(length(i1)!=length(i2) || any(i2<=i1)) {
      print(i1)
      print(i2)
      stop(paste(f, "seems to have invalid code chunk syntax."))
    }

    ## which chunks are evaluated?
    args=gsub("^<<|>>=$", "", gsub(" ", "", txt[i1]))
    args=strsplit(args, ",")
    is.evaluated=sapply(args, function(v) {
       i1 = ("eval=FALSE" == v)
       i2 = ("eval=TRUE"  == v)
       i3 = grep("eval", v)
       stopifnot( !(any(i1) && any(i2)),
                 length(setdiff(i3, which(i1|i2)))==0 )
       return(!any(i1))
     }) ## sapply

    ## chunk names
    chunkname=sapply(args, function(v) {
      res = v[-grep("=", v)]
      if(length(res)==0) res=""
      return(res)
    }) ## sapply
    chunkname = paste("## chunk ", 1:length(chunkname), ": ", chunkname, sep="")
      
    ## write
    writeLines(c(seplin, paste("##", txt[grep("chapter{", txt, extended=FALSE)]),
               seplin), con)
    chks = mapply(chunkfun, chunkname, i1, i2, is.evaluated)
    lapply(chks, writeLines, con=con)
    writeLines(character(2), con)
    
  } ## for f
  close(con)
}

tangleToSingleFiles = function() {
  ifiles = .RbcBook1Files()
  ofiles = sapply(strsplit(ifiles, "/"), function(x) x[2])
  of2 = gsub(".Rnw", ".R", ofiles)
  of3 = paste("Rfiles", of2, sep="/")
  dir.create("Rfiles")
  for( i in 1:length(ifiles))
     bcStangle(ifiles[i], of3[i])
}
bcSweave <- function(f) {
  out  <- sub('.Rnw','.tex',f)
  if(out==f)
    stop("Expecting filename with '.Rnw' extension.")
  Sweave(f, eps=FALSE, output=out)

  ## This is for the sessionInfo stuff
  tmp  <- tempfile()
  Sweave("../sessionInfo.Rnw", output=tmp)
  con <- file(out, open="at")
  writeLines(readLines(tmp), con)
  close(con)
}
## find lines that are longer than 70 characters within Sinput and Soutput
## environments

.RbcBook1Files = function(ext=".Rnw") paste(c(
  "Preproc/overview", "Preproc/AffyPreprocess", "Preproc/AffyQuality",
  "Preproc/TwoColorPre", "Preproc/cellAssays", "Preproc/massSpectra",
  "Metadata/metaOverview", "Metadata/metaQuery", "Metadata/metaOutput", 
  "Metadata/metaVisualize",
  "Analysis/anovv", "Analysis/dist", "Analysis/AnalClust", 
  "Analysis/AvHDS", "Analysis/multtest", 
  "Analysis/MLchap", "Analysis/Computational_Inference",
  "Analysis/bbanal",
  "Graphs/Intro", "Graphs/Graphs", "Graphs/bioCGraph",
  "Graphs/modelingGraphs",
  "CaseStudies/limma", "CaseStudies/class", "CaseStudies/fromcels"), ext, sep="")



checkVerbatim =
  function(files = .RbcBook1Files(ext=".tex"),
            maxc = 70,
            which = "both",
            verbose=TRUE)
{
  rv = NULL
  for (f in files) {
    if(!file.exists(f)) {
      cat(f, "NOT FOUND.\n")
    } else {
      if(verbose)
        cat(f, "")
      txt = readLines (f)
      pat = switch(which,
        Sinput  = c("^.begin.Sinput}",  "^.end.Sinput."), 
        Soutput = c("^.begin.Soutput}", "^.end.Soutput."), 
        both    = c("^.begin.Sinput}|^.begin.Soutput.",
                    "^.end.Sinput}|^.end.Soutput."),
        stop(paste("Unknown value for 'which':", which)))
    
      i1 = grep(pat[1], txt)
      i2 = grep(pat[2], txt)
      if(length(i1)!=length(i2) || any(i2<=i1))
        stop(paste(f, "seems to have unbalanced environment keywords."))
      
      if(length(i1)>=1) {
        for(j in 1:length(i1)) {
          rg = (i1[j]+1):(i2[j]-1)
          nc = nchar(txt[rg])
          wh = (nc > maxc)
          stopifnot(!any(is.na(wh)))
          if(any(wh))
            rv = rbind(rv, data.frame(
              file   = I(rep(f, sum(wh))),
              line   = as.integer(rg[wh]),
              length = as.integer(nc[wh]),
              text   = I(txt[rg[wh]])))
        } ## for j
      } ## if
    } ## else
  } ## for f
  if(verbose) cat("\nFinished.\n\n")
  return(rv)
}

checkRnw =
function(files = .RbcBook1Files(), verbose=TRUE, stopOnError=FALSE) {
  rv = NULL
  for(f in files) {
    if(verbose) cat(f, "")
    txt = readLines (f)
    i1 = grep("^<<.*>>=", txt)
    i2 = grep("^@", txt)
    if(length(i1)!=length(i2) || any(i2<=i1)) {
      if(verbose) cat("\n")
      print(i1)
      print(i2)
      stop(paste(f, "seems to have invalid code chunk syntax."))
    }

    ## are there any lines with '@' at the start that aren't empty otherwise?
    z = nchar(gsub(" ", "", txt[i2]))
    if(!all(z==1))
      rv = rbind(rv, data.frame(
        file = I(f),
        line = as.integer(i2[z>1]),
        text = I("'@' followed by text.")))
    
    ## are there any lines with '\caption' and '%' and more text thereafter?
    i = grep("caption.*%.*[a-zA-Z]", txt, extended=FALSE)
    if(length(i)>0)
      rv = rbind(rv, data.frame(
        file = I(f),
        line = as.integer(i),
        text = I(txt[i])))
    
    if(length(i1)>=1) {
      ## the line numbers of all R code
      codeChunks = unlist(apply(cbind(i1+1, i2-1), 1, function(v) seq(v[1], v[2])))

      ## Check for occurences of keyword 'options'
      wh = grep("options", txt[codeChunks])
      if(length(wh)>0)
        rv = rbind(rv, data.frame(
            file = I(rep(f, length(wh))),
            line = as.integer(codeChunks[wh]),
            text = I(txt[codeChunks[wh]])))

      ## Check for occurences of keyword 'library("RbcBook1")'
      firstChunk = (i1[1]+1):(i2[1]-1)
      lib1 = grep("library..RbcBook1..", txt[firstChunk])
      if (length(lib1)<1) { 
        rv = rbind(rv, data.frame(
          file = I(f),
          line = as.integer(NA),
          text = I('library("RbcBook1") is missing from first code chunk!')))
        if(stopOnError)stop()
      }      
      wh = grep("library..RbcBook1..", txt[setdiff(codeChunks, firstChunk)])
      if (length(wh)>=1) {
        rv = rbind(rv, data.frame(
          file = I(f),
          line = as.integer(codeChunks[wh[1]]),
          text = I('library("RbcBook1") occurs multiple times!')))
        if(stopOnError)stop()
      }

      ## Check for occurences of "=" as assignment
      ex = parse(text=txt[codeChunks])
      cl = sapply(ex, class)
      wh = which(cl=="=")
      if(length(wh>0)) {
        rv = rbind(rv, data.frame(
          file = I(rep(f, length(wh))),
          line = as.integer(NA),
          text = I(as.character(ex[wh]))))
        if(stopOnError)stop()
      }      
    } ## if
  } ## for
  if(verbose) cat("\nFinished.\n\n")
  return(rv)
}

checkPackage = function(files = .RbcBook1Files(ext=".Rnw"), verbose=TRUE) {
  pkgNames <-  library()$results[,"Package"]

  ## additional ones:
  pkgNames <-  c(pkgNames, "iSPlot", "aCGH", "daMA", 
                 "Rggobi", "RMAGEML",  ## Omegahat
                 "gclus", "vcd", "scatterplot3d", "RSvgDevice", ## CRAN
                 "logspline", "mgcv", "cclust", "flexmix", "fpc",
                 "ade4", "ape", "Matrix")

  
  pkg <- vector(mode="list", length=length(pkgNames))
  names(pkg) <- pkgNames
  
  for (i in seq(along=files)) {
    f = files[i]
    if(!file.exists(f)) {
      cat(f, "NOT FOUND.\n")
    } else {
      txt = readLines (f)
      ## the following is to break up into invidual words - otherwise we
      ## would only find first occurence in each line
      txt = unlist(strsplit(txt, "[ ,.]"))
      ## re  = regexpr("Rpackage{.*}", txt, extended=FALSE) 
      ## this is more specific, but somehow I didn't get it to work:
      re  = regexpr("Rpackage.[a-zA-Z0-9]+.", txt)
      hit = (re>0)
      p = substr(txt[hit], start=re[hit], stop=re[hit]+attr(re, "match.length")[hit]-1)
      p = sub("Rpackage{", "", sub("}", "", unique(p), extended=FALSE), extended=FALSE)
      mt   = match(p, names(pkg))
       if(any(is.na(mt))) {
        cat(paste(f, ": invalid package name:", p[is.na(mt)], "\n"))
        ## browser()
     } else {
        if(verbose)
          cat(f, "OK.\n")
      }
      for(j in which(!is.na(mt)))
        pkg[[mt[j]]] = append( pkg[[mt[j]]], f)
    }
  }
  pkg <- pkg[sapply(pkg, length) > 0]
  pkg <- pkg[order(names(pkg))]
  return(pkg)
}
imageSize <- function(dirs= c("Preproc", "Analysis", "Metadata", "Graphs", "CaseStudies"),
                      ext = c("pdf", "png")) {
  f = lapply(dirs, dir, pattern=paste("", paste(ext, collapse="|"), "$", sep=""), recursive=TRUE)
  for(i in seq(along=f))
    f[[i]] = file.path(dirs[i], f[[i]])
  f = unlist(f)
  fi = file.info(f)
  fi = fi[order(fi$size, decreasing=TRUE), ]
  data.frame(name=I(rownames(fi)), size=fi$size)
}
  

.RbcBook1.pkgs = function() c(
  "affycomp", "affydata", "affypdnn", "affyPLM", "ALL", "ALLMLL",
"AnnBuilder", "AmpAffyExample", "annaffy", "arrayMagic",
"arrayQuality", "beta7", "bioDist", "cMAP", "CoCiteStats", "convert",
"e1071", "edd", "estrogen", "exactRankTests", "facsDorit",
"factDesign", "gbm", "gcrma", "golubEsets", "GOstats", "gpls",
"graph", "hexbin", "hgu133a", "hgu133acdf", "hgu133bcdf", "hgu95av2",
"hgu95av2cdf", "hgu95av2probe", "hopach", "hu6800cdf", "hu6800probe",
"humanLLMappings", "ipred", "KEGG", "KEGGSOAP", "kidpack", "limma", "locfit", 
"LogitBoost", "matchprobes", "mclust", "mlbench", "MLInterfaces",
"multtest", "pamr", "prada", "PROcess", "ProData", "randomForest",
"RBGL", "Rgraphviz", "rrcov", "simpleaffy", "sma", "SpikeInSubset", "statmod",
"vsn", "XML", "xtable", "YEAST", "yeastExpData")

## install.from.svn = function(madman="../../../madman/Rpacks") {
##  pkgs <- .RbcBook1.pkgs 
##  ... bla...bla
## }


require.RbcBook1 = function() {
  pkgs = .RbcBook1.pkgs()
  res = sapply(pkgs, require, character.only=TRUE)
  if(any(!res))
    stop(paste("There were error(s) loading the following package(s):\n", pkgs[!res]))
  return(search())
}

 .fixdu <- function(x,suff=" ") {
#
# makes char tokens unique by adding whitespace or another suffix as needed
#
  du <- duplicated(x)
  if (sum(du) == 0) return(x)
  x[du] <- paste(x[du], suff, sep="")
  Recall(x,suff)
 }

rpart2gNEL <- function(tr, remap=function(x)x, nsep="\n") {
#
# tr is an rpart output.  Because rpart may fiddle with
# variable names, remap allows mapping from rpart labels
# to other symbols.  nsep is the separator between vote and (a:b)
# vote count tally token
#
# node takes the form  [voteToken][nsep](a:b), it is a string
# such strings might recur in the translation of an rpart and
# we would then have redundant node names.  fixdu pads with spaces
# so that we have unique strings
#
# how do we derive graph topology from rpart?  see below
#
 require(graph)
 fixdu <- function(x,suff=" ") {
  du <- duplicated(x)
  if (sum(du) == 0) return(x)
  x[du] <- paste(x[du], suff, sep="")
  Recall(x,suff)
 }
 f <- tr$frame
 ylev <- attr(tr,"ylevels")
 yval <- f[["yval"]]
 vote <- ylev[yval]
#
# here we construct the nodes based on split results
#
 r0 <- function(x) round(as.numeric(x),0)
 an <- function(x) as.numeric(x)
 #nds <- fixdu(paste("N=",as.character(f$n),
 nds <- fixdu(paste( "(", as.character(r0(an(f$yval2[,2]))),
         ":", as.character(r0(an(f$yval2[,3]))), ")",sep=""))
 nds <- paste(vote, nds, sep=nsep) 
 G <- new("graphNEL", nodes=nds, edgemode="directed")
#
# now we start to derive graph topology
# a binary enumeration is used in rpart
# if node has number n, its children are numbered 2n, 2n+1
#
 pos <- as.numeric(row.names(f))
 parent <- floor(pos/2)
#
 names(nds) <- pos
#
# so now nds is a named vector with binary enumeration as names
# we will have children pointing to parents
#
 G <- addEdge(
    to <- nds[as.character(parent)[parent>0]], 
    fr <- nds[parent>0], 
    G, 1)
 nl <- remap(labels(tr)[-1])
 names(nl) <- paste(to, fr, sep="~")
 attr(G,"edgeLabels") <- as.list(nl)
 G
}
 
.plotAsGraph <- function(x,remap=function(x)x,...) {
# defunct -- it would be nice to use Rgraphviz at high level
# but not ready yet
 tmp <- rpart2gNEL(x,remap=remap)
 plot(tmp, edgeAttrs=list(label=attr(tmp,"edgeLabels")),...)
}

grabSplitV <- function(g,use="%") {
 gl <- labels(g)
 fx <- gsub(">|<", use, gl)
 fxs <- strsplit(fx, use)
 sapply(fxs, function(x)x[1])
}

remapAff <- function(x, env=hgu95av2SYMBOL, use="%" ) {
 # suppose rpart has taken affy 1071_at to X1071_at >= 4.4
 # this replaces X1071_at with it symbol for 1071_at
 fx <- gsub(">|<", use, x)
 fxs <- strsplit(fx, use)
 tags <- unlist(mget(substr(sapply(fxs, function(x)x[1]), 2, 1000), env))
 tags
}

 
## general options that should be used for all chapters
## and are set via 'library("RbcBook1")'.
.First.lib <- function(lib, pkgname) {
  options(width=60,digits=3)
}
