[med-svn] [r-bioc-geneplotter] 01/08: Imported Upstream version 1.48.0
Michael Crusoe
misterc-guest at moszumanska.debian.org
Mon Jun 27 21:30:23 UTC 2016
This is an automated email from the git hooks/post-receive script.
misterc-guest pushed a commit to branch master
in repository r-bioc-geneplotter.
commit df1e6f2fda7129754604ee1f6fdf4e3975a563a0
Author: Michael R. Crusoe <crusoe at ucdavis.edu>
Date: Fri Jan 15 07:25:38 2016 -0800
Imported Upstream version 1.48.0
---
DESCRIPTION | 15 ++
NAMESPACE | 60 +++++
R/Makesense.R | 69 +++++
R/alongChrom.R | 609 +++++++++++++++++++++++++++++++++++++++++++++
R/amplicon.plot.R | 86 +++++++
R/cPlot.R | 112 +++++++++
R/cScale.R | 21 ++
R/gplotter.R | 30 +++
R/groupedHeatmap.R | 64 +++++
R/histStack.R | 19 ++
R/imageMap.R | 31 +++
R/multiecdf.R | 173 +++++++++++++
R/openHtmlPage.R | 14 ++
R/plotChr.R | 113 +++++++++
R/plotExpression.R | 56 +++++
R/plotMA.R | 20 ++
R/savepng.R | 40 +++
R/zzz.R | 9 +
README | 19 ++
build/vignette.rds | Bin 0 -> 332 bytes
data/IMCAEntrezLink.R | 31 +++
data/expressionSet133a.rda | Bin 0 -> 990912 bytes
inst/NEWS.Rd | 15 ++
inst/doc/byChroms.R | 55 ++++
inst/doc/byChroms.Rnw | 110 ++++++++
inst/doc/byChroms.pdf | Bin 0 -> 117720 bytes
inst/doc/visualize.R | 54 ++++
inst/doc/visualize.Rnw | 153 ++++++++++++
inst/doc/visualize.pdf | Bin 0 -> 253580 bytes
man/GetColor.Rd | 45 ++++
man/Makesense.Rd | 62 +++++
man/alongChrom.Rd | 123 +++++++++
man/amplicon.plot.Rd | 39 +++
man/cColor.Rd | 48 ++++
man/cPlot.Rd | 61 +++++
man/cScale.Rd | 42 ++++
man/eset133a.Rd | 20 ++
man/groupedHeatmap.Rd | 52 ++++
man/histStack.Rd | 38 +++
man/imageMap.Rd | 111 +++++++++
man/make.chromOrd.Rd | 33 +++
man/multiecdf.Rd | 131 ++++++++++
man/openHtmlPage.Rd | 30 +++
man/plotChr.Rd | 64 +++++
man/plotExpressionGraph.Rd | 91 +++++++
man/plotMA.Rd | 61 +++++
man/savepng.Rd | 73 ++++++
vignettes/byChroms.Rnw | 110 ++++++++
vignettes/visualize.Rnw | 153 ++++++++++++
49 files changed, 3365 insertions(+)
diff --git a/DESCRIPTION b/DESCRIPTION
new file mode 100644
index 0000000..c323b3d
--- /dev/null
+++ b/DESCRIPTION
@@ -0,0 +1,15 @@
+Package: geneplotter
+Title: Graphics related functions for Bioconductor
+Version: 1.48.0
+Author: R. Gentleman, Biocore
+Description: Functions for plotting genomic data
+Maintainer: Bioconductor Package Maintainer <maintainer at bioconductor.org>
+Depends: R (>= 2.10), methods, Biobase, BiocGenerics, lattice, annotate
+Imports: AnnotationDbi, graphics, grDevices, grid, RColorBrewer, stats,
+ utils
+Suggests: Rgraphviz, fibroEset, hgu95av2.db, hu6800.db, hgu133a.db
+License: Artistic-2.0
+biocViews: Visualization
+LazyLoad: yes
+NeedsCompilation: no
+Packaged: 2015-10-14 00:32:26 UTC; biocbuild
diff --git a/NAMESPACE b/NAMESPACE
new file mode 100644
index 0000000..db7b9fd
--- /dev/null
+++ b/NAMESPACE
@@ -0,0 +1,60 @@
+
+## import(methods)
+importClassesFrom(methods, character, list, matrix, missing, oldClass)
+
+importClassesFrom(Biobase, ExpressionSet)
+
+importMethodsFrom(annotate, chromLengths, chromLocs, chromNames,
+ geneSymbols, organism, probesToChrom)
+
+importMethodsFrom(AnnotationDbi, colnames, exists, get, mget, ncol,
+ nrow, sample)
+
+importMethodsFrom(Biobase, annotation, contents, esApply, exprs,
+ featureNames)
+
+importMethodsFrom(BiocGenerics, plotMA)
+
+importFrom(annotate, getAnnMap, usedChromGenes)
+
+importFrom(Biobase, addVigs2WinMenu, multiassign)
+
+importFrom(graphics, abline, axis, barplot, boxplot, bxp, hist, image,
+ lines, matplot, mtext, par, plot, plot.new, segments,
+ strheight, title)
+
+importFrom(grDevices, colorRampPalette, dev.copy, dev.off, pdf, png,
+ postscript, rgb)
+
+importFrom(grid, convertUnit, gpar, grid.rect, grid.text, stringWidth, unit)
+
+importFrom(RColorBrewer, brewer.pal)
+
+importFrom(stats, approx, density, ecdf, lowess, mad, median, quantile, sd)
+
+importFrom(utils, data)
+
+export(alongChrom,
+ cColor, cPlot, cScale,
+ dChip.colors,
+ greenred.colors, GetColor,
+ plotChr, plotExpressionGraph,
+ make.chromOrd,
+ savepng, savepdf, saveeps, savetiff,
+ histStack, groupedHeatmap,
+ openHtmlPage, closeHtmlPage,
+ multiecdf, multidensity)
+
+exportMethods(imageMap, Makesense, plotMA)
+
+S3method(multiecdf, formula)
+S3method(multiecdf, matrix)
+S3method(multiecdf, list)
+S3method(multiecdf, data.frame)
+
+S3method(multidensity, formula)
+S3method(multidensity, matrix)
+S3method(multidensity, list)
+S3method(multidensity, data.frame)
+
+
diff --git a/R/Makesense.R b/R/Makesense.R
new file mode 100755
index 0000000..8a2c674
--- /dev/null
+++ b/R/Makesense.R
@@ -0,0 +1,69 @@
+setGeneric("Makesense", function(expr, lib, ...) standardGeneric("Makesense"))
+
+setMethod("Makesense", signature(expr="ExpressionSet", lib="character"),
+ function(expr, lib, f=1/10) {
+ Makesense(exprs(expr), lib, f)
+})
+
+setMethod("Makesense", signature(expr="ExpressionSet", lib="missing"),
+ function(expr, f=1/10) {
+ Makesense(expr, annotation(expr), f)
+ })
+
+setMethod("Makesense", signature(expr="matrix", lib="character"),
+ function(expr, lib, f=1/10) {
+ if (length(lib) != 1 || nchar(lib) < 1)
+ stop("'lib' argument must be length one")
+
+ genes <- rownames(expr)
+ libCHR <- getAnnMap("CHR", lib)
+ libCHRLOC <- getAnnMap("CHRLOC", lib)
+ ## Select genes that are annotated at exactly _one_ chromosome.
+ chr <- mget(genes, envir=libCHR, ifnotfound=NA)
+ oneC <- sapply(chr, function(x)
+ if (length(x) == 1 && !is.na(x)) TRUE else FALSE)
+ ## Select genes that are annotated at exactly _one_ chrom location
+ ##
+ ## FIXME: There are many genes with multiple CHRLOC entries, is
+ ## there anything we can do to keep more of them?
+ chrL <- mget(genes, envir=libCHRLOC, ifnotfound=NA)
+ oneL <- sapply(chrL, function(x)
+ if (length(x) == 1 && !is.na(x)) TRUE else FALSE)
+ wanted <- oneC & oneL
+ chrName <- unlist(chr[wanted])
+ chrPos <- unlist(chrL[wanted])
+
+ cP <- split(chrPos, chrName)
+
+ gE <- expr[wanted, ]
+ ans2 <- vector("list", length=ncol(gE))
+
+ for( j in 1:ncol(gE) ) {
+ s1 <- split(gE[,j], chrName)
+ ans <- NULL
+ for (i in names(cP)) {
+ d1 <- s1[[i]]
+ cL <- cP[[i]]
+ dp <- d1[cL>0]
+ lp <- cL[cL>0]
+ dn <- d1[cL<0]
+ ln <- -cL[cL<0]
+ if (length(lp)) {
+ lw1 <- lowess(lp, dp, f=f)
+ names(lw1$x) <- names(dp)[order(lp)]
+ } else {
+ lw2 <- list(x=numeric(0), y=numeric(0))
+ }
+ if (length(ln)) {
+ lw2 <- lowess(ln, dn, f=f)
+ names(lw2$x) <- names(dn)[order(ln)]
+ lw2$y <- -lw2$y
+ } else {
+ lw2 <- list(x=numeric(0), y=numeric(0))
+ }
+ ans[[i]] <- list(posS = lw1, negS =lw2)
+ }
+ ans2[[j]] <- ans
+ }
+ list(ans2=ans2, lib=lib)
+})
diff --git a/R/alongChrom.R b/R/alongChrom.R
new file mode 100644
index 0000000..580a162
--- /dev/null
+++ b/R/alongChrom.R
@@ -0,0 +1,609 @@
+alongChrom <- function(eSet, chrom, specChrom, xlim, whichGenes,
+ plotFormat=c("cumulative", "local","image"),
+ xloc=c("equispaced", "physical"),
+ scale=c("none","zscale","rankscale","rangescale",
+ "zrobustscale"),
+ geneSymbols=FALSE, byStrand=FALSE,
+ colors="red", lty=1, type="S", ...) {
+
+ ## Will plot a set of exprset samples by genes of a chromosome
+ ## according to their expression levels.
+
+ ##make sure we get the full name for all args
+ xloc <- match.arg(xloc)
+ plotFormat <- match.arg(plotFormat)
+ scale <- match.arg(scale)
+
+ ## Get plotting labels
+ labEnv <- getACPlotLabs(plotFormat, chrom, xloc, scale)
+
+ ## Get the genes to display
+ usedGenes <- usedChromGenes(eSet, chrom, specChrom)
+ ## Filter out any NA positioned genes
+ usedGenes <- usedGenes[!is.na(usedGenes)]
+ ## Limit genes to requested range
+ if (!missing(xlim)) {
+ usedGenes <- limitACXRange(xlim, usedGenes)
+ }
+ geneNames <- names(usedGenes)
+ if (geneSymbols == TRUE) {
+ geneNames <- getACGeneSyms(geneNames, specChrom)
+ }
+ ## Select out requested genes
+ if (!missing(whichGenes)) {
+ nameLocs <- geneNames %in% whichGenes
+ if (!all(nameLocs)) {
+ print("Warning: Not all requested genes are displayed.")
+ }
+ usedGenes <- usedGenes[nameLocs]
+ geneNames <- names(usedGenes)
+ }
+
+ ## Handle cases where we have filter out all but 0 or 1 gene.
+ nGenes <- length(usedGenes)
+ if (nGenes == 0) {
+ emptyACPlot(chrom)
+ return()
+ }
+ else if (nGenes == 1) {
+ ## !!!! TODO: Plot the single value as is instead of this
+ x <- paste("Only gene to be plotted: ",
+ geneNames,":",as.numeric(abs(usedGenes)),sep="")
+ stop(x)
+ }
+
+ ## Get the expression data, cumulative or otherwise
+ chromExprs <- getACExprs(eSet, usedGenes, plotFormat,scale)
+
+ ## Figure out which strands each gene is on
+ strands <- ifelse(usedGenes>0,"+","-")
+
+ ## Check for duplicated positions
+ dup <- which(duplicated(abs(as.numeric(usedGenes))))
+ dup <- dup[!is.na(dup)]
+
+ dataEnv <- getACDataEnv(chromExprs, geneNames, strands,
+ byStrand, dup)
+
+ ## If image plot was requested, split off here
+ switch(plotFormat,
+ "image" = return(doACImagePlot(dataEnv, labEnv, colors)),
+ "local" = return(doACLocalPlot(dataEnv, labEnv, colors)),
+ "cumulative" = return(doACCumPlot(dataEnv, labEnv,
+ usedGenes, xloc, colors, lty, type, ...))
+ )
+}
+
+doACImagePlot <- function(dataEnv, labEnv, nCols) {
+ ## Passed in the expression matrix, the names of the
+ ## used genes, the name of the chromosome, the scaling method & the number
+ ## of colours to utilize in the plot, will generate
+ ## an image plot
+ chromExprs <- dataEnv$chromExprs
+ byStrand <- dataEnv$byStrand
+
+ ngenes <- nrow(chromExprs)
+ nsamp <- ncol(chromExprs)
+
+ ## Get the colour mapping
+ if( is.numeric(nCols) )
+ d <- dChip.colors(nCols)
+ else
+ d <- nCols
+ w <- sort(chromExprs)
+ b <- quantile(w,probs=seq(0,1,(1/length(d))))
+
+ ## retrieve the labels
+ xlab <- labEnv$xlab
+ ylab <- labEnv$ylab
+ main <- labEnv$main
+
+ ## Build the plot
+ xPoints <- 1:ngenes
+
+ if (byStrand==TRUE) {
+ strands <- dataEnv$strands
+
+ mfPar <- par(mfrow = c(2,1))
+ on.exit(par(mfPar))
+ midVal <- b[length(b)/2]
+ pos <- xPoints[which(strands == "+")]
+ neg <- xPoints[which(strands == "-")]
+ posExprs <- chromExprs
+ posExprs[neg,] <- midVal
+ negExprs <- chromExprs
+ negExprs[pos,] <- midVal
+
+ image(x=xPoints,y=1:(nsamp+1),z=posExprs, col=d, breaks=b,
+ xlab=xlab, ylab=ylab, main=main, axes=FALSE)
+ axis(2, at=1:nsamp, labels=colnames(posExprs))
+ dispACXaxis(xPoints, dataEnv, "image")
+ mtext("Plus",
+ side=3,line=0.35,outer=FALSE,at=mean(par("usr")[1:2]))
+ image(x=xPoints,y=1:(nsamp+1),z=negExprs, col=d, breaks=b,
+ xlab=xlab, ylab=ylab, axes=FALSE)
+ axis(2, at=1:nsamp, labels=colnames(chromExprs))
+ dispACXaxis(xPoints, dataEnv, "image")
+ mtext("Minus",
+ side=3,line=0.35,outer=FALSE,at=mean(par("usr")[1:2]))
+ }
+ else {
+ image(x=xPoints,y=1:(nsamp+1),z=chromExprs, col=d, breaks=b,
+ xlab=xlab, ylab=ylab, main=main, axes=FALSE)
+ axis(2, at=1:nsamp, labels=colnames(chromExprs))
+ dispACXaxis(xPoints, dataEnv, "image")
+ }
+ invisible(chromExprs)
+}
+
+doACMatPlot <- function(xPoints, dataEnv, xlim, ylim, type, lty, col,
+ labEnv, xloc, ...) {
+ xlab <- labEnv$xlab
+ ylab <- labEnv$ylab
+ main <- labEnv$main
+
+ chromExprs <- dataEnv$chromExprs
+
+ matplot(xPoints, chromExprs, xlim=xlim, ylim=ylim,type=type,
+ lty=lty, col=col, xlab=xlab,ylab=ylab, main=main,
+ xaxt="n", cex.lab=0.9,...)
+
+ dispACXaxis(xPoints, dataEnv, xloc, "cumulative")
+}
+
+doACLocalPlot <- function(dataEnv, labEnv, colors) {
+ ## retrieve the labels
+ xlab <- labEnv$xlab
+ ylab <- labEnv$ylab
+ main <- labEnv$main
+
+ envTitles <- c("chromExprs", "geneNames", "strands", "dup")
+ ## Retrieve data values
+ envVals <- mget(c(envTitles,"byStrand"),envir=dataEnv, ifnotfound=NA)
+
+ xPoints <- 1:nrow(envVals$chromExprs)
+
+ if (envVals$byStrand == TRUE) {
+ mfPar <- par(mfrow = c(2,1))
+ on.exit(par(mfPar),add=TRUE)
+ strandVals <- getACStrandVals(envVals$chromExprs,
+ envVals$strands, xPoints,
+ envVals$dup, envVals$geneNames,
+ "local")
+ multiassign(envTitles,list(strandVals$posExprs,
+ strandVals$posGen,
+ strandVals$posStr,
+ strandVals$posDup),envir=dataEnv)
+ z <- boxplot(data.frame(t(strandVals$posExprs)), plot=FALSE)
+ z$stats[,strandVals$nts] <- NA
+ bxp(z,col=colors, xaxt="n", xlab=xlab, ylab=ylab, main=main,
+ cex.lab=0.9)
+ mtext("Plus", side=3,line=0.35,outer=FALSE,
+ at=mean(par("usr")[1:2]))
+ dispACXaxis(strandVals$posPoints, dataEnv)
+ ## Now do negative
+ multiassign(envTitles,list(strandVals$negExprs,
+ strandVals$negGen,
+ strandVals$negStr,
+ strandVals$negDup),envir=dataEnv)
+ z <- boxplot(data.frame(t(strandVals$negExprs)), plot=FALSE)
+ z$stats[,strandVals$pts] <- NA
+ bxp(z,col=colors, xaxt="n", xlab=xlab, ylab=ylab, main=main,
+ cex.lab=0.9)
+ mtext("Minus", side=3,line=0.35,outer=FALSE,
+ at=mean(par("usr")[1:2]))
+ dispACXaxis(strandVals$negPoints, dataEnv)
+ }
+ else {
+ boxplot(data.frame(t(envVals$chromExprs)), col=colors, xlab=xlab,
+ ylab=ylab, main=main, cex.lab=0.9, xaxt="n")
+ dispACXaxis(xPoints, dataEnv)
+ }
+ invisible(envVals$chromExprs)
+}
+
+doACCumPlot <- function(dataEnv, labEnv, usedGenes, xloc, colors, lty, type,
+ ...) {
+ envTitles <- c("chromExprs", "dup", "geneNames", "strands",
+ "byStrand")
+ envVals <- mget(envTitles, envir=dataEnv, ifnotfound=NA)
+
+ ## Create a fictitious start & end gene to help with plots
+ start <- abs(as.numeric(usedGenes[1])) * 0.8
+ end <- abs(as.numeric(usedGenes[length(usedGenes)])) * 1.2
+ usedGenes <- c(start,usedGenes,end)
+
+ geneNames <- envVals$geneNames <- c("",envVals$geneNames,"")
+ strands <- envVals$strands <- c("",envVals$strands,"")
+ ## Also need to give them data in the chromExprs matrix
+ ## just copy data from the one next to them.
+ chromExprs <- envVals$chromExprs
+ chromExprs <- envVals$chromExprs <- rbind(chromExprs[1,],chromExprs,
+ chromExprs[nrow(chromExprs),])
+ dup <- envVals$dup <- envVals$dup + 1
+
+ multiassign(envTitles, envVals, envir=dataEnv)
+
+ ## Define the points for the X axis
+ if (xloc == "equispaced")
+ xPoints <- 1:length(usedGenes)
+ else if (xloc == "physical") {
+ xPoints <- abs(as.numeric(usedGenes)) + 1
+ xPoints <- fixACPhysPoints(xPoints, dup)
+ }
+
+ ## Get x & y ranges
+ xlim <- range(xPoints)
+ ylim <- range(chromExprs)
+ ylim[1] <- ylim[1]-0.1
+
+ ## Plot the graph
+ opar <- par(mar=c(6,5,4,1),mgp=c(4,1,0))
+ on.exit(par(opar),add=TRUE)
+
+ if (envVals$byStrand == TRUE) {
+ mfPar <- par(mfrow = c(2,1))
+ on.exit(par(mfPar),add=TRUE)
+
+ strandVals <- getACStrandVals(chromExprs, strands, xPoints, dup,
+ geneNames, "cumulative", xloc)
+
+ strandTitles <- c("chromExprs", "geneNames","strands", "dup")
+ multiassign(strandTitles,list(strandVals$posExprs,
+ strandVals$posGen,
+ strandVals$posStr,
+ strandVals$posDup),envir=dataEnv)
+ doACMatPlot(strandVals$posPoints, dataEnv, xlim=xlim, ylim=ylim,
+ type=type, lty=lty, col=colors,
+ labEnv=labEnv, xloc=xloc, ...)
+ mtext("Plus", side=3,line=0.35,outer=FALSE,
+ at=mean(par("usr")[1:2]))
+
+ multiassign(strandTitles,list(strandVals$negExprs,
+ strandVals$negGen,
+ strandVals$negStr,
+ strandVals$negDup),envir=dataEnv)
+ doACMatPlot(strandVals$negPoints, dataEnv, xlim=xlim, ylim=ylim,
+ type=type, lty=lty, col=colors, labEnv=labEnv,
+ xloc=xloc, ...)
+ mtext("Minus", side=3,line=0.35,outer=FALSE,
+ at=mean(par("usr")[1:2]))
+ }
+ else {
+ doACMatPlot(xPoints, dataEnv, xlim=xlim, ylim=ylim,
+ type=type, lty=lty, col=colors, labEnv=labEnv,
+ xloc=xloc, ...)
+ }
+ ## Create an environment that contains the necessary X & Y points
+ ## for use with identify()
+ identEnv <- new.env()
+ multiassign(c("X","Y"),list(xPoints,chromExprs),envir=identEnv)
+
+ return(identEnv)
+}
+
+getACStrandVals <- function(chromExprs, strands, xPoints, dup,
+ geneNames, plotFormat, xloc="equispaced") {
+ ## Determine which points are on the + and which on the -
+ ## strand
+ posPoints <- xPoints[strands %in% "+"]
+ negPoints <- xPoints[strands %in% "-"]
+
+ if (plotFormat == "cumulative") {
+ posExprs <- chromExprs[which(strands=="+"),]
+ negExprs <- chromExprs[which(strands=="-"),]
+ }
+ else {
+ posExprs <- negExprs <- chromExprs
+ posExprs[negPoints,] <- 0
+ negExprs[posPoints,] <- 0
+ }
+
+ if (xloc == "physical") {
+ pts <- which(xPoints %in% posPoints)
+ nts <- which(xPoints %in% negPoints)
+ posDup <- posPoints[pts %in% dup]
+ posDup <- match(posDup,posPoints)
+ negDup <- negPoints[nts %in% dup]
+ negDup <- match(negDup,negPoints)
+ }
+ else {
+ pts <- posPoints
+ nts <- negPoints
+ posDup <- dup[dup %in% pts]
+ negDup <- dup[dup %in% nts]
+ }
+
+ posGen <- geneNames[pts]
+ posStr <- strands[pts]
+ negGen <- geneNames[nts]
+ negStr <- strands[nts]
+
+ strandList <- list(posExprs=posExprs, negExprs=negExprs,
+ posPoints=posPoints, negPoints=negPoints,
+ pts=pts, nts=nts, posDup=posDup, negDup=negDup,
+ posGen=posGen, posStr=posStr, negGen=negGen,
+ negStr=negStr)
+ return(strandList)
+}
+
+dispACXaxis <- function(xPoints, dataEnv, xloc="equispaced",
+ plotFormat="local") {
+ ## Retrieve values from dataEnv
+ chromExprs <- dataEnv$chromExprs
+ geneNames <- dataEnv$geneNames
+ strands <- dataEnv$strands
+ byStrand <- dataEnv$byStrand
+ dup <- dataEnv$dup
+
+ ## Make sure that xPoints isn't exceeding our visual maximum.
+ ## If so, reduce the number of poitns to actually be displayed.
+ dispXPoints <- cullACXPoints(xPoints)
+ dispPointLocs <- match(dispXPoints,xPoints)
+
+ if (length(dup)>0)
+ highlightACDups(dispXPoints, chromExprs, dup, xloc)
+
+ if (plotFormat == "cumulative") {
+ ## Need to filter out the first and last tick
+ dispXPoints <- dispXPoints[2:(length(dispXPoints)-1)]
+ dispPointLocs <- dispPointLocs[2:(length(dispPointLocs)-1)]
+ }
+
+ axis(1, at=dispXPoints, labels = geneNames[dispPointLocs], las=2,
+ cex.axis=0.7,)
+ if (byStrand == FALSE) {
+ axis(3, at=dispXPoints, labels = strands[dispPointLocs],
+ cex.axis=0.7, tick=FALSE, mgp=c(0,0,0))
+ }
+}
+
+getACPlotLabs <- function(plotFormat, chrom, xloc, scale) {
+ labEnv <- new.env()
+
+ ylab <- switch(plotFormat,
+ "cumulative"="Cumulative expression levels",
+ "local"="Expression levels",
+ "image"="Samples"
+ )
+
+ xlab <- "Representative Genes"
+ main <- buildACMainLabel(ylab, chrom, xloc, plotFormat, scale)
+ multiassign(c("xlab","ylab","main"),c(xlab,ylab,main),envir=labEnv)
+ return(labEnv)
+}
+
+getACDataEnv <- function(chromExprs, geneNames, strands, byStrand,
+ dup) {
+ dataEnv <- new.env()
+ titles <- c("chromExprs","geneNames","strands","byStrand","dup")
+ vals <- list(chromExprs, geneNames, strands, byStrand, dup)
+ multiassign(titles, vals, envir=dataEnv)
+ return(dataEnv)
+}
+
+highlightACDups <- function(xPoints, chromExprs, dup, xloc) {
+ y <- min(chromExprs)-0.2
+
+ for (i in seq(along=dup)) {
+ ## For each dup, see if both that point and the point
+ ## before it are still in the displayed set of points
+ cur <- dup[i]
+ prev <- dup[i] - 1
+ if (xloc == "equispaced") {
+ curPt <- match(cur, xPoints)
+ prevPt <- match(prev, xPoints)
+ }
+ else {
+ curPt <- cur
+ prevPt <- prev
+ }
+ if ((!is.na(curPt))&&(!is.na(prevPt))) {
+ segments(xPoints[curPt],y,xPoints[prevPt],y, col="cyan",lwd=2)
+ }
+ }
+}
+
+fixACPhysPoints <- function(xPoints, dup) {
+ ## !!!!!
+ ## !!! Currently doing this in a very inefficient manner.
+ ## !!! needs to be smarter
+ ## !!!!!!
+
+ if (length(dup)>0) {
+ dupDiff <- c(1,diff(dup),2)
+ tmpDup <- NULL
+ for (i in 1:(length(dup)+1)) {
+ if (dupDiff[i] != 1) {
+ ## At end of dup run
+ dist <- xPoints[tmpDup[length(tmpDup)]+1] - xPoints[tmpDup[1]]
+ spacing <- dist/(length(tmpDup)+1)
+ for (j in 1:length(tmpDup)) {
+ pt <- dup[match(tmpDup[j],dup)]
+ xPoints[pt] <- xPoints[pt] + (j*spacing)
+ }
+ tmpDup <- NULL
+ }
+ tmpDup <- c(tmpDup,dup[i])
+ }
+ }
+ return(xPoints)
+}
+
+buildACMainLabel <- function(ylab, chrom, xloc, plotFormat, scale) {
+ if ((xloc == "physical")&&(plotFormat=="cumulative")) {
+ main <- paste(ylab, "in chromosome", chrom,
+ "by relative position\n")
+ }
+ else {
+ main <- paste(ylab, "by genes in chromosome", chrom, "\n")
+ }
+
+ main <- paste(main,"scaling method:",scale,"\n")
+
+ return(main)
+}
+
+limitACXRange <- function(xlim, usedGenes) {
+
+ if (!missing(xlim)) {
+ if (length(xlim) == 2) {
+ if (is.character(xlim)) {
+ ## If a pair of gene names are provided, get hteir
+ ## locations, and then use them as the xlim values.
+ xlim[1] <- as.numeric(usedGenes[xlim[1]])
+ xlim[2] <- as.numeric(usedGenes[xlim[2]])
+ if ((is.na(xlim[1]))|(is.na(xlim[2]))) {
+ print("Error: Bad xlim parameters provided.")
+ xlim[1] = 0
+ xlim[2] = 0
+ usedGenes <- NULL
+ }
+ ## Place them in proper numerical order
+ xlim <- xlim[order(xlim)]
+ }
+ ## At this point, we're dealing with a pair of numerical
+ ## values to denote the location range (in base pairs).
+ ## Ensure that the max is > than the min, then pick out
+ ## the remaining genes
+ if (xlim[2] > xlim[1]) {
+ lowLim <- match(xlim[1],usedGenes)
+ if (is.na(lowLim)) {
+ lowLim <- getACClosestPos(xlim[1],usedGenes)
+ }
+
+ hiLim <- match(xlim[2], usedGenes)
+ if (is.na(hiLim)) {
+ hiLim <- getACClosestPos(xlim[2],usedGenes)
+ }
+
+ subs <- seq(lowLim,hiLim)
+ usedGenes <- usedGenes[subs]
+ }
+ else {
+ print("Error: Bad xlim parameters provided.")
+ usedGenes <- NULL
+ }
+ }
+ else {
+ print("Error: Bad xlim parameters provided.")
+ usedGenes <- NULL
+ }
+ }
+
+ return(usedGenes)
+}
+
+getACGeneSyms <- function(affys, chrObj) {
+ syms <- mget(affys, envir=geneSymbols(chrObj), ifnotfound=NA)
+ syms[is.na(syms)] <- affys[is.na(syms)]
+ return(as.character(syms))
+}
+
+getACClosestPos <- function(val, usedGenes) {
+ ## Given a value, finds the closest value in usedGenes to the
+ ## passed value and returns its location in the usedGenes vector
+
+ dists <- abs(val-abs(as.numeric(usedGenes)))
+ closest <- match(min(dists), dists)
+ return(closest)
+}
+
+scaleACData <- function(chromData,
+ method=c("none","zscale","rangescale","rankscale",
+ "zrobustscale"))
+{
+ ## Will scale the data set to be plotted based on a variety of
+ ## methods
+
+ method <- match.arg(method)
+ if (method != "none") {
+ for (i in 1:nrow(chromData)) {
+ x <- chromData[i,]
+ if (method == "zscale") {
+ chromData[i,] <- (x - mean(x))/sd(x)
+ }
+ else if (method == "rangescale") {
+ curRange <- range(x)
+ chromData[i,] <- (x - curRange[1])/(curRange[2] - curRange[1])
+ }
+ else if (method == "rankscale") {
+ chromData[i,] <- rank(x)
+ }
+ else if (method == "zrobustscale") {
+ chromData[i,] <- (x - median(x))/mad(x)
+ }
+ else {
+ stmt <- paste("method:", method, ", is not implemented yet")
+ stop(stmt)
+ }
+ }
+ }
+
+ return(chromData)
+}
+
+cullACXPoints <- function(xPoints) {
+ ## Will reduce the xPoints vector to a visibly manageable size
+ ## Currently if the size > 40, will leave every Nth point where
+ ## xPoints/maxSize = N. Maximum number of points is determined
+ ## by determining the size of the label text and filling up 65%
+ ## of the axis space with labels.
+
+ ## First get the size of the plotting region
+ preg <- par('pin')[1] * 0.65
+ ## Now get the font size
+ strsize <- strheight("test",units="inches")
+ ## Calculate the maxSize
+ maxSize <- preg %/% strsize
+
+ if (length(xPoints) > maxSize) {
+ ## Calculate N, and then get the maxSize elements from every
+ ## Nth element. Problem: Sometiems will generate a few extra
+ ## due to integer division on N.
+ N <- length(xPoints) %/% maxSize
+
+ ## Start from 2 for now as a hack to keep from getting 0th
+ ## entity, which throws off the labeling.
+ keep <- seq(1,length(xPoints),N)
+
+ xPoints <- xPoints[keep]
+ }
+
+ return(xPoints)
+}
+
+emptyACPlot <- function(chrom) {
+ plot.new()
+ axis(1, at=c(0,0.2, 0.4, 0.6,0.8,1), labels=rep("NA",6))
+ axis(2, at=c(0,0.2, 0.4, 0.6,0.8,1),labels=rep("NA",6))
+ main <- paste("Plot empty, no genes from chromosome",chrom,
+ "in ExpressionSet provided.\n")
+
+ title(main = main)
+}
+
+getACExprs <- function(eSet, usedGenes,
+ plotFormat=c("cumulative","local", "image"),
+ scale=c("none","zscale","rangescale","rankscale", "zrobustscale"))
+{
+ ## Will get the expression data for the given genes out of the
+ ## expr set. If plotFormat is set to cumulative, will generate the
+ ## cumulative sum of this data across the genes.
+
+ ## Split out only the genes on the desired chrom from the exprset
+ plotFormat <- match.arg(plotFormat)
+ scale <- match.arg(scale)
+
+ chromExprs <- exprs(eSet)[names(usedGenes),]
+
+ chromExprs <- scaleACData(chromExprs,scale)
+
+ if (plotFormat == "cumulative") {
+ chromExprs <- t(chromExprs)
+ ## Fill the matrix with the cumulative sum of the expression
+ chromExprs <- apply(chromExprs, 1, cumsum)
+ }
+
+ return(chromExprs)
+}
diff --git a/R/amplicon.plot.R b/R/amplicon.plot.R
new file mode 100644
index 0000000..217c7c0
--- /dev/null
+++ b/R/amplicon.plot.R
@@ -0,0 +1,86 @@
+##a function to get the chromosome order
+
+make.chromOrd <- function(genome, gnames) {
+ if(!is.character(genome) && length(genome != 1 ) )
+ stop("need a character vector indicating the genome")
+ require("annotate") || stop("need the annotate package")
+
+ clname <- paste(genome, "chroloc", sep="")
+ do.call(data, list(clname))
+ allGcrloc <- mget(gnames, envir=get(clname), ifnotfound=NA)
+ myfun <- function(x) min(as.numeric(x))
+ allGcloc <- sapply(allGcrloc, myfun)
+
+ dname <- paste(genome, "chrom", sep="")
+ if( !exists(dname, mode="environment") )
+ do.call(data, list(dname))
+ whichChrom <- unlist(mget(gnames, envir=get(dname), ifnotfound=NA))
+ byChr.cloc <- split(allGcloc, whichChrom)
+ nchrom <- length(byChr.cloc)
+ byChr.ord <- vector("list", length=nchrom)
+ for(i in 1:nchrom ) byChr.ord[[i]] <- order(byChr.cloc[[i]])
+ names(byChr.ord) <- names(byChr.cloc)
+ byChr.ord$"NA" <- NULL
+ byChr.ord
+}
+
+##actually do the amplicon plotting
+
+amplicon.plot <- function(ESET, FUN, genome="hgu95A" ) {
+ print("this will take a few seconds")
+ tests <- esApply(ESET, 1, FUN)
+ tests.pvals <- sapply(tests, function(x) x$p.value)
+ tests.stats <- sapply(tests, function(x) x$statistic)
+
+ dname <- paste(genome, "chrom", sep="")
+ if( !exists(dname, mode="environment") )
+ do.call(data, list(dname))
+
+ whichChrom <- unlist(mget(featureNames(ESET), envir=get(dname),
+ ifnotfound=NA))
+ ##split these by chromosome
+ byChr.pv <- split(tests.pvals, whichChrom)
+ byChr.stat <- split(tests.stats, whichChrom)
+
+ byChr.pv$"NA" <- NULL
+ byChr.stat$"NA" <- NULL
+
+ chromOrd <- make.chromOrd(genome, featureNames(ESET))
+ nchrom <- length(chromOrd)
+
+ #get the names of the chromosome and their order
+ #for plotting
+ chromNames <- paste(genome, "chromNames", sep="")
+ if( !exists(chromNames, mode="environment") )
+ do.call(data, list(chromNames))
+ geneOrd <- get(chromNames)
+
+ chromOrd <- chromOrd[geneOrd]
+ byChr.pv <- byChr.pv[geneOrd]
+ byChr.stat <- byChr.stat[geneOrd]
+
+ print("patience.....")
+ chrlens <- sapply(chromOrd, length)
+
+ collist <- vector("list", length=nchrom)
+ for(i in 1:nchrom) {
+ smp <- ifelse(byChr.pv[[i]] < 0.05, 1, 0)
+ dir <- byChr.stat[[i]]*smp
+ cols <- ifelse(dir == 0 , 2, 3)
+ cols <- ifelse(dir < 0, 1, cols)
+ collist[[i]] <- cols[chromOrd[[i]]]
+ }
+
+ ncols <- vector("list", length=nchrom)
+ maxlen <- max(chrlens)
+ for(i in 1:nchrom) {
+ extras<- maxlen - chrlens[i]
+ ncols[[i]]<- c(collist[[i]], rep(2, extras))
+ }
+ z<- data.frame(ncols)
+ z<- as.matrix(z)
+ image(1:maxlen, 1:nchrom, z, col=c("blue","white", "red"),
+ xlab="Gene location", ylab="Chromosome", axes=FALSE )
+ axis(2, at = 1:nchrom, labels=names(byChr.pv))
+}
+
diff --git a/R/cPlot.R b/R/cPlot.R
new file mode 100644
index 0000000..c6d7681
--- /dev/null
+++ b/R/cPlot.R
@@ -0,0 +1,112 @@
+## cPlot.R
+.plotData <- function(chromNum, locs, xPoints, chromLens, fg,
+ scale = c("relative","max"),glen=0.4, ...)
+{
+ ## Get the scaling factor
+ scale <- match.arg(scale)
+
+ scaledX <- cScale(xPoints, chromLens, scale, chromNum)
+
+ nlocs <- length(locs)
+
+ ## APply the scaling factor to the x positions
+ cNum <- match(chromNum, names(chromLens))
+ locs <- locs*scaledX
+ if (length(locs) == 0) {
+ if (scale == "relative")
+ return()
+ }
+ else {
+ ## Determine the direction of the Y plot (+ or -)
+ ypos <- rep(cNum, nlocs)
+ ytop <- ifelse(locs>0, ypos+glen, ypos-glen)
+
+ ## Plot
+ segments(abs(locs), ypos, abs(locs), ytop, col=fg, ...)
+
+ ## Drawn last to ensure that that the lines are actually displayed
+ }
+ if (scale == "max") {
+ lines(c(1,xPoints-1),c(cNum,cNum),col="blue")
+ }
+ else {
+ lines(c(1,max(abs(locs[!is.na(locs)]))),c(cNum,cNum),col="blue")
+ }
+}
+
+cColor <- function(probes, color, plotChroms,
+ scale=c("relative","max"), glen=0.4, ...) {
+ ## Passed a vector of probe names, a color and an instance of a
+ ## chromLocation class. Will recolor the specific probes in the
+ ## cPlot created plot to match the specified color. Scale should
+ ## be the same as the scale from cPlot
+ scale <- match.arg(scale)
+ xPoints <- 1000
+
+ gc <- unlist(mget(probes,envir=probesToChrom(plotChroms), ifnotfound=NA))
+ gchr <- split(names(gc),gc)
+ cchr <- split(color[rep(seq_along(color), len=length(gc))], gc)
+ gchr[["NA"]] <- cchr[["NA"]] <- NULL
+
+ ## Look up the locations of these probes in each chromosome,
+ ## plotting any results.
+ locList <- chromLocs(plotChroms)
+ lens <- chromLengths(plotChroms)
+ names(lens) <- chromNames(plotChroms)
+
+ sel <- (names(gchr)%in% names(locList))
+ chrToDo <- names(gchr)[sel]
+ if(!all(sel))
+ warning(sprintf("No locations available for probes on chromosome%s %s",
+ c("", "s")[1+(sum(!sel)>1)],
+ names(gchr)[!sel]))
+
+ for (cName in chrToDo) {
+ locs <- locList[[cName]][gchr[[cName]]]
+ locs <- as.numeric(locs[!is.na(locs)])
+ if (length(locs) > 0) {
+ .plotData(cName, locs, xPoints, lens,
+ fg=cchr[[cName]], scale, glen, ...)
+ }
+ }
+}
+
+
+cPlot <- function(plotChroms, useChroms=chromNames(plotChroms),
+ scale=c("relative", "max"), fg="white",
+ bg="lightgrey", glen=0.4, xlab="", ylab="Chromosome",
+ main = organism(plotChroms), ...) {
+ ## Passed an instance of a chromLocation class, and the number of
+ ## points to represent on the X axis, will utilize that data
+ ## to plot a set of genes on their proper chromosome locations.
+ scale <- match.arg(scale)
+
+ xPoints <- 1000
+
+ chromNames <- chromNames(plotChroms)
+ labs <- chromNames[chromNames %in% useChroms]
+
+ lens <- chromLengths(plotChroms)
+ whichLabs <- chromNames %in% labs
+ lens <- lens[whichLabs]
+ names(lens) <- chromNames[whichLabs]
+
+ ## Build the initial plot structure
+ op <- par(bg=bg)
+ plot(c(1, xPoints), c(1-glen,length(labs)+glen), type="n", xlab=xlab,
+ ylab=ylab, axes=FALSE, las=2, main=main)
+ par(op)
+
+ axis(2, c(1:length(labs)), labs, las=2)
+
+ chromLocs <- chromLocs(plotChroms)
+ byChroms <- chromLocs[labs]
+
+ for (cName in labs) {
+ .plotData(cName,byChroms[[cName]], xPoints,
+ lens, fg, scale, glen, ...)
+ }
+}
+
+
+
diff --git a/R/cScale.R b/R/cScale.R
new file mode 100644
index 0000000..d081e2f
--- /dev/null
+++ b/R/cScale.R
@@ -0,0 +1,21 @@
+# cScale.R
+# Used to calculate scaling on the geneplots
+# Uses the vector of chromosome lengths and returns a vector
+# of scales.
+
+cScale <- function(points, cLengths, method=c("max","relative"),
+ chrom) {
+# Passed points - the number of points to scale the chromosomes too
+# and cLengths - a vector of chromosome lengths.
+
+ method <- match.arg(method)
+
+ if (method == "max") {
+ cScales <- points / cLengths[chrom];
+ }
+ else {
+ cScales <- points / max(cLengths)
+ }
+
+ return(cScales);
+}
diff --git a/R/gplotter.R b/R/gplotter.R
new file mode 100644
index 0000000..957fa94
--- /dev/null
+++ b/R/gplotter.R
@@ -0,0 +1,30 @@
+#copyright R. Gentleman, 2001, all rights reserved
+#functions/ methods to plot microarray data
+
+#Cheng Li's Red/Blue color scheme
+
+dChip.colors <- function(n) GetColor(seq(-3,3,6/n))
+
+greenred.colors <- function(n) GetColor(seq(-3,3,6/n), GreenRed=TRUE)
+
+GetColor <- function(value, GreenRed=FALSE, DisplayRange=3) {
+ RGB <- function(x,y,z) rgb(x/255,y/255,z/255)
+ missing <- is.na(value)
+ good <- value[!missing]
+ ans <- value
+ if ( GreenRed )
+ ans[missing] <- RGB(0, 0, 0)
+ else
+ ans[missing] <- RGB(255, 255, 255)
+ tone <- abs(good) / DisplayRange * 255 + .5;
+ tone[tone > 255] <- 255
+
+ #classical: red and green on black background
+ if (GreenRed)
+ tone <- ifelse(good > 0, RGB(tone, 0, 0), RGB(0, tone, 0))
+ else
+ tone <- ifelse(good > 0, RGB(255, 255 - tone, 255 - tone),
+ RGB(255 - tone, 255 - tone, 255) )
+ ans[!missing]<-tone
+ ans
+}
diff --git a/R/groupedHeatmap.R b/R/groupedHeatmap.R
new file mode 100644
index 0000000..d73e688
--- /dev/null
+++ b/R/groupedHeatmap.R
@@ -0,0 +1,64 @@
+groupedHeatmap = function(
+ z, frow, fcol,
+ fillcolours = c("#2166ac","#4393c3","#92c5de","#d1e5f0","#fefefe","#fddbc7","#f4a582","#d6604d","#b2182b"),
+ bordercolour = "#e0e0e0",
+ zlim = range(z, na.rm=TRUE)) {
+
+ ## Define set of vertical and horizontal
+ ## lines along which the plot is organised
+ ## s: a character vector with the strings for the labels of the
+ ## *other* coordinate axis
+ ## g: a factor with groups
+ makecoords = function(s, g) {
+ stopifnot(is.factor(g))
+ x0 = if(is.null(s)) unit(0, "npc") else max(convertUnit(stringWidth(s), "mm"))
+ wx = unit(1, "npc") - x0
+ gapsize = 0.5
+ dx = wx* ( 1 / (nlevels(g)*gapsize + length(g) -0.5) )
+ return(list(
+ pos = x0 + ((0L:(length(g)-1L))+(as.integer(g)-1L)*gapsize+0.5) * dx,
+ delta = dx) )
+ }
+
+ ## map data values into fillcolours
+ colourMap = function(z, numColours = 201, na.colour="#ffffff"){
+ colores = colorRampPalette(fillcolours)(numColours)
+ i = as.integer(round( (z-zlim[1]) / diff(zlim) * numColours) )
+ i[i<1L] = 1L
+ i[i>numColours] = numColours
+ list(fill = ifelse(is.na(z), na.colour, colores[i]),
+ col = ifelse(is.na(z), na.colour,
+ if (is.null(bordercolour)||is.na(bordercolour)) colores[i] else bordercolour))
+ }
+
+ if(missing(frow)) {
+ frow = factor(rep(1L, nrow(z)))
+ } else {
+ o = order(frow)
+ z = z[o, ]
+ frow = frow[o]
+ }
+
+ if(missing(fcol)) {
+ fcol = factor(rep(1L, ncol(z)))
+ } else {
+ o = order(fcol)
+ z = z[, o]
+ fcol = fcol[o]
+ }
+
+ textx = if(is.null(colnames(z))) NULL else paste(colnames(z), "", sep=" ")
+ texty = if(is.null(rownames(z))) NULL else paste(rownames(z), "", sep=" ")
+
+ cx = makecoords(s=texty, g=fcol)
+ cy = makecoords(s=textx, g=frow)
+ x = cx$pos
+ y = cy$pos
+
+ grid.rect(x = x[rep(seq(along=x), each =length(y))], width = cx$delta,
+ y = y[rep(seq(along=y), times =length(x))], height = cy$delta,
+ just = c(0.5,0.5), gp = do.call(gpar, colourMap(z)))
+
+ if(!is.null(textx)) grid.text(textx, x=x, y=y[1]-0.5*cy$delta, just=c("right", "center"), rot=90)
+ if(!is.null(texty)) grid.text(texty, x=x[1]-0.5*cx$delta, y=y, just=c("right", "center"))
+}
diff --git a/R/histStack.R b/R/histStack.R
new file mode 100644
index 0000000..1a6b930
--- /dev/null
+++ b/R/histStack.R
@@ -0,0 +1,19 @@
+histStack <- function(x, breaks, breaksFun=paste, ylab="frequency", ...) {
+ if(!is.list(x))
+ stop("'x' must be a list.")
+ bars <- NULL
+ for (i in 1:length(x)) {
+ if(!is.numeric(x[[i]]))
+ paste("Element", i, "of 'x' is not numeric.")
+ h <- hist(x[[i]], breaks=breaks, plot=FALSE)
+ bars <- rbind(bars, h$counts)
+ }
+
+ barplot(bars, names.arg=NULL, space=0, ylab=ylab, ...)
+
+ at = seq(along=h$breaks)-1
+ modulo = ceiling(length(at)/10)
+ sel = (at %% modulo == 0)
+ axis(side=1,at=at[sel],labels=breaksFun(h$breaks)[sel])
+
+}
diff --git a/R/imageMap.R b/R/imageMap.R
new file mode 100644
index 0000000..4933832
--- /dev/null
+++ b/R/imageMap.R
@@ -0,0 +1,31 @@
+setGeneric("imageMap", function(object, con, tags, imgname, ...)
+ standardGeneric("imageMap"))
+
+
+setMethod("imageMap",
+ signature=signature(object="matrix", con="connection", tags="list",
+ imgname="character"),
+ definition=function(object, con, tags, imgname) {
+
+ if(!is.matrix(object)||ncol(object)!=4)
+ stop("'object' must be a matrix with 4 columns.")
+
+ for(i in seq(along=tags))
+ if(length(tags[[i]])!=nrow(object))
+ stop(paste("'tags[[", i, "]] must have as many elements as 'object' has rows (",
+ nrow(object),").", sep=""))
+
+ mapname <- paste("map", gsub(" |/|#", "_", imgname), sep="_")
+ base::writeLines(paste("<IMG SRC=\"", imgname, "\" USEMAP=\"#", mapname, "\" BORDER=0/>",
+ "<MAP NAME=\"", mapname, "\">", sep=""), con)
+ for(i in 1:nrow(object)) {
+ out = paste("<AREA SHAPE=\"rect\" COORDS=\"", paste(object[i,], collapse=","),
+ "\"", sep="")
+ for(t in seq(along=tags))
+ out = paste(out, " ", names(tags)[t], "=\"", tags[[t]][i], "\"", sep="")
+ out = paste(out, ">", sep="")
+ base::writeLines(out, con)
+ }
+ base::writeLines("</MAP>", con)
+} ## end of definition
+) ## end of setMethod
diff --git a/R/multiecdf.R b/R/multiecdf.R
new file mode 100644
index 0000000..d6cb124
--- /dev/null
+++ b/R/multiecdf.R
@@ -0,0 +1,173 @@
+multiecdf = function(x, ...)
+ UseMethod("multiecdf")
+multidensity = function(x, ...)
+ UseMethod("multidensity")
+
+
+multiecdf.formula = function(formula, data = NULL,
+ xlab,
+ na.action = NULL,
+ ...) {
+
+ if(missing(xlab))
+ xlab = deparse(substitute(formula))
+ if(missing(formula) || (length(formula) != 3))
+ stop("'formula' missing or incorrect")
+ m = match.call(expand.dots = FALSE)
+ if(is.matrix(eval(m$data, parent.frame())))
+ m$data = as.data.frame(data)
+ m$... = m$xlab = NULL
+ m$na.action = na.action ## force use of default for this method
+ m[[1]] = as.name("model.frame")
+ mf = eval(m, parent.frame())
+ response = attr(attr(mf, "terms"), "response")
+ multiecdf(split(mf[[response]], mf[-response]), xlab=xlab, ...)
+}
+
+multidensity.formula = function(formula, data = NULL,
+ xlab,
+ na.action = NULL,
+ ...){
+
+ if(missing(xlab))
+ xlab = deparse(substitute(formula))
+ if(missing(formula) || (length(formula) != 3))
+ stop("'formula' missing or incorrect")
+ m = match.call(expand.dots = FALSE)
+ if(is.matrix(eval(m$data, parent.frame())))
+ m$data = as.data.frame(data)
+ m$... = m$xlab = NULL
+ m$na.action = na.action ## force use of default for this method
+ m[[1]] = as.name("model.frame")
+ mf = eval(m, parent.frame())
+ response = attr(attr(mf, "terms"), "response")
+ multidensity(split(mf[[response]], mf[-response]), xlab=xlab, ...)
+}
+
+
+multiecdf.matrix = function(x, xlab, ...) {
+ if(missing(xlab))
+ xlab = deparse(substitute(x))
+ l = lapply(seq_len(ncol(x)), function(j) x[,j])
+ names(l) = colnames(x)
+ multiecdf(l, xlab=xlab, ...)
+}
+
+multidensity.matrix = function(x, xlab, ...) {
+ if(missing(xlab))
+ xlab = deparse(substitute(x))
+ l = lapply(seq_len(ncol(x)), function(j) x[,j])
+ names(l) = colnames(x)
+ multidensity(l, xlab=xlab, ...)
+}
+
+multiecdf.data.frame = function(x, xlab, ...) {
+ if(missing(xlab))
+ xlab = deparse(substitute(x))
+ multiecdf.list(x, xlab=xlab, ...)
+}
+
+multidensity.data.frame = function(x, xlab, ...) {
+ if(missing(xlab))
+ xlab = deparse(substitute(x))
+ multidensity.list(x, xlab=xlab, ...)
+}
+
+multiecdf.list = function(x,
+ xlim,
+ col = brewer.pal(9, "Set1"),
+ main = "ecdf",
+ xlab,
+ do.points = FALSE,
+ subsample = 1000L,
+ legend = list(
+ x = "right",
+ legend = if(is.null(names(x))) paste(seq(along=x)) else names(x),
+ fill = col),
+ ...) {
+
+ if(missing(xlab))
+ xlab = deparse(substitute(x))
+
+ stopifnot(length(x)>=1, length(subsample)==1)
+
+ if(is.logical(subsample))
+ subsample = if(subsample) 1000L else 0L
+ stopifnot(is.numeric(subsample))
+ if( (!is.na(subsample)) && (subsample>0) )
+ for(i in seq(along=x))
+ if(length(x[[i]])>subsample)
+ x[[i]] = x[[i]][sample(1:length(x[[i]]), subsample)]
+
+ ef = lapply(x, ecdf)
+ if(missing(xlim))
+ xlim = range(unlist(x), na.rm=TRUE)
+ plot(ef[[1]], xlim=xlim, xlab=xlab, main=main, col=col[1], do.points=do.points, ...)
+ m = match.call(expand.dots = FALSE) # avoid warnings for invalid arguments
+ m$... = m$...[!names(m$...) %in% c("main", "xlab", "ylab", "ylim")]
+
+ for(j in seq(along=ef)[-1]) {
+ mycol = col[1+((j-1)%%length(col))]
+ args = c(list(x=ef[[j]], col=mycol, do.points=do.points), m$...)
+ do.call(lines, args)
+ }
+
+ if(is.list(legend))
+ do.call(graphics::legend, legend)
+
+ invisible(ef)
+}
+
+multidensity.list = function(x,
+ bw = "nrd0",
+ xlim,
+ ylim,
+ col = brewer.pal(9, "Set1"),
+ main = if(length(x)==1) "density" else "densities",
+ xlab,
+ lty = 1L ,
+ legend = list(
+ x = "topright",
+ legend = if(is.null(names(x))) paste(seq(along=x)) else names(x),
+ fill = col),
+ density = NULL,
+ ...) {
+
+ ## process argument 'xlab'
+ if(missing(xlab))
+ xlab = deparse(substitute(x))
+
+ ## process argument 'bw':
+ if(length(bw)==1)
+ bw = rep(bw, length(x))
+ if(length(bw)!=length(x))
+ stop("'length(bw)' needs to be either 1 or the same as 'length(x)'.")
+
+ ## process argument 'x'
+ stopifnot(length(x)>=1)
+ if(missing(xlim))
+ xlim = range(unlist(x), na.rm=TRUE)
+ x = lapply(x, function(z) z[(z>=xlim[1]) & (z<=xlim[2])])
+
+ ef = vector(mode="list", length=length(x))
+ for(j in seq(along=x))
+ ef[[j]] = do.call(stats::density, c(list(x=x[[j]], na.rm=TRUE, bw=bw[j]), density))
+
+ if(missing(ylim))
+ ylim = range(unlist(lapply(ef, "[[", "y")), na.rm=TRUE)
+
+ plot(ef[[1]], xlim=xlim, ylim=ylim, xlab=xlab, main=main, col=col[1], lty=lty[1], ...)
+ m = match.call(expand.dots = FALSE) ## avoid warnings for invalid arguments
+ m$... = m$...[!names(m$...) %in% c("main", "xlab", "ylab", "ylim")]
+ for(j in seq(along=ef)[-1]) {
+ args = c(list(x=ef[[j]]), col=col[1+((j-1)%%length(col))],
+ lty=lty[1+((j-1)%%length(lty))], m$...)
+ do.call(lines, args)
+ }
+
+ if(is.list(legend))
+ do.call(graphics::legend, legend)
+
+ invisible(ef)
+}
+
diff --git a/R/openHtmlPage.R b/R/openHtmlPage.R
new file mode 100644
index 0000000..b2b5b55
--- /dev/null
+++ b/R/openHtmlPage.R
@@ -0,0 +1,14 @@
+openHtmlPage = function(name, title="") {
+ name = gsub("\\.html$", "", name)
+ con = file(paste(name, ".html", sep=""), open="wt")
+ writeLines(paste("<html><head><title>", title,
+ "</title></head><body style=\"font-family: ",
+ "helvetica,arial,sans-serif;\">", sep=""), con)
+ return(con)
+}
+
+closeHtmlPage = function(con) {
+ writeLines("</body></html>", con)
+ close(con)
+}
+
diff --git a/R/plotChr.R b/R/plotChr.R
new file mode 100755
index 0000000..38cf2d0
--- /dev/null
+++ b/R/plotChr.R
@@ -0,0 +1,113 @@
+plotChr <- function(chrN, senseObj,
+ cols=rep("black", length(senseObj[[1]])),log=FALSE,
+ xloc = c("equispaced", "physical"), geneSymbols=FALSE,
+ ngenes=20, lines.at=NULL, lines.col="red") {
+ # lines of +/- stands of a chromosome for a given sample:
+ linesStrand <- function(smooths, col="black", log=FALSE,
+ smX=NULL) {
+ if (is.null(smX)) {
+ sm.px <- smooths$pos$x
+ sm.nx <- smooths$neg$x
+ } else {
+ sm.px <- smX[1:length(smooths$pos$x)]
+ sm.nx <- smX[-(1:length(smooths$pos$x))]
+ }
+ if( log ) {
+ lines(sm.px, log(smooths$pos$y), col=col)
+ lines(sm.nx, -log(-smooths$neg$y), col=col)
+ }
+ else {
+ lines(sm.px, smooths$pos$y, col=col)
+ lines(sm.nx, smooths$neg$y, col=col)
+ }
+ }
+ xloc <- match.arg(xloc)
+ ans2 <- senseObj$ans2
+ ## Only plot if we have data
+ numPos <- length(ans2[[1]][[chrN]]$posS$y)
+ numNeg <- length(ans2[[1]][[chrN]]$negS$y)
+ if (numPos < 2)
+ stop("Less than two data points for positive strand on chromosome ",
+ chrN)
+ if (numNeg < 2)
+ stop("Less than two data points for negative strand on chromosome ",
+ chrN)
+ if (numPos < 20 || numNeg < 20)
+ warning("Less than 20 genes annotated on chromosome ", chrN,
+ ".\nConsider using a heatmap instead.")
+ libCHRLENGTHS <- get(paste(senseObj$lib,"CHRLENGTHS",sep=""))
+ chrRange <- function(chrN) {
+ mn <- min(sapply(ans2, function(x) min(x[[chrN]]$negS$y)))
+ mx <- max(sapply(ans2, function(x) max(x[[chrN]]$posS$y)))
+ c(mn, mx)
+ }
+ xlims <- c(0, libCHRLENGTHS[chrN])
+ ylims <- chrRange(chrN)
+ if( log ) {
+ ylims[1] <- -log(-ylims[1])
+ ylims[2] <- log(ylims[2])
+ }
+ at.px <- ans2[[1]][[chrN]]$pos$x
+ at.nx <- ans2[[1]][[chrN]]$neg$x
+ X <- c(at.px, at.nx)
+ uX <- !duplicated(X)
+ every <- sum(uX) %/% ngenes
+ if (!isTRUE(every >= 1)) every <- 1
+ ind.seq <- seq(1,sum(uX),by=every)
+ repGx <- sort(X[uX])[ind.seq]
+ probes <- names(X[uX])[order(X[uX])][ind.seq]
+ if (xloc=="equispaced") {
+ repGx <- 1:length(repGx)
+ names(repGx) <- probes
+ xlims <- c(1, length(repGx))
+ }
+ # probe density:
+ if (xloc=="equispaced") {
+ if (length(at.px) > 1)
+ at.px <- approx(sort(X[uX])[ind.seq],repGx, xout=at.px)$y
+ if (length(at.nx) > 1)
+ at.nx <- approx(sort(X[uX])[ind.seq],repGx, xout=at.nx)$y
+ smX <- c(at.px, at.nx)
+ } else smX <- NULL
+ opar <- par(mar = c(6, 5, 4, 1), mgp = c(4, 1, 0))
+ on.exit(par(opar), add = TRUE)
+ if (log == TRUE)
+ yLab <- "Smoothed Expression (log)"
+ else
+ yLab <- "Smoothed Expression"
+ plot(1,1, type="n", xlim=xlims, ylim=ylims, cex.lab=0.9,
+ xlab="Representative Genes",
+ ylab=yLab, main=paste("Chromosome",chrN),
+ xaxt="n", yaxt="n")
+ yticks <- pretty(c(0,ylims), 5)
+ axis(2, at=yticks, labels=abs(yticks))
+ abline(h=0, col="gray")
+ if (length(at.nx))
+ axis(1, at=at.nx, pos=0, tck=-0.01,col="gray", labels=FALSE)
+ else
+ warning("No values on negative strand for chromosome ", chrN)
+ if (length(at.px))
+ axis(1, at=at.px, pos=0, tck=0.01,col="gray", las=3, labels=FALSE)
+ else
+ warning("No values on positive strand for chromosome ", chrN)
+ # label representative genes:
+ labs <- probes
+ if(geneSymbols) labs <- unlist(mget(labs,
+ envir=get(paste(senseObj$lib,"SYMBOL",sep="")), ifnotfound=NA))
+ axis(1, at=repGx, labels=labs,las=3, cex.axis=.7)
+ for(i in 1:length(ans2))
+ linesStrand(ans2[[i]][[chrN]], cols[i], log, smX=smX)
+ if (!is.null(lines.at)) {
+ lineXs <- unlist(mget(lines.at,
+ envir=get(paste(senseObj$lib,"CHRLOC",sep="")),
+ ifnotfound=NA))
+ lineXs <- abs(lineXs)
+ if(any(is.na(lineXs)))
+ warning("wrong probe names: ",
+ paste(names(lineXs)[is.na(lineXs)]))
+ if (xloc=="equispaced")
+ lineXs <- approx(sort(X[uX])[ind.seq],repGx, xout=lineXs)$y
+ abline(v=lineXs, col=lines.col)
+ }
+}
+
diff --git a/R/plotExpression.R b/R/plotExpression.R
new file mode 100644
index 0000000..66c0f33
--- /dev/null
+++ b/R/plotExpression.R
@@ -0,0 +1,56 @@
+plotExpressionGraph <- function(graph, nodeEGmap, exprs, ENTREZIDenvir,
+ mapFun, log=FALSE, nodeAttrs=list(), ...) {
+ require("Rgraphviz") || stop("Requires Rgraphviz to continue")
+ .plot.graph <- selectMethod("plot", "graph")
+
+ envll <- unlist(contents(ENTREZIDenvir))
+ graphEGs <- unlist(lapply(nodeEGmap, function(x){x[1]}))
+ graphAffys <- names(envll)[envll %in% graphEGs]
+
+ if (missing(mapFun))
+ mapFun <- defMapFun
+
+ cols <- getPlotExpressionColors(graphAffys, exprs, mapFun, log)
+
+ ## Vector of colors w/ affy's as names - need SYMs
+ colAffys <- names(cols)
+ colEGs <- envll[colAffys]
+ colSyms <- names(graphEGs[graphEGs %in% colEGs])
+ names(cols) <- colSyms
+ nodeAttrs$fillcolor <- cols
+
+ .plot.graph(graph, nodeAttrs=nodeAttrs, ...)
+}
+
+
+getPlotExpressionColors <- function(graphAffys, exprs, mapFun, log=FALSE) {
+
+ if (missing(mapFun))
+ mapFun <- defMapFun
+
+ affyCols <- mapFun(exprs, log)
+
+ affyCols[names(affyCols) %in% graphAffys]
+}
+
+defMapFun <- function(exprs, log=FALSE) {
+ part1 <- 100
+ part2 <- 500
+
+ if (log) {
+ part1 <- log2(part1)
+ part2 <- log2(part2)
+ }
+
+ cols <- unlist(lapply(exprs, function(x) {
+ if (x <= part1)
+ "blue"
+ else if (x <= part2)
+ "green"
+ else
+ "red"
+ }))
+
+ cols
+}
+
diff --git a/R/plotMA.R b/R/plotMA.R
new file mode 100644
index 0000000..6f2e556
--- /dev/null
+++ b/R/plotMA.R
@@ -0,0 +1,20 @@
+setMethod( "plotMA", signature( object="data.frame" ),
+function( object, ylim = NULL,
+ colNonSig = "gray32", colSig = "red3", colLine = "#ff000080",
+ log = "x", cex=0.45, xlab="mean expression", ylab="log fold change", ... )
+{
+ if( !( ncol(object) == 3 & inherits( object[[1]], "numeric" ) & inherits( object[[2]], "numeric" )
+ & inherits( object[[3]], "logical" ) ) ) {
+ stop( "When called with a data.frame, plotMA expects the data frame to have 3 columns, two numeric ones for mean and log fold change, and a logical one for significance.")
+ }
+ colnames(object) <- c( "mean", "lfc", "sig" )
+ object = subset( object, mean != 0 )
+ py = object$lfc
+ if( is.null(ylim) )
+ ylim = c(-1,1) * quantile(abs(py[is.finite(py)]), probs=0.99) * 1.1
+ plot(object$mean, pmax(ylim[1], pmin(ylim[2], py)),
+ log=log, pch=ifelse(py<ylim[1], 6, ifelse(py>ylim[2], 2, 16)),
+ cex=cex, col=ifelse( object$sig, colSig, colNonSig ), xlab=xlab, ylab=ylab, ylim=ylim, ...)
+ abline( h=0, lwd=4, col=colLine )
+}
+)
diff --git a/R/savepng.R b/R/savepng.R
new file mode 100644
index 0000000..05e778d
--- /dev/null
+++ b/R/savepng.R
@@ -0,0 +1,40 @@
+## width and height in pixels
+savepng <- function(fn, dir, width=480, asp=1) {
+ fn <- paste(fn, ".png", sep="")
+ if(!missing(dir))
+ fn <- file.path(dir, fn)
+ dev.copy(png, filename=fn , width=width, height=width*asp)
+ dev.off()
+ return(fn)
+}
+
+## width and height in inches
+savepdf <- function(fn, dir, width=6, asp=1) {
+ fn = paste(fn, ".pdf", sep="")
+ if(!missing(dir))
+ fn <- file.path(dir, fn)
+ dev.copy(pdf, file=fn, width=width, height=width*asp)
+ dev.off()
+ return(fn)
+}
+saveeps <- function(fn, dir, width=6, asp=1) {
+ fn = paste(fn, ".eps", sep="")
+ if(!missing(dir))
+ fn <- file.path(dir, fn)
+ dev.copy(postscript, file=fn, width=width, height=width*asp,
+ horizontal = FALSE, onefile = FALSE, paper = "special")
+ dev.off()
+ return(fn)
+}
+savetiff <- function(fn, dir, density=360, keeppdf=TRUE, ...) {
+ pdffn <- savepdf(fn, dir, ...)
+ fn <- paste(fn, ".tiff", sep="")
+ if(!missing(dir))
+ fn <- file.path(dir, fn)
+ cmd <- paste("convert -density", density, pdffn, "-compress RLE", fn)
+ ## cat(cmd, "\n")
+ system(cmd)
+ if(!keeppdf) file.remove(pdffn)
+ return(fn)
+}
+
diff --git a/R/zzz.R b/R/zzz.R
new file mode 100644
index 0000000..f19bc14
--- /dev/null
+++ b/R/zzz.R
@@ -0,0 +1,9 @@
+.onAttach <- function(libname, pkgname)
+ {
+
+ if(.Platform$OS.type == "windows" && interactive() && .Platform$GUI == "Rgui"){
+ addVigs2WinMenu("geneplotter")
+ }
+
+
+}
diff --git a/README b/README
new file mode 100644
index 0000000..feb7bf1
--- /dev/null
+++ b/README
@@ -0,0 +1,19 @@
+geneplotter contains plotting functions for microarrays
+
+ To Do:
+
+ o A mechanism to order the rows and columns of the microarray matrix.
+ order.restricted is a start. We need a mechanism for dendrograms.
+ Dan Carr suggested that there was a method based on Principle components.
+
+ o Links to the annotation library. Using locator(1) we should be able
+ to simulate interaction with the plot and look up genes at LocusLink
+ etc.
+
+ o Color scheme for Red-Blue is the same as Cheng's but the Red Green still
+ looks funny.
+
+ o Need some notion of a viewport so that we can zoom in and out. Perhaps
+ Paul Murrell, Ross Ihaka or Saikat DebRoy can help out in this regard.
+
+ o Lots of other visualization methods need to be implemented.
diff --git a/build/vignette.rds b/build/vignette.rds
new file mode 100644
index 0000000..18f9d6c
Binary files /dev/null and b/build/vignette.rds differ
diff --git a/data/IMCAEntrezLink.R b/data/IMCAEntrezLink.R
new file mode 100644
index 0000000..af0e7e8
--- /dev/null
+++ b/data/IMCAEntrezLink.R
@@ -0,0 +1,31 @@
+
+IMCAEntrezLink = structure(list(ITGB = NA, ITGA = NA, ILK = structure("3611", .Names = "35365_at"),
+#
+# computed 24 Sept 2007 using hgu95av2.db revmap(hgu95av2SYMBOL) from nodes(IMCAgraph),
+# then looking up the probes in hgu95av2ENTREZID
+#
+ CAV = NA, SHC = NA, FYN = structure("2534", .Names = "2039_s_at"),
+ GRB2 = structure("2885", .Names = "1565_s_at"), SOS = NA,
+ "Ha-Ras" = NA, Raf = NA, MEK = NA, ERK = NA, MYLK = structure("4638", .Names = "32847_at"),
+ MYO = NA, ACTN = NA, VCL = structure("7414", .Names = "36601_at"),
+ TLN = NA, PXN = structure("5829", .Names = "38644_at"), ZYX = structure("7791", .Names = "36958_at"),
+ VASP = structure("7408", .Names = "39105_at"), SH3D5 = NA,
+ TNS = NA, CAPN = NA, CAPNS = NA, SRC = structure("6714", .Names = "1938_at"),
+ FAK = NA, BCAR1 = NA, CSK = structure("1445", .Names = "1768_s_at"),
+ CRK = structure("1398", .Names = "38219_at"), DOCK1 = structure("1793", .Names = "37638_at"),
+ GRF2 = NA, RAP1 = NA, JNK = NA, GIT2 = structure("9815", .Names = "36741_at"),
+ ARHGEF = NA, PAK = NA, p85 = NA, p110 = NA, "Phosphatidylinositol signaling system" = NA,
+ VAV = NA, PDPK1 = structure("5170", .Names = "32029_at"),
+ AKT = NA, RAC = NA, CDC42 = structure("998", .Names = "39736_at"),
+ RHO = structure("6010", .Names = "32875_at"), PI5K = NA,
+ ROCK = NA, "MYO-P" = NA, "cell maintenance" = NA, "cell motility" = NA,
+ "F-actin" = NA, "cell proliferation" = NA), .Names = c("ITGB",
+"ITGA", "ILK", "CAV", "SHC", "FYN", "GRB2", "SOS", "Ha-Ras",
+"Raf", "MEK", "ERK", "MYLK", "MYO", "ACTN", "VCL", "TLN", "PXN",
+"ZYX", "VASP", "SH3D5", "TNS", "CAPN", "CAPNS", "SRC", "FAK",
+"BCAR1", "CSK", "CRK", "DOCK1", "GRF2", "RAP1", "JNK", "GIT2",
+"ARHGEF", "PAK", "p85", "p110", "Phosphatidylinositol signaling system",
+"VAV", "PDPK1", "AKT", "RAC", "CDC42", "RHO", "PI5K", "ROCK",
+"MYO-P", "cell maintenance", "cell motility", "F-actin", "cell proliferation"
+))
+
diff --git a/data/expressionSet133a.rda b/data/expressionSet133a.rda
new file mode 100644
index 0000000..de94ce4
Binary files /dev/null and b/data/expressionSet133a.rda differ
diff --git a/inst/NEWS.Rd b/inst/NEWS.Rd
new file mode 100644
index 0000000..b966f86
--- /dev/null
+++ b/inst/NEWS.Rd
@@ -0,0 +1,15 @@
+\name{NEWS}
+\title{News for Package 'geneplotter'}
+
+\section{Changes in version 1.31.4}{
+ \subsection{USER VISIBLE CHANGES}{
+ \itemize{
+ \item Using NEWS.Rd
+ \item The interpretation of the argument \code{bw} by the function
+ \code{\link{multidensity}} has been changed with the aim to make the
+ behaviour more robust when the data ranges or sample sizes of the
+ groups are quite different. Also, to allow more control, \code{bw}
+ can now also be a vector, with elements corresponding to the different
+ groups.}
+ }
+}
diff --git a/inst/doc/byChroms.R b/inst/doc/byChroms.R
new file mode 100644
index 0000000..6f2611d
--- /dev/null
+++ b/inst/doc/byChroms.R
@@ -0,0 +1,55 @@
+### R code from vignette source 'byChroms.Rnw'
+
+###################################################
+### code chunk number 1: loaddata
+###################################################
+
+ library("annotate")
+ library("hu6800.db")
+ lens <- unlist(eapply(hu6800CHR, length))
+
+ table(lens)
+ wh2 = mget(names(lens)[lens==2], env = hu6800CHR)
+
+ wh2[1]
+
+
+###################################################
+### code chunk number 2: fixdata
+###################################################
+chrs2 <- unlist(eapply(hu6800CHR, function(x) x[1]))
+chrs2 <- factor(chrs2)
+length(chrs2)
+ table(unlist(chrs2))
+
+
+###################################################
+### code chunk number 3: strandloc
+###################################################
+
+ strand <- as.list(hu6800CHRLOC)
+
+ splits <- split(strand, chrs2)
+ length(splits)
+ names(splits)
+
+
+
+###################################################
+### code chunk number 4: chrloc
+###################################################
+
+ newChrClass <- buildChromLocation("hu6800")
+
+
+
+###################################################
+### code chunk number 5: cPlot
+###################################################
+
+ library(geneplotter)
+
+ cPlot(newChrClass)
+
+
+
diff --git a/inst/doc/byChroms.Rnw b/inst/doc/byChroms.Rnw
new file mode 100644
index 0000000..63d9310
--- /dev/null
+++ b/inst/doc/byChroms.Rnw
@@ -0,0 +1,110 @@
+%
+% NOTE -- ONLY EDIT THE .Rnw FILE!!! The .tex file is
+% likely to be overwritten.
+%
+% \VignetteIndexEntry{How to assemble a chromLocation object}
+% \VignetteAuthor{R. Gentleman}
+%\VignetteDepends{annotate, hu6800.db}
+%\VignetteKeywords{chromosomes}
+%\VignettePackage{geneplotter}
+\documentclass[12pt]{article}
+
+\usepackage{amsmath}
+\usepackage{hyperref}
+
+\newcommand{\Rfunction}[1]{{\texttt{#1}}}
+\newcommand{\Robject}[1]{{\texttt{#1}}}
+\newcommand{\Rpackage}[1]{{\textit{#1}}}
+
+
+\textwidth=6.2in
+\textheight=8.5in
+%\parskip=.3cm
+\oddsidemargin=.1in
+\evensidemargin=.1in
+\headheight=-.3in
+
+\newcommand{\scscst}{\scriptscriptstyle}
+\newcommand{\scst}{\scriptstyle}
+
+\bibliographystyle{plainnat}
+
+\begin{document}
+
+\section*{How to Assemble a chromLocation Object}
+
+
+In order to use the various \Rpackage{geneplotter} functions you will
+need to assemble an object of class \Robject{chromLocation}.
+This is relatively straightforward if you have access to a Bioconductor
+data package. In this example we will consider using the
+\Rpackage{hu6800.db} data package to construct our object. This vignette
+was built with version \Sexpr{packageDescription("hu6800.db")$Version} of
+the package.
+
+<<loaddata>>=
+
+ library("annotate")
+ library("hu6800.db")
+ lens <- unlist(eapply(hu6800CHR, length))
+
+ table(lens)
+ wh2 = mget(names(lens)[lens==2], env = hu6800CHR)
+
+ wh2[1]
+@
+
+So somehow \Sexpr{length(wh2)} of the genes are mapped to two
+ different chromosomes. Based on OMIM the these genes are localized
+ to the so called \textit{pseudoautosomal region} where the X and Y
+ cromosomes are similar and there is actual recombination going on
+ between them. So, we will take the expedient measure of assigning
+ each of them to just one chromosome.
+
+<<fixdata>>=
+chrs2 <- unlist(eapply(hu6800CHR, function(x) x[1]))
+chrs2 <- factor(chrs2)
+length(chrs2)
+ table(unlist(chrs2))
+@
+
+Now we are ready to obtain the chromosome location data and
+orientation. The chromosome location data tells us the (approximate)
+location of the gene on the chromosome. The positions for both the
+sense and antisense strand are number of base pairs measured from the
+p (5' end of the sense strand) to q (3' end of the sense strand) arms.
+Chromosomes are double stranded and the gene is encoded on only one of
+those two strands. The strands are labeled plus and minus (sense and
+antisense). We use both the location and the orientation when making
+plots.
+
+<<strandloc>>=
+
+ strand <- as.list(hu6800CHRLOC)
+
+ splits <- split(strand, chrs2)
+ length(splits)
+ names(splits)
+
+@
+
+Now we have processed the data and are ready to construct a new
+\Robject{chromLocation} object.
+
+<<chrloc>>=
+
+ newChrClass <- buildChromLocation("hu6800")
+
+@
+
+And finally we can test it by calling \Rfunction{cPlot}.
+
+<<cPlot, fig=TRUE>>=
+
+ library(geneplotter)
+
+ cPlot(newChrClass)
+
+@
+
+\end{document}
diff --git a/inst/doc/byChroms.pdf b/inst/doc/byChroms.pdf
new file mode 100644
index 0000000..abb1c1a
Binary files /dev/null and b/inst/doc/byChroms.pdf differ
diff --git a/inst/doc/visualize.R b/inst/doc/visualize.R
new file mode 100644
index 0000000..8677ad7
--- /dev/null
+++ b/inst/doc/visualize.R
@@ -0,0 +1,54 @@
+### R code from vignette source 'visualize.Rnw'
+
+###################################################
+### code chunk number 1: getl
+###################################################
+library(geneplotter)
+
+
+###################################################
+### code chunk number 2: start
+###################################################
+data(sample.ExpressionSet)
+eset = sample.ExpressionSet # legacy naming
+mytt <- function(y, cov2) {
+ ys <- split( y, cov2 )
+ t.test( ys[[1]], ys[[2]] )
+ }
+
+ttout <- esApply(eset, 1, mytt, eset$type)
+s1means <- sapply(ttout, function(x) x$estimate[1])
+s2means <- sapply(ttout, function(x) x$estimate[2])
+deciles <- quantile(c(s1means, s2means), probs=seq(0,1,.1))
+s1class <- cut(s1means, deciles)
+names(s1class) <- names(s1means)
+s2class <- cut(s2means, deciles)
+names(s2class) <- names(s2means)
+
+
+###################################################
+### code chunk number 3: f11
+###################################################
+cols <- dChip.colors(10)
+def.par <- par(no.readonly = TRUE)# save default, for resetting...
+nf <- layout(matrix(1:3,nr=1), widths=c(5,5,2))
+chrObj <- buildChromLocation("hgu95av2")
+cPlot(chrObj)
+cColor(featureNames(eset), cols[s1class], chrObj)
+cPlot(chrObj)
+cColor(featureNames(eset), cols[s2class], chrObj)
+image(1,1:10,matrix(1:10,nc=10),col=cols, axes=FALSE,
+ xlab="", ylab="")
+axis(2, at=(1:10), labels=levels(s1class), las=1)
+par(def.par)
+
+
+###################################################
+### code chunk number 4: f22
+###################################################
+ par(mfrow=c(1,1))
+ mycols <- c("red", "darkgreen", "blue")[eset$cov3]
+ alongChrom(eset, "1", chrObj, plotFormat="cumulative",
+ col=mycols)
+
+
diff --git a/inst/doc/visualize.Rnw b/inst/doc/visualize.Rnw
new file mode 100644
index 0000000..c60e1b2
--- /dev/null
+++ b/inst/doc/visualize.Rnw
@@ -0,0 +1,153 @@
+%
+% NOTE -- ONLY EDIT THE .Rnw FILE!!! The .tex file is
+% likely to be overwritten.
+%
+
+
+% \VignetteIndexEntry{Visualization of Microarray Data}
+% \VignetteDepends{Biobase, annotate, geneplotter, hgu95av2.db}
+% \VignetteKeywords{Expression Analysis}
+%\VignettePackage{geneplotter}
+\documentclass[12pt]{article}
+
+\usepackage{amsmath}
+\usepackage{hyperref}
+
+\newcommand{\Rfunction}[1]{{\texttt{#1}}}
+\newcommand{\Robject}[1]{{\texttt{#1}}}
+\newcommand{\Rpackage}[1]{{\textit{#1}}}
+
+\author{Robert Gentleman}
+
+\begin{document}
+\title{Overview: Visualization of Microarray Data}
+\maketitle{}
+
+\section{Overview}
+
+In this document we present a brief overview of the visualization
+methods that are available in Bioconductor project.
+To make use of these tools you will need the packages: \Rpackage{Biobase},
+\Rpackage{annotate}, and \Rpackage{geneplotter}. These must be installed in your
+version of R and when you start R you must load them with the
+\Rfunction{library} command.
+
+A quick word of warning regarding the interpretation of these
+plots. We can only plot where the gene is supposed to be. If there are
+translocations or amplifications these will not be detected by
+microarray analyses.
+
+<<getl>>=
+library(geneplotter)
+@
+
+
+\section{Whole Genome Plots}
+
+The functions \Rfunction{cPlot} and \Rfunction{cColor} allow the user to
+associate microarray expression data with chromosomal location.
+The plots can include any subset (by default all chromosomes are
+shown) of chromosomes for the organism being considered.
+
+To make these plots we use the complete reference set of genes
+for the organism being studied. We must then obtain the chromosomal
+location (in bases) and orientation (which strand) the gene is on.
+Chromosomes are represented by straight lines parallel to the
+$x$--axis. Genes are represented by short perpendicular lines. All
+genes for the experiment (i.e. for an Affymetrix U95A analysis we show
+all genes on the chips).
+
+The user can then change the color of different sets of the
+genes according to their needs.
+
+The original setup is done using \Rfunction{cPlot}. The subsequent coloring
+is done using \Rfunction{cColor}.
+
+
+We will use the example data in \Robject{sample.ExpressionSet} to show how this function
+might be used.
+
+<<start>>=
+data(sample.ExpressionSet)
+eset = sample.ExpressionSet # legacy naming
+mytt <- function(y, cov2) {
+ ys <- split( y, cov2 )
+ t.test( ys[[1]], ys[[2]] )
+ }
+
+ttout <- esApply(eset, 1, mytt, eset$type)
+s1means <- sapply(ttout, function(x) x$estimate[1])
+s2means <- sapply(ttout, function(x) x$estimate[2])
+deciles <- quantile(c(s1means, s2means), probs=seq(0,1,.1))
+s1class <- cut(s1means, deciles)
+names(s1class) <- names(s1means)
+s2class <- cut(s2means, deciles)
+names(s2class) <- names(s2means)
+@
+
+Next we need to set up the graphics output. We do this in a rather
+complicated way.
+In the plot below we can compare the mean expression levels for genes
+in Group 1 with those in Group 2.
+The Group 1 values are in the left--hand plot and the Group 2 values
+are in the right--hand plot.
+
+\begin{verbatim}
+cols <- dChip.colors(10)
+nf <- layout(matrix(1:3,nr=1), widths=c(5,5,2))
+chrObj <- buildChromLocation("hgu95av2")
+cPlot(chrObj)
+cColor(featureNames(eset), cols[s1class], chrObj)
+cPlot(chrObj)
+cColor(featureNames(eset), cols[s2class], chrObj)
+image(1,1:10,matrix(1:10,nc=10),col=cols, axes=FALSE,
+ xlab="", ylab="")
+axis(2, at=(1:10), labels=levels(s1class), las=1)
+\end{verbatim}
+
+
+\begin{center}
+<<f11,fig=TRUE, echo=FALSE>>=
+cols <- dChip.colors(10)
+def.par <- par(no.readonly = TRUE)# save default, for resetting...
+nf <- layout(matrix(1:3,nr=1), widths=c(5,5,2))
+chrObj <- buildChromLocation("hgu95av2")
+cPlot(chrObj)
+cColor(featureNames(eset), cols[s1class], chrObj)
+cPlot(chrObj)
+cColor(featureNames(eset), cols[s2class], chrObj)
+image(1,1:10,matrix(1:10,nc=10),col=cols, axes=FALSE,
+ xlab="", ylab="")
+axis(2, at=(1:10), labels=levels(s1class), las=1)
+par(def.par)
+@
+\end{center}
+
+\section{Single Chromosome Plots}
+
+A different view of the variation in expression level can be obtained
+by plotting characteristics of expression levels over contiguous
+regions of a chromosome.
+For these plots cummulative expression or per--gene expressions can be
+plotted.
+There are some issues of interpretation here (as in most places) --
+expression is not likely to be controlled too much by chromosomal
+locality. However these plots may be helpful in detecting
+deletions (of both chromatids) or amplifications, or other interesting
+features of the genome.
+
+In this section we will show how one can explore a particular
+chromosome for an amplicon.
+The data arise from a study of breast cancer in the Iglehart
+Laboratory.
+
+\begin{center}
+<<f22,fig=TRUE, echo=FALSE>>=
+ par(mfrow=c(1,1))
+ mycols <- c("red", "darkgreen", "blue")[eset$cov3]
+ alongChrom(eset, "1", chrObj, plotFormat="cumulative",
+ col=mycols)
+@
+\end{center}
+
+\end{document}
diff --git a/inst/doc/visualize.pdf b/inst/doc/visualize.pdf
new file mode 100644
index 0000000..6f5543f
Binary files /dev/null and b/inst/doc/visualize.pdf differ
diff --git a/man/GetColor.Rd b/man/GetColor.Rd
new file mode 100644
index 0000000..7ce5b7d
--- /dev/null
+++ b/man/GetColor.Rd
@@ -0,0 +1,45 @@
+\name{GetColor}
+\alias{GetColor}
+\alias{dChip.colors}
+\alias{greenred.colors}
+\title{ A function to get the Red-Blue color scheme used by dChip }
+\description{
+ A simple, vectorized function that computes a Red/Blue color for
+ plotting microarray expression data.
+}
+\usage{
+GetColor(value, GreenRed=FALSE, DisplayRange=3)
+dChip.colors(n)
+greenred.colors(n)
+}
+
+\arguments{
+ \item{value}{The vector of expression values. }
+ \item{GreenRed}{If \code{TRUE} the Green-Red colors are produced,
+ otherwise Red-Blue are procduced. }
+ \item{DisplayRange}{ A parameter controlling the range of
+ \code{value}'s that will be plotted. }
+ \item{n}{An integer saying how many colors to be in the palette.}
+}
+\details{
+ \code{GetColor} is a simple mapping into RGB land provided by Cheng
+ Li.
+ \code{dChip.colors} provides functionality similar to that of
+ \code{\link[grDevices:palettes]{topo.colors}} for the red--blue colors
+ used for genome plots. \code{greenred.colors} does the same for the
+ green-black-red gradient.
+}
+\value{
+ A vector of RGB colors suitable for plotting in R.
+}
+
+\author{R. Gentleman, based on an original by C. Li. }
+
+\examples{
+ set.seed(10)
+ x <- rnorm(10)
+ GetColor(x)
+ dChip.colors(10)
+}
+\keyword{ manip }
+
diff --git a/man/Makesense.Rd b/man/Makesense.Rd
new file mode 100644
index 0000000..319e54c
--- /dev/null
+++ b/man/Makesense.Rd
@@ -0,0 +1,62 @@
+\name{Makesense}
+\alias{Makesense}
+\alias{Makesense,matrix,character-method}
+\alias{Makesense,ExpressionSet,missing-method}
+\alias{Makesense,ExpressionSet,character-method}
+\title{Produce Smoothed Sense/Anti-sense For All Chromosomes}
+\description{
+ 'Makesense' takes either an \code{ExpressionSet} object or a \code{matrix}
+ of gene expressions and will produce a smoothed positive and negative strands
+ for all chromosomes.
+}
+\usage{
+Makesense(expr, lib, ...)
+}
+\arguments{
+ \item{expr}{Either an \code{ExpressionSet} or a \code{matrix} of
+ gene expressions with genes as rows and columns as samples.}
+ \item{lib}{The name of the Bioconductor annotation data package that
+ will be used to provide mappings from probes to chromosomal
+ locations, such as \code{hgu95av2.db} or \code{hgu133a.db}. If
+ \code{expr} is an \code{ExpressionSet}, the argument defaults to the
+ \code{annotation} slot of the \code{ExpressionSet}.}
+ \item{...}{Currently, the only optional argument is \code{f}, the
+ smoother span to be passed to 'lowess'. Its value should
+ be in the interval of (0,1). This gives the proportion of points in
+ the plot which influence the smooth at each value. Larger values
+ give more smoothness. The default value for this argument is 1/10.}
+}
+\details{
+ The \code{expr} argument can either be of class \code{ExpressionSet} or
+ \code{matrix}, where the latter represents the matrix of gene
+ expressions.
+
+ If the \code{expr} argument is an \code{ExpressionSet}, the \code{lib}
+ argument will use the \code{annotation} slot. Users can override this
+ behaviour and supply their own \code{lib} argument if they wish. If
+ the \code{ExpressionSet} has no value associated with the \code{annotation}
+ slot (which should not happen, but is possible) then the user must
+ supply the \code{lib} argument manually or the function will throw an
+ error.
+ }
+\value{
+A list of 2 components:
+\item{ans2}{a \code{list}, whose components correspond to samples
+in the same order as appearing in the columns of
+'expr'. Each component is also a \code{list}, named by chromosomes
+"1"-"22", "X" and "Y". Each named component is again a \code{list}
+with two elements named "posS" and "negS", corresponding to the
+positive and negative strands of a chromosome, each of which is an object returned by 'lowess'.}
+\item{lib}{A string giving the name of the annotation data package to
+use. Optional if \code{expr} is an \code{ExpressionSet}.}
+}
+\author{Robert Gentleman and Xiaochun Li}
+\seealso{ \code{\link{plotChr}}}
+\examples{
+ if (require("hgu133a.db")) {
+ data(expressionSet133a)
+ esetobj <- Makesense(exprs(expressionSet133a), "hgu133a")
+ esetobj2 <- Makesense(expressionSet133a[1:200, ])
+ }
+}
+\keyword{dplot}
diff --git a/man/alongChrom.Rd b/man/alongChrom.Rd
new file mode 100644
index 0000000..4418c10
--- /dev/null
+++ b/man/alongChrom.Rd
@@ -0,0 +1,123 @@
+\name{alongChrom}
+\alias{alongChrom}
+\alias{buildACMainLabel}
+\alias{doACImagePlot}
+\alias{fixACPhysPoints}
+\alias{getACGeneSyms}
+\alias{limitACXRange}
+\alias{cullACXPoints}
+\alias{doACLocalPlot}
+\alias{getACClosestPos}
+\alias{getACPlotLabs}
+\alias{scaleACData}
+\alias{dispACXaxis}
+\alias{doACMatPlot}
+\alias{getACDataEnv}
+\alias{getACStrandVals}
+\alias{doACCumPlot}
+\alias{emptyACPlot}
+\alias{getACExprs}
+\alias{highlightACDups}
+\title{A function for plotting expression data from an ExpressionSet for a
+ given chromosome.}
+\description{
+ Given a particular ExpressionSet object, a chromLocation object, and a
+ chromosome name, will plot selected ExpressionSet data using various methods.
+}
+\usage{
+ alongChrom(eSet, chrom, specChrom, xlim, whichGenes,
+ plotFormat=c("cumulative", "local","image"),
+ xloc=c("equispaced", "physical"),
+ scale=c("none","zscale","rankscale","rangescale","zrobustscale"),
+ geneSymbols=FALSE, byStrand=FALSE, colors="red", lty=1, type="S",
+ ...)}
+\arguments{
+ \item{eSet}{The ExpressionSet object to be used.}
+ \item{chrom}{The desired chromosome.}
+ \item{specChrom}{An object of type chromLocation for the species being
+ represented.}
+ \item{xlim}{A pair of values - either character or integer, which will
+ denote the range of genes to display (based on base pair: either directly
+ in the case of integers, or using the locations of the named genes if
+ character). If not supplied, the entire chromosome is used.}
+ \item{whichGenes}{If supplied, will limit the displayed genes to the ones
+ provided in this vector.}
+ \item{xloc}{Determines whether the X axis points (gene names) will be
+ displayed according to their relative position on the chromosome
+ (physical), or spaced evenly (equispaced). Default is equispaced.}
+ \item{plotFormat}{Determines the method which to plot the data.}
+ \item{scale}{Determines what method of scaling will be applied to the
+ data. Default is none.}
+ \item{geneSymbols}{Notes whether to use Affy IDs or Gene Symbols,
+ default is Affy IDs}
+ \item{byStrand}{Determines whether to show the entire plot at once, or
+ a split plot by strands. Default is a singular plot}
+ \item{lty}{A vector of line types, which will be cycled. }
+ \item{type}{Plot type, from par. Defaults to "S".}
+ \item{colors}{A vector of colors for the plots, which will be cycled.}
+ \item{...}{Any remaining graphics commands may be passed along as per plot()}
+}
+\details{
+ The genes on the chromosome of interest are extracted from the
+ \code{chromLocation} object passed in, which are then intersected with the
+ genes listed in the ExpressionSet. These remaining genes will then be
+ plotted according to the \code{plotFormat} argument. If \code{image} is
+ specified, an image plot is created showing the expression levels of
+ the samples by gene, using a colour map to denote the levels. If
+ \code{cumulative} is chosen, the cumulative expression level is plotted
+ against the genes for each sample. Likewise, if \code{local} is used, the
+ raw data is plotted for each sample against the genes using a boxplot format.
+
+ Not all parameters are honored for all plotformats. \code{xloc},
+ \code{lty}, and \code{type} are only used with the \code{cumulative}
+ plotformat.
+}
+\author{Jeff Gentry}
+\examples{
+ data(sample.ExpressionSet)
+ ## A bit of a hack to not have a package dependency on hgu95av2
+ ## but need to fiddle w/ the warn level to not fail the example anyways.
+ curWarn <- options(warn=0)
+ on.exit(options(curWarn), add=TRUE)
+ if (require("hgu95av2.db")) {
+ z <- buildChromLocation("hgu95av2")
+ lty <- c(1, 2, 3, 4, 5)
+ cols <- c("red", "green", "blue", "orange", "magenta", "black")
+ cols <- cols[sample.ExpressionSet$type]
+ if (interactive()) {
+ par(ask=TRUE)
+ }
+
+ ## Here we're using xlim to denote a physical region to display
+ xlim <- c(87511280,127717880)
+ for (xl in c("equispaced", "physical"))
+ for (sc in c("none","rangescale"))
+ {
+ alongChrom(sample.ExpressionSet, "1", z, xlim=xlim, xloc=xl,
+ plotFormat="cumulative", scale=sc,lty=lty, colors=cols)
+ }
+
+ ## Here we're looking for specific genes
+ which <- c("31540_at","31583_at", "31508_at", "31529_at", "31439_f_at",
+ "31729_at")
+ ## Gene "31529_at" does not exist in the current set of genes,
+ ## here it demonstrates how genes not available are dropped.
+ for (xl in c("equispaced", "physical"))
+ for (sc in c("none","rangescale"))
+ {
+ alongChrom(sample.ExpressionSet, "1", z, which=which, xloc=xl,
+ plotFormat="cumulative", scale=sc,lty=lty, col=cols)
+ }
+
+ ## Do an image plot
+ for (bs in c(TRUE,FALSE))
+ alongChrom(sample.ExpressionSet, "1",z, xlim=xlim, plotFormat="image",
+ scale="zscale", byStrand=bs)
+
+ ## A boxplot
+ for (st in c(TRUE,FALSE))
+ alongChrom(sample.ExpressionSet, "1", z, plotFormat="local",
+ colors=cols, byStrand=st)
+ } else print("Example can not be run without the hgu95av2 data package")
+}
+\keyword{utilities}
diff --git a/man/amplicon.plot.Rd b/man/amplicon.plot.Rd
new file mode 100644
index 0000000..d8d9207
--- /dev/null
+++ b/man/amplicon.plot.Rd
@@ -0,0 +1,39 @@
+\name{amplicon.plot}
+\alias{amplicon.plot}
+\title{Create an amplicon plot }
+\description{
+ Given a two-sample test statistic and an ExpressionSet this function plots
+ regions of the genome that are either highly expressed (in red) or
+ have low expression (blue) differentially in the two groups.
+}
+\usage{
+amplicon.plot(ESET, FUN, genome)
+}
+\arguments{
+ \item{ESET}{an object of class \code{ExpressionSet}}
+ \item{FUN}{A two sample test function suitable for \code{\link[Biobase]{esApply}}. }
+ \item{genome}{A character string of the base name for the annotation. }
+}
+\details{
+ In some genetic studies we are interested in finding regions of the
+ genome where there are a set of highly expressed genes in some
+ subgroup of the population. This set of highly (or lowly) expressed
+ genes is often of great interest. For example in breast cancer the
+ HER--2 gene is on an amplicon. In some patients approximately 5 genes
+ located near HER--2 are all amplified.
+
+ These plot should help in the search for such regions.
+}
+\value{
+ No value is returned. This function is executed purely for side
+ effect.
+}
+
+\author{Robert Gentleman }
+
+\seealso{\code{\link[Biobase]{esApply}}, \code{\link{make.chromOrd}}}
+
+\examples{
+ ##none yet; takes too long
+}
+\keyword{ hplot }
diff --git a/man/cColor.Rd b/man/cColor.Rd
new file mode 100644
index 0000000..81251a0
--- /dev/null
+++ b/man/cColor.Rd
@@ -0,0 +1,48 @@
+\name{cColor}
+\alias{cColor}
+\title{A function for marking specific probes on a cPlot.}
+\description{
+ Given a set of probes, will highlight them in the color desired on
+ a plot which has already been created via the function cPlot().
+}
+\usage{
+cColor(probes, color, plotChroms, scale=c("relative","max"), glen=0.4,
+ ...)
+}
+\arguments{
+ \item{probes}{The probes that are being highlighted.}
+ \item{color}{A vector of colors, recycled as necessary, to highlight
+ the probes.}
+ \item{plotChroms}{An object of type \code{chromLocation} which contains all
+ the gene information to be plotted.}
+ \item{scale}{Whether to plot the graph scaled absolutely or relative
+ by chromosome. Default is absolute.}
+ \item{glen}{The length of the gene line plotted.}
+ \item{...}{Additional graphics arguments, passed to \code{segments},
+ which is used to draw the vertical ticks.}
+}
+\details{
+ It is important to call the function \code{cPlot()} first. This function
+ will then search for the specific locations of the probes desired,
+ which are contained within the \code{plotChroms} instance of a
+ \code{chromLocation} class. It will then pass these on to the
+ plotting routine to highlight the desired locations. NOTE: It
+ is important that \code{plotChroms}, \code{scale} and \code{glen}
+ parameters are the same as used for \code{cPlot()}.
+}
+\author{Jeff Gentry}
+\seealso{
+ \code{\link{cPlot}}, \code{\link[annotate]{chromLocation-class}}
+}
+\examples{
+ if (require("hgu95av2.db")) {
+ z <- buildChromLocation("hgu95av2")
+ cPlot(z)
+ probes <- c("266_s_at", "31411_at", "610_at", "failExample")
+ cColor(probes, "red", z)
+ probes2 <- c("960_g_at", "41807_at", "931_at", "39032_at")
+ cColor(probes2, "blue", z)
+ } else
+ print("Need hgu95av2.db data package for the example")
+ }
+\keyword{utilities}
diff --git a/man/cPlot.Rd b/man/cPlot.Rd
new file mode 100644
index 0000000..362cb94
--- /dev/null
+++ b/man/cPlot.Rd
@@ -0,0 +1,61 @@
+\name{cPlot}
+\alias{cPlot}
+\title{A plotting function for chromosomes.}
+\description{
+ Given a chromLocation object, will plot all the gene locations from
+ that object.
+}
+\usage{
+cPlot(plotChroms, useChroms=chromNames(plotChroms),
+ scale=c("relative","max"), fg="white", bg="lightgrey",
+ glen=0.4, xlab="", ylab="Chromosome",
+ main = organism(plotChroms), ...)
+}
+\arguments{
+ \item{plotChroms}{An object of type chromLocation which contains all
+ the gene information to be plotted.}
+ \item{useChroms}{A vector of chromosome names to be used in the plot.
+ Default is to use all the chromosomes from the plotChroms object.}
+ \item{scale}{Passed on to cScale as it's scale argument. Determines
+ whether the graph is scaled on a relative or absolute basis.}
+ \item{fg}{The colour to be used for the genes. Default is white.}
+ \item{bg}{The colour to be used for the background of the plot.
+ Defaults to lightgrey.}
+ \item{glen}{A scaling factor applied to the plotted length of each
+ gene. Defaults to 0.4 - it is recommended that this not be set
+ larger then 0.5 as it will cause overlap between chromosomes.}
+ \item{xlab}{A label for the x axis.}
+ \item{ylab}{A label for the y axis.}
+ \item{main}{A main label for the plot.}
+ \item{...}{Additional graphics arguments, passed to \code{segments},
+ which is used to draw the vertical ticks.}
+}
+\details{
+ This function will first use the lengths of the chromosomes, stored in
+ the object to create scaling factors for the X axis. Once the
+ scaling factors are determined, the \code{chromLocation} object which is
+ passed in is used to determine all the gene locations/strand
+ information/etc, which is then plotted for the user.
+}
+\author{Jeff Gentry}
+\seealso{\code{\link{cScale}}, \code{\link{cColor}},
+ \code{\link[annotate]{chromLocation-class}}}
+\examples{
+ ## A bit of a hack to not have a package dependency on hgu95av2
+ ## but need to fiddle w/ the warn level to not fail the example anyways.
+
+ curWarn <- options(warn=0)
+ on.exit(options(curWarn), add=TRUE)
+ if (require("hgu95av2.db")) {
+ z <- buildChromLocation("hgu95av2")
+
+ if (interactive()) {
+ curPar <- par(ask=TRUE)
+ on.exit(par(curPar), add=TRUE)
+ }
+
+ for (sc in c("max","relative"))
+ cPlot(z,c("1","5","10","X","Y"),sc)
+ } else print("This example can not be run without hgu95av2 data package")
+}
+\keyword{utilities}
diff --git a/man/cScale.Rd b/man/cScale.Rd
new file mode 100644
index 0000000..f372fbc
--- /dev/null
+++ b/man/cScale.Rd
@@ -0,0 +1,42 @@
+\name{cScale}
+\alias{cScale}
+\title{A function for mapping chromosome length to a number of points.}
+\description{
+ Given a number of points (generally representing the number of points
+ on a plot's axis), and a vector of chromosome lengths - will generate
+ a vector of the same length as the one passed in containing scaling
+ factors for each chromosome.
+}
+\usage{
+cScale(points, cLengths, method=c("max", "relative"), chrom)
+}
+\arguments{
+ \item{points}{The number of points to scale the chromosome length to.}
+ \item{cLengths}{A vector of chromosome lengths.}
+ \item{method}{Determines whether to use relative or absolute scaling.
+ Default is "max" (absolute).}
+ \item{chrom}{Which chrom to determine the scale for}
+}
+\details{
+ The scale factor is calculated in a manner based on the \code{method}
+ argument. If method is \code{max}, the factor is derived by dividing the
+ points argument by each chromosome's length (in base pairs). If the
+ method chosen is \code{relative}, then the scale is determined by dividing
+ the points argument by the maximum chromsome length, and applying that
+ value to each chromosome.
+}
+\author{Jeff Gentry}
+\seealso{\code{\link{cPlot}}}
+\examples{
+ ## A bit of a hack to not have a package dependency on hgu95av2
+ ## but need to fiddle w/ the warn level to not fail the example anyways.
+ curWarn <- options(warn=0)
+ on.exit(options(warn), add=TRUE)
+ if (require("hgu95av2.db")) {
+ z <- buildChromLocation("hgu95av2")
+
+ for (sc in c("max","relative"))
+ scale <- cScale(1000, chromLengths(z),sc,"Y")
+ } else print("This example needs the hgu95av2 data package")
+}
+\keyword{utilities}
diff --git a/man/eset133a.Rd b/man/eset133a.Rd
new file mode 100644
index 0000000..d812485
--- /dev/null
+++ b/man/eset133a.Rd
@@ -0,0 +1,20 @@
+\name{expressionSet133a}
+\alias{expressionSet133a}
+\docType{data}
+\title{A small dataset for testing}
+\description{
+ An artificial Affymetrix hgu133a dataset, with one
+covariate 'cov1'.
+}
+\usage{data(expressionSet133a)
+}
+\format{
+ The data are artifical. There are 6 cases labeled 1 to
+ 6 and and 22283 genes as in an Affymetrix U133a chips.
+ There is one covariate (factor) whose values are "type 1"
+ for the first 3 samples and "type 2" for the last 3 samples.
+}
+\examples{
+data(expressionSet133a)
+}
+\keyword{datasets}
diff --git a/man/groupedHeatmap.Rd b/man/groupedHeatmap.Rd
new file mode 100644
index 0000000..92608a9
--- /dev/null
+++ b/man/groupedHeatmap.Rd
@@ -0,0 +1,52 @@
+\name{groupedHeatmap}
+\alias{groupedHeatmap}
+
+\title{Heatmap of a matrix with grouped rows and columns}
+\description{The function uses \code{\link[grid]{grid.rect}}
+ and \code{\link[grid]{grid.rect}} to draw a heatmap with grouped rows and columns.
+}
+
+\usage{
+groupedHeatmap(z, frow, fcol,
+ fillcolours = c("#2166ac","#4393c3","#92c5de","#d1e5f0","#fefefe","#fddbc7","#f4a582","#d6604d","#b2182b"),
+ bordercolour = "#e0e0e0",
+ zlim = range(z, na.rm=TRUE))
+}
+
+\arguments{
+ \item{z}{A matrix with row and column names.}
+ \item{frow}{A \code{factor} of length \code{nrow(z)} indicating the
+ row grouping.}
+ \item{fcol}{A \code{factor} of length \code{ncol(z)} indicating the
+ column grouping.}
+ \item{fillcolours}{A \code{character} vector of colours from which the
+ colour map is obtained through interpolation.}
+ \item{bordercolour}{Either a \code{character} vector of length 1,
+ specifying the border colour of the heatmap tiles, or \code{NULL} or
+ \code{NA}, which indicates that the border colour should match the
+ fill colour.}
+ \item{zlim}{Lower and upper limit of \code{z} values represented in the colour
+ map.}
+}
+
+\details{The function can be called within other drawing operations
+ from the grid package, e.g. within a viewport.
+}
+
+\value{The function is called for its side effect, drawing text and
+ rectangles on the current viewport.}
+
+\seealso{\code{\link[grid]{grid.text}}, \code{\link[grid]{grid.rect}}}
+
+\author{Wolfgang Huber \url{http://www.ebi.ac.uk/huber}}
+
+\examples{
+
+data("mtcars")
+
+groupedHeatmap(
+ scale(mtcars),
+ frow = factor(sapply(strsplit(rownames(mtcars), " "), "[", 1)),
+ fcol = factor(round(seq_len(ncol(mtcars))/3)))
+}
+
diff --git a/man/histStack.Rd b/man/histStack.Rd
new file mode 100644
index 0000000..506aeea
--- /dev/null
+++ b/man/histStack.Rd
@@ -0,0 +1,38 @@
+\name{histStack}
+\alias{histStack}
+\title{Stacked histogram}
+\description{Stacked histogram}
+\usage{histStack(x, breaks, breaksFun=paste, ylab="frequency", ...) }
+\arguments{
+ \item{x}{A list of numeric vectors.}
+ \item{breaks}{Histogram breaks, as in
+ \code{\link[graphics:hist]{hist}}}
+ \item{breaksFun}{Function, can be used to control the formatting
+ of the bin labels. See example.}
+ \item{ylab}{Label for the Y-axis on the plot}
+ \item{...}{Further arguments that get passed to
+ \code{\link[graphics:barplot]{barplot}}}
+}
+
+\details{The function calls \code{\link[graphics:hist]{hist}}
+ for each element of \code{x} and plots the frequencies
+ as a stacked barplot using
+ \code{\link[graphics:barplot]{barplot}} with \code{beside=FALSE}.}
+
+\value{The function is called for its side effect, producing a barplot
+ on the active graphics device. It returns the result of the call to
+ \code{\link[graphics:barplot]{barplot}}.}
+
+\author{Wolfgang Huber \url{http://www.ebi.ac.uk/huber}}
+
+\examples{
+ x <- list(rnorm(42), rnorm(42)+2)
+ br <- seq(-3, 5, length=13)
+ cols <- c("#1D267B", "#ceffc0")
+ histStack(x, breaks=br, col=cols)
+
+ histStack(x, breaks=br, col=cols,
+ breaksFun=function(z) paste(signif(z, 3)))
+}
+\keyword{hplot}
+
diff --git a/man/imageMap.Rd b/man/imageMap.Rd
new file mode 100644
index 0000000..8bc9f2d
--- /dev/null
+++ b/man/imageMap.Rd
@@ -0,0 +1,111 @@
+\name{imageMap-methods}
+\docType{methods}
+
+\alias{imageMap}
+\alias{imageMap-methods}
+\alias{imageMap,matrix-method}
+\alias{imageMap,matrix,connection,list,character-method}
+
+\title{Write an HTML IMG tag together with a MAP image map.}
+\description{Write an HTML IMG tag together with a MAP image map.}
+\usage{
+ \S4method{imageMap}{matrix,connection,list,character}(object, con, tags, imgname)
+}
+\arguments{
+ \item{object}{Matrix with 4 columns, specifying the coordinates
+ of the mouse-sensitive region . Each row specifies the corners of a
+ rectangle within the image, in the following order: (left x,
+ lower y, right x, upper y). Note that the point (x=0, y=0) is
+ at the left upper side of the image.}
+ \item{con}{Connection to which the image map is written.}
+ \item{tags}{Named list whose elements are named character vectors.
+ Names must correspond to node names in \code{object}. See details.}
+ \item{imgname}{Character. Name of the image file (for example PNG
+ file) that contains the plot.}
+}
+
+\details{The most important tags are \code{TITLE}, \code{HREF},
+ and \code{TARGET}. If the list \code{tags} contains an element
+ with name \code{TITLE}, then this must be a named character vector
+ containing the tooltips that are to be displayed when the mouse moves
+ over a node. The names of the nodes are specified in the \code{names}
+ attribute of the character vector and must match those of
+ \code{object}.
+
+ Similarly, \code{HREF} may be used to specify hyperlinks that the
+ browser can follow when the mouse clicks on a node, and \code{TARGET}
+ to specify the target browser window.
+
+ Currently, only rectangular regions are implemented; the actual
+ shape of the nodes as specified in \code{object} is ignored.
+ Also, tags for edges of the graph are currently not supported.
+
+ This function is typically used with the following sequence
+ of steps:
+ \enumerate{
+ \item generate your graphic and save it as a bitmap file, e.g.
+ using the \code{jpeg}, \code{\link[grDevices]{png}}, or
+ \code{bitmap} device. At this stage, you also need to
+ figure out the pixel coordinates of the interesting regions
+ within your graphic. Since the mapping between device coordinates
+ and pixel coordinates is not obvious, this may be a little tricky.
+ See the examples below, and for a more complex example, see the
+ source code of the function \code{\link[prada]{plotPlate}}.
+ \item open an HTML page for writing and write HTML header,
+ e.g. using the \code{\link{openHtmlPage}} function.
+ \item Call the \code{\link{imageMap}} function.
+ \item Optionally, write further text into the HTML connection.
+ \item Close HTML file, e.g. using the \code{\link{closeHtmlPage}} function.
+ }
+}
+
+\value{The function is called for its side effect, which is writing text into
+the connection \code{con}.}
+
+\seealso{\code{\link[prada]{plotPlate}},
+ \code{\link[base]{writeLines}}}
+
+\author{Wolfgang Huber \url{http://www.dkfz.de/abt0840/whuber}}
+\keyword{manip}
+\examples{
+f1 = paste(tempfile(), ".html", sep="")
+f2 = paste(tempfile(), ".html", sep="")
+fpng = tempfile()
+
+if(capabilities()["png"]) {
+ ## create the image
+ colors = c("#E41A1C","#377EB8","#4DAF4A","#984EA3","#FF7F00","#FFFF33","#A65628","#F781BF","#999999")
+ width = 512
+ height = 256
+ png(fpng, width=width, height=height)
+ par(mai=rep(0,4))
+ plot(0,xlim=c(0,width-1),ylim=c(0,height-1),xaxs="i",yaxs="i",type="n",bty="n")
+ cx=floor(runif(100)*(width-11))
+ cy=floor(runif(100)*(height-11))
+ coord=cbind(cx, cy, cx+10, cy+10)
+ rect(coord[,1], height-coord[,2], coord[,3], height-coord[,4],
+ col=sample(colors, 100, replace=TRUE))
+ text(width/2, height-3, "Klick me!", adj=c(0.5, 1), font=2)
+ dev.off()
+
+ ## create the frame set
+ cat("<html><head><title>Hello world</title></head>\n",
+ "<frameset rows=\"280,*\" border=\"0\">\n",
+ "<frame name=\"banner\" src=\"file://", f2, "\">\n",
+ "<frame name=\"main\" scrolling=\"auto\">",
+ "</frameset>", sep="",file=f1)
+
+ ## create the image map
+ href =sample(c("www.bioconductor.org", "www.r-project.org"),nrow(coord),replace=TRUE)
+ title =sample(as.character(packageDescription("geneplotter")),nrow(coord),replace=TRUE)
+ con = file(f2, open="w")
+ imageMap(coord, con,
+ list(HREF=paste("http://", href, sep=""),
+ TITLE=title, TARGET=rep("main", nrow(coord))), fpng)
+ close(con)
+
+ cat("Now have a look at file ", f1, " with your browser.\n", sep="")
+}
+}
+
+
diff --git a/man/make.chromOrd.Rd b/man/make.chromOrd.Rd
new file mode 100644
index 0000000..d249ccb
--- /dev/null
+++ b/man/make.chromOrd.Rd
@@ -0,0 +1,33 @@
+\name{make.chromOrd}
+\alias{make.chromOrd}
+\title{Make a chromOrd object }
+\description{
+ This function makes a chromOrd object.
+}
+\usage{
+make.chromOrd(genome, gnames)
+}
+\arguments{
+ \item{genome}{A character string. }
+ \item{gnames}{A character vector of the genes to be selected. }
+}
+\details{
+ This function reads in a lot of annotation data and creates a list
+ with one element for each chromosome. The elements of this list are
+ indices indicating the order of the genes that are on that chromosome
+ (and in the annotation data set being used).
+}
+\value{
+ A list of chromOrd type. One element for each chromosome. Suitable for
+ reordering other values according to the chromosomal location.
+}
+
+\author{ Robert Gentleman }
+
+\seealso{ \code{\link{amplicon.plot}} }
+
+\examples{
+ data(sample.ExpressionSet)
+ make.chromOrd("hgu95A", featureNames(sample.ExpressionSet))
+}
+\keyword{ utilities }
diff --git a/man/multiecdf.Rd b/man/multiecdf.Rd
new file mode 100644
index 0000000..5c2afc5
--- /dev/null
+++ b/man/multiecdf.Rd
@@ -0,0 +1,131 @@
+\name{multiecdf}
+\alias{multiecdf}
+\alias{multiecdf.list}
+\alias{multiecdf.formula}
+\alias{multiecdf.matrix}
+\alias{multidensity}
+\alias{multidensity.list}
+\alias{multidensity.formula}
+\alias{multidensity.matrix}
+
+\title{Multiple empirical cumulative distribution functions (ecdf) and densities}
+
+\description{Plot multiple empirical cumulative distribution functions (ecdf)
+ and densities with a user interface similar to that of \code{\link{boxplot}}.
+ The usefulness of \code{multidensity} is variable, depending on the
+ data and the smoothing kernel.
+ \code{multiecdf} will in many cases be preferable. Please see Details.
+}
+
+\usage{
+multiecdf(x, \dots)
+\method{multiecdf}{formula}(formula, data = NULL, xlab, na.action = NULL, \dots)
+\method{multiecdf}{matrix}(x, xlab, ...)
+\method{multiecdf}{list}(x,
+ xlim,
+ col = brewer.pal(9, "Set1"),
+ main = "ecdf",
+ xlab,
+ do.points = FALSE,
+ subsample = 1000L,
+ legend = list(
+ x = "right",
+ legend = if(is.null(names(x))) paste(seq(along=x)) else names(x),
+ fill = col),
+ \dots)
+
+multidensity(x, \dots)
+\method{multidensity}{formula}(formula, data = NULL, xlab, na.action = NULL, \dots)
+\method{multidensity}{matrix}(x, xlab, ...)
+\method{multidensity}{list}(x,
+ bw = "nrd0",
+ xlim,
+ ylim,
+ col = brewer.pal(9, "Set1"),
+ main = if(length(x)==1) "density" else "densities",
+ xlab,
+ lty = 1L,
+ legend = list(
+ x = "topright",
+ legend = if(is.null(names(x))) paste(seq(along=x)) else names(x),
+ fill = col),
+ density = NULL,
+ \dots)
+}
+
+\arguments{
+ \item{formula}{a formula, such as \code{y ~ grp}, where \code{y} is a
+ numeric vector of data values to be split into groups according to
+ the grouping variable \code{grp} (usually a factor).}
+ \item{data}{a data.frame (or list) from which the variables in
+ \code{formula} should be taken.}
+ \item{na.action}{a function which indicates what should happen
+ when the data contain \code{NA}s. The default is to ignore missing
+ values in either the response or the group.}
+ \item{x}{methods exist for: \code{formula}, \code{matrix}, \code{data.frame}, \code{list} of numeric vectors.}
+ \item{bw}{the smoothing bandwidth, see the manual page for
+ \code{\link[stats]{density}}. The length of \code{bw} needs to be either 1
+ (in which case the same is used for all groups)
+ or the same as the number of groups in \code{x} (in which case the
+ corresponding value of \code{bw} is used for each group).}
+ \item{xlim}{Range of the x axis. If missing, the data range is used.}
+ \item{ylim}{Range of the y axis. If missing, the range of the density
+ estimates is used.}
+ \item{col, lty}{Line colors and line type.}
+ \item{main}{Plot title.}
+ \item{xlab}{x-axis label.}
+ \item{do.points}{logical; if \code{TRUE}, also draw points at the knot
+ locations.}
+ \item{subsample}{numeric or logical of length 1. If numeric, and
+ larger than 0, subsamples of that size are used to compute and plot
+ the ecdf for those elements of \code{x} with more than that number of
+ observations. If logical and \code{TRUE}, a value of 1000 is used for
+ the subsample size.}
+ \item{legend}{a list of arguments that is passed to the function
+ \code{\link[graphics]{legend}}.}
+ \item{density}{a list of arguments that is passed to the function
+ \code{\link[stats]{density}}.}
+ \item{...}{Further arguments that get passed to the \code{plot} functions.}
+}
+
+\seealso{
+ \code{\link[graphics]{boxplot}},
+ \code{\link[stats]{ecdf}},
+ \code{\link[stats]{density}}
+}
+
+\details{\emph{Density estimates}: \code{multidensity} uses the function
+ \code{\link[stats]{density}}. If the density of the data-generating
+ process is smooth on the real axis, then the output from this function tends to produce
+ results that are good approximations of the true density. If,
+ however, the true density has steps (this is in particular the case
+ for quantities such as p-values and correlation coefficients, or for
+ some distributions that have weight only on the posititve numbers, or
+ only on integer numbers), then
+ the output of this function tends to be misleading. In that case, please
+ either use \code{multiecdf} or histograms, or try to improve the
+ density estimate by setting the \code{density}
+ argument (\code{from}, \code{to}, \code{kernel}).
+
+ \emph{Bandwidths}: the choice of the smoothing bandwidths in \code{multidensity}
+ can be problematic, in particular, if the different groups vary with
+ respect to range and/or number of data points. If curves look
+ excessively wiggly or overly smooth, try varying the arguments
+ \code{xlim} and \code{bw}; note that the argument \code{bw} can be a
+ vector, in which case it is expect to align with the groups.}
+
+\value{For the \code{multidensity} functions, a list of
+ \code{\link[stats]{density}} objects.}
+
+\author{Wolfgang Huber}
+
+\examples{
+ words = strsplit(packageDescription("geneplotter")$Description, " ")[[1]]
+ factr = factor(sample(words, 2000, replace = TRUE))
+ x = rnorm(length(factr), mean=as.integer(factr))
+
+ multiecdf(x ~ factr)
+ multidensity(x ~ factr)
+}
+\keyword{hplot}
+
diff --git a/man/openHtmlPage.Rd b/man/openHtmlPage.Rd
new file mode 100644
index 0000000..2aa20b1
--- /dev/null
+++ b/man/openHtmlPage.Rd
@@ -0,0 +1,30 @@
+\name{openHtmlPage}
+\alias{openHtmlPage}
+\alias{closeHtmlPage}
+\title{Open and close an HTML file for writing.}
+\description{Open and close an HTML file for writing..}
+\usage{
+ openHtmlPage(name, title="")
+ closeHtmlPage(con)
+}
+\arguments{
+ \item{name}{Character. File name (\emph{without} the extension '.html').}
+ \item{title}{Character. Value of the \code{title} tag in the HTML header.}
+ \item{con}{Connection.}
+}
+
+\details{See example.}
+
+\value{For \code{openHtmlPage}, a \code{\link[base]{connections}}. }
+
+\author{Wolfgang Huber \url{http://www.dkfz.de/abt0840/whuber}}
+\keyword{IO}
+\examples{
+ fn <- tempfile()
+ con <- openHtmlPage(fn, "My page")
+ writeLines("Hello world", con)
+ closeHtmlPage(con)
+ readLines(paste(fn, ".html", sep=""))
+}
+
+
diff --git a/man/plotChr.Rd b/man/plotChr.Rd
new file mode 100644
index 0000000..8cbaa98
--- /dev/null
+++ b/man/plotChr.Rd
@@ -0,0 +1,64 @@
+\name{plotChr}
+\alias{plotChr}
+\title{Plot Smoothed Sense/Anti-sense of Specified Chromosomes}
+\description{
+For a given chromosome, plot the smooths of the sense and the
+anti-sense from 5' to 3' (left to right on x-axis).
+}
+\usage{
+plotChr(chrN, senseObj, cols = rep("black", length(senseObj[[1]])), log = FALSE, xloc = c("equispaced", "physical"), geneSymbols = FALSE, ngenes = 20, lines.at = NULL, lines.col = "red")
+}
+\arguments{
+ \item{chrN}{The desired chromosome, e.g. for humans it would be a character string in the set of c(1:22, "X", "Y").}
+ \item{senseObj}{The result of \code{Makesense}.}
+ \item{cols}{A vector of colors for the lines in the plot, typically specified according to a certain pheotype of samples.}
+ \item{log}{Logical, whether log-transformation should be taken on the smoothed expressions.}
+ \item{xloc}{Determines whether the "Representative Genes"
+ will be displayed according to their relative
+ positions on the chromosome (physical), or spaced
+ evenly (equispaced). Default is equispaced.}
+ \item{geneSymbols}{Logical, whether to use Affy IDs or
+ Gene Symbols for "Representative Genes", default is
+ Affy IDs.}
+ \item{ngenes}{Desired number of "Representative Genes". The
+ number of actual displayed genes may differ.}
+ \item{lines.at}{A vector of Affy IDs. Vertical lines will
+ be drawn at specified genes.}
+ \item{lines.col}{A vector of colors associated with
+ \code{lines.at}.}
+}
+\author{Robert Gentleman and Xiaochun Li}
+\seealso{\code{\link{Makesense}}}
+\examples{
+example(Makesense)
+
+if (interactive())
+ op <- par(ask=TRUE)
+
+cols <- ifelse(expressionSet133a$cov1=="test 1", "red", "green")
+plotChr("21", esetobj, cols)
+
+# plot on log-scale:
+
+plotChr("21", esetobj, cols, log=TRUE)
+
+# genesymbol instead of probe names:
+
+plotChr("21", esetobj, cols, log=TRUE, geneSymbols=TRUE)
+
+# add vertical lines at genes of interest:
+
+gs <- c("220372_at", "35776_at", "200943_at")
+plotChr("21", esetobj, cols, log=TRUE, geneSymbols=FALSE, lines.at=gs)
+
+# add vertical lines at genes of interest
+# with specified colors:
+
+gs <- c("220372_at", "35776_at", "200943_at")
+cc <- c("blue", "cyan","magenta")
+plotChr("21", esetobj, cols, log=TRUE, geneSymbols=FALSE, lines.at=gs,
+lines.col=cc)
+if (interactive())
+ par(op)
+}
+\keyword{hplot}
diff --git a/man/plotExpressionGraph.Rd b/man/plotExpressionGraph.Rd
new file mode 100644
index 0000000..b84f679
--- /dev/null
+++ b/man/plotExpressionGraph.Rd
@@ -0,0 +1,91 @@
+\name{plotExpressionGraph}
+\alias{plotExpressionGraph}
+\alias{getPlotExpressionColors}
+\alias{IMCAEntrezLink}
+\alias{defMapFun}
+\title{A function to plot a graph colored by expression data}
+\description{
+ Given a graph and expression data for one entity, will plot the graph
+ with the nodes colored according to the expression levels provided.
+}
+\usage{
+plotExpressionGraph(graph, nodeEGmap, exprs, ENTREZIDenvir, mapFun, log = FALSE, nodeAttrs = list(), ...)
+}
+\arguments{
+ \item{graph}{The graph to plot}
+ \item{nodeEGmap}{A \code{list} with element names being node names and the
+ elements being EntrezLink IDs corresponding to those node names.}
+ \item{exprs}{A \code{vector} of expression data, with names being Affymetrix
+ IDs and values being the expression level.}
+ \item{ENTREZIDenvir}{An \code{environment} mapping Affymetrix IDs to EntrezLink
+ IDs, such as the ones provided in the xxx2ENTREZID environments from
+ the Bioconductor data packages (where xxx) is a data package).}
+ \item{mapFun}{A function to map expression levels to colors.}
+ \item{log}{Whether or not the expression data.}
+ \item{nodeAttrs}{A \code{list} of node attributes, as per \code{plot.graph}.}
+ \item{\dots}{Any extra arguments to be passed to \code{plot.graph}.}
+}
+\details{
+ This function can be used to plot a graph and have the nodes colored
+ according to expression levels provided by the user. The
+ \code{graph} parameter is a \code{graph} object from the \code{graph}
+ package.
+
+ The \code{nodeEGmap} parameter is a list that maps the nodes of the
+ graphs to EntrezLink IDs. An example of this is the
+ \code{IMCAEntrezLink} object in the
+ \code{integrinMediatedCellAdhesion} data set in the
+ \code{graph} package.
+
+ The \code{exprs} argument is a vector mapping expression levels to
+ Affymetrix IDs. One way to generate an appropriate vector is to
+ extract a single column from an \code{ExpressionSet}.
+
+ The \code{ENTREZIDenvir} environment maps Affymetrix IDs to EntrezLink
+ IDs. The simplest way to provide this argument is to load the
+ preferred Bioconductor data package (e.g. \code{hgu95av2.db}) and pass in
+ that package's \code{xxx2ENTREZID}, where \code{xxx} is the name of the
+ package.
+
+ The \code{mapFun} function defaults to the function \code{defMapFun},
+ which maps nodes to be either blue, green or red depending for
+ expression ranges of 0-100, 101-500, and 501+. In the case where
+ \code{log} is \code{TRUE} these ranges are modified with
+ \code{\link{log2}}. Custom versions of this function can be supplied
+ by the user - it must take two parameters, first the expression vector
+ and a boolean value (\code{log}) specifying if the data has had a
+ \code{log2} applied to it. The function must return a vector with the
+ same names as the expression vector, but the values of the vector will
+ be color strings.
+
+ The \code{nodeAttrs} list can be specified if any other node
+ attributes are desired to be set by the user. Please see the
+ \code{\link[Rgraphviz:plot-methods]{plot.graph}} man page for more
+ information on this. The
+ other attribute list (\code{attrs} and \code{edgeAttrs}) can be passed
+ in via the \code{...} parameter.
+
+ The IMCAEntrezLink data structure was created for the purpose of
+ illustrating this program. On Sept 24 2007, the current version
+ of \code{hgu95av2.db} was used to map from the nodes of IMCAGraph
+ (in graph package) to Entrez identifiers.
+}
+\author{Jeff Gentry}
+\seealso{\code{\link[Rgraphviz:plot-methods]{plot.graph}},
+ \code{integrinMediatedCellAdhesion}}
+\examples{
+ if (require("Rgraphviz") && require("hgu95av2.db") &&
+ require("fibroEset")) {
+ data(integrinMediatedCellAdhesion)
+ data(IMCAEntrezLink)
+ data(fibroEset)
+ attrs <- getDefaultAttrs()
+ attrs$graph$rankdir <- "LR"
+ plotExpressionGraph(IMCAGraph, IMCAEntrezLink,
+ exprs(fibroEset)[,1],
+ hgu95av2ENTREZID, attrs = attrs)
+ }
+}
+\keyword{utilities}
+\keyword{graphs}
+\keyword{hplot}
diff --git a/man/plotMA.Rd b/man/plotMA.Rd
new file mode 100644
index 0000000..6c19539
--- /dev/null
+++ b/man/plotMA.Rd
@@ -0,0 +1,61 @@
+\name{plotMA-methods}
+\docType{methods}
+\alias{plotMA}
+\alias{plotMA-methods}
+\alias{plotMA,data.frame-method}
+\alias{plotMA,ExonCountSet-method}
+\title{Generate an MA plot}
+
+\description{Generate a plot of log fold change versus mean expression (MA plot)}
+
+\usage{
+\S4method{plotMA}{data.frame}( object, ylim = NULL,
+ colNonSig = "gray32", colSig = "red3", colLine = "#ff000080",
+ log = "x", cex=0.45, xlab="mean expression", ylab="log fold change", ... )
+}
+
+\arguments{
+ \item{object}{
+ A \code{data.frame} with (at least) three columns, the first containing the
+ mean expression values (for the x-axis), the second the logarithmic fold change
+ (for the-y axis) and the third
+ a logical vector indicating significance (for the colouring of the dots).
+ }
+ \item{ylim}{
+ The limits for the y-axis. If missing, an attempt is made to choose a sensible value.
+ Dots exceeding the limits will be displayed as triangles at the limits, pointing outwards.
+ }
+ \item{colNonSig}{
+ colour to use for non-significant data points.
+ }
+ \item{colSig}{
+ colour to use for significant data points.
+ }
+ \item{colLine}{
+ colour to use for the horizontal (y=0) line.
+ }
+ \item{log}{
+ which axis/axes should be logarithmic; will be passed to \code{\link{plot}}.
+ }
+ \item{cex}{
+ The \code{cex} parameter for \code{\link{plot}}.
+ }
+ \item{xlab}{
+ The x-axis label.
+ }
+ \item{ylab}{
+ The y-axis label.
+ }
+ \item{...}{
+ Further parameters to be passed through to \code{\link{plot}}.
+ }
+}
+
+\examples{
+ plotMA(
+ data.frame(
+ `M` = exp(rexp(1000)),
+ `A` = rnorm(1000) -> tmp,
+ `isde` = abs(tmp)>2)
+ )
+}
diff --git a/man/savepng.Rd b/man/savepng.Rd
new file mode 100644
index 0000000..89e2e60
--- /dev/null
+++ b/man/savepng.Rd
@@ -0,0 +1,73 @@
+\name{savepng}
+\alias{savepdf}
+\alias{saveeps}
+\alias{savepng}
+\alias{savetiff}
+
+\title{Save the contents of the current graphics device to a file}
+\description{Save the contents of the current graphics device to file}
+
+\usage{
+ savepdf(fn, dir, width=6, asp=1)
+ saveeps(fn, dir, width=6, asp=1)
+ savepng(fn, dir, width=480, asp=1)
+ savetiff(fn, dir, density=360, keeppdf=TRUE, ...)
+}
+
+\arguments{
+ \item{fn}{character: name of the output file (without extension).
+ An extension \code{.pdf}, \code{.eps}, \code{.png}, or \code{.tiff}
+ will be added automatically.}
+ \item{dir}{character: directory to which the file should be written.}
+ \item{width}{numeric: width of the image in pixels (png) or inches
+ (pdf, eps).}
+ \item{asp}{numeric: aspect ratio; height=width*asp.}
+ \item{density}{pixels per inch (see Details).}
+ \item{keeppdf}{Should the intermediate PDF file (see Details)
+ be kept? If \code{FALSE}, it is deleted before the function
+ returns.}
+ \item{...}{Further arguments that are passed on to \code{savepdf}
+ (see Details).}
+}
+
+\details{The functions are called for their side effect, writing a
+ graphics file.
+
+ \code{savepdf}, \code{savepng}, and \code{saveeps} use the
+ devices \code{\link[grDevices]{pdf}}, \code{\link[grDevices]{png}}, and
+ \code{\link[grDevices]{postscript}}, respectively.
+
+ There is currently no TIFF device for R, so \code{savetiff}
+ works differently. It relies on the external tool \code{convert} from
+ the ImageMagick software package. First, \code{savetiff} produces
+ a PDF files with \code{savepdf}, then uses \code{\link{system}} to
+ invoke \code{convert} with the parameter \code{density}.
+ \code{savetiff} does \bold{not} check for the existence of
+ \code{convert} or the success of the system call, and returns silently
+ no matter what.
+}
+
+\value{Character: name of the file that was written.}
+
+\author{Wolfgang Huber \url{http://www.dkfz.de/abt0840/whuber}}
+
+\seealso{\code{\link[grDevices:dev2]{dev.copy}},
+ \code{\link[grDevices]{pdf}}, \code{\link[grDevices]{png}},
+ \code{\link[grDevices]{postscript}}}
+
+\examples{
+ x = seq(0, 20*pi, len=1000)
+ plot(x*sin(x), x*cos(x), type="l")
+
+ try({ ## on some machines, some of the devices may not be available
+ c(
+ savepdf("spiral", dir=tempdir()),
+ savepng("spiral", dir=tempdir()),
+ saveeps("spiral", dir=tempdir()),
+ savetiff("spiral", dir=tempdir())
+ )
+ })
+}
+
+\keyword{programming}
+\keyword{error}
diff --git a/vignettes/byChroms.Rnw b/vignettes/byChroms.Rnw
new file mode 100644
index 0000000..63d9310
--- /dev/null
+++ b/vignettes/byChroms.Rnw
@@ -0,0 +1,110 @@
+%
+% NOTE -- ONLY EDIT THE .Rnw FILE!!! The .tex file is
+% likely to be overwritten.
+%
+% \VignetteIndexEntry{How to assemble a chromLocation object}
+% \VignetteAuthor{R. Gentleman}
+%\VignetteDepends{annotate, hu6800.db}
+%\VignetteKeywords{chromosomes}
+%\VignettePackage{geneplotter}
+\documentclass[12pt]{article}
+
+\usepackage{amsmath}
+\usepackage{hyperref}
+
+\newcommand{\Rfunction}[1]{{\texttt{#1}}}
+\newcommand{\Robject}[1]{{\texttt{#1}}}
+\newcommand{\Rpackage}[1]{{\textit{#1}}}
+
+
+\textwidth=6.2in
+\textheight=8.5in
+%\parskip=.3cm
+\oddsidemargin=.1in
+\evensidemargin=.1in
+\headheight=-.3in
+
+\newcommand{\scscst}{\scriptscriptstyle}
+\newcommand{\scst}{\scriptstyle}
+
+\bibliographystyle{plainnat}
+
+\begin{document}
+
+\section*{How to Assemble a chromLocation Object}
+
+
+In order to use the various \Rpackage{geneplotter} functions you will
+need to assemble an object of class \Robject{chromLocation}.
+This is relatively straightforward if you have access to a Bioconductor
+data package. In this example we will consider using the
+\Rpackage{hu6800.db} data package to construct our object. This vignette
+was built with version \Sexpr{packageDescription("hu6800.db")$Version} of
+the package.
+
+<<loaddata>>=
+
+ library("annotate")
+ library("hu6800.db")
+ lens <- unlist(eapply(hu6800CHR, length))
+
+ table(lens)
+ wh2 = mget(names(lens)[lens==2], env = hu6800CHR)
+
+ wh2[1]
+@
+
+So somehow \Sexpr{length(wh2)} of the genes are mapped to two
+ different chromosomes. Based on OMIM the these genes are localized
+ to the so called \textit{pseudoautosomal region} where the X and Y
+ cromosomes are similar and there is actual recombination going on
+ between them. So, we will take the expedient measure of assigning
+ each of them to just one chromosome.
+
+<<fixdata>>=
+chrs2 <- unlist(eapply(hu6800CHR, function(x) x[1]))
+chrs2 <- factor(chrs2)
+length(chrs2)
+ table(unlist(chrs2))
+@
+
+Now we are ready to obtain the chromosome location data and
+orientation. The chromosome location data tells us the (approximate)
+location of the gene on the chromosome. The positions for both the
+sense and antisense strand are number of base pairs measured from the
+p (5' end of the sense strand) to q (3' end of the sense strand) arms.
+Chromosomes are double stranded and the gene is encoded on only one of
+those two strands. The strands are labeled plus and minus (sense and
+antisense). We use both the location and the orientation when making
+plots.
+
+<<strandloc>>=
+
+ strand <- as.list(hu6800CHRLOC)
+
+ splits <- split(strand, chrs2)
+ length(splits)
+ names(splits)
+
+@
+
+Now we have processed the data and are ready to construct a new
+\Robject{chromLocation} object.
+
+<<chrloc>>=
+
+ newChrClass <- buildChromLocation("hu6800")
+
+@
+
+And finally we can test it by calling \Rfunction{cPlot}.
+
+<<cPlot, fig=TRUE>>=
+
+ library(geneplotter)
+
+ cPlot(newChrClass)
+
+@
+
+\end{document}
diff --git a/vignettes/visualize.Rnw b/vignettes/visualize.Rnw
new file mode 100644
index 0000000..c60e1b2
--- /dev/null
+++ b/vignettes/visualize.Rnw
@@ -0,0 +1,153 @@
+%
+% NOTE -- ONLY EDIT THE .Rnw FILE!!! The .tex file is
+% likely to be overwritten.
+%
+
+
+% \VignetteIndexEntry{Visualization of Microarray Data}
+% \VignetteDepends{Biobase, annotate, geneplotter, hgu95av2.db}
+% \VignetteKeywords{Expression Analysis}
+%\VignettePackage{geneplotter}
+\documentclass[12pt]{article}
+
+\usepackage{amsmath}
+\usepackage{hyperref}
+
+\newcommand{\Rfunction}[1]{{\texttt{#1}}}
+\newcommand{\Robject}[1]{{\texttt{#1}}}
+\newcommand{\Rpackage}[1]{{\textit{#1}}}
+
+\author{Robert Gentleman}
+
+\begin{document}
+\title{Overview: Visualization of Microarray Data}
+\maketitle{}
+
+\section{Overview}
+
+In this document we present a brief overview of the visualization
+methods that are available in Bioconductor project.
+To make use of these tools you will need the packages: \Rpackage{Biobase},
+\Rpackage{annotate}, and \Rpackage{geneplotter}. These must be installed in your
+version of R and when you start R you must load them with the
+\Rfunction{library} command.
+
+A quick word of warning regarding the interpretation of these
+plots. We can only plot where the gene is supposed to be. If there are
+translocations or amplifications these will not be detected by
+microarray analyses.
+
+<<getl>>=
+library(geneplotter)
+@
+
+
+\section{Whole Genome Plots}
+
+The functions \Rfunction{cPlot} and \Rfunction{cColor} allow the user to
+associate microarray expression data with chromosomal location.
+The plots can include any subset (by default all chromosomes are
+shown) of chromosomes for the organism being considered.
+
+To make these plots we use the complete reference set of genes
+for the organism being studied. We must then obtain the chromosomal
+location (in bases) and orientation (which strand) the gene is on.
+Chromosomes are represented by straight lines parallel to the
+$x$--axis. Genes are represented by short perpendicular lines. All
+genes for the experiment (i.e. for an Affymetrix U95A analysis we show
+all genes on the chips).
+
+The user can then change the color of different sets of the
+genes according to their needs.
+
+The original setup is done using \Rfunction{cPlot}. The subsequent coloring
+is done using \Rfunction{cColor}.
+
+
+We will use the example data in \Robject{sample.ExpressionSet} to show how this function
+might be used.
+
+<<start>>=
+data(sample.ExpressionSet)
+eset = sample.ExpressionSet # legacy naming
+mytt <- function(y, cov2) {
+ ys <- split( y, cov2 )
+ t.test( ys[[1]], ys[[2]] )
+ }
+
+ttout <- esApply(eset, 1, mytt, eset$type)
+s1means <- sapply(ttout, function(x) x$estimate[1])
+s2means <- sapply(ttout, function(x) x$estimate[2])
+deciles <- quantile(c(s1means, s2means), probs=seq(0,1,.1))
+s1class <- cut(s1means, deciles)
+names(s1class) <- names(s1means)
+s2class <- cut(s2means, deciles)
+names(s2class) <- names(s2means)
+@
+
+Next we need to set up the graphics output. We do this in a rather
+complicated way.
+In the plot below we can compare the mean expression levels for genes
+in Group 1 with those in Group 2.
+The Group 1 values are in the left--hand plot and the Group 2 values
+are in the right--hand plot.
+
+\begin{verbatim}
+cols <- dChip.colors(10)
+nf <- layout(matrix(1:3,nr=1), widths=c(5,5,2))
+chrObj <- buildChromLocation("hgu95av2")
+cPlot(chrObj)
+cColor(featureNames(eset), cols[s1class], chrObj)
+cPlot(chrObj)
+cColor(featureNames(eset), cols[s2class], chrObj)
+image(1,1:10,matrix(1:10,nc=10),col=cols, axes=FALSE,
+ xlab="", ylab="")
+axis(2, at=(1:10), labels=levels(s1class), las=1)
+\end{verbatim}
+
+
+\begin{center}
+<<f11,fig=TRUE, echo=FALSE>>=
+cols <- dChip.colors(10)
+def.par <- par(no.readonly = TRUE)# save default, for resetting...
+nf <- layout(matrix(1:3,nr=1), widths=c(5,5,2))
+chrObj <- buildChromLocation("hgu95av2")
+cPlot(chrObj)
+cColor(featureNames(eset), cols[s1class], chrObj)
+cPlot(chrObj)
+cColor(featureNames(eset), cols[s2class], chrObj)
+image(1,1:10,matrix(1:10,nc=10),col=cols, axes=FALSE,
+ xlab="", ylab="")
+axis(2, at=(1:10), labels=levels(s1class), las=1)
+par(def.par)
+@
+\end{center}
+
+\section{Single Chromosome Plots}
+
+A different view of the variation in expression level can be obtained
+by plotting characteristics of expression levels over contiguous
+regions of a chromosome.
+For these plots cummulative expression or per--gene expressions can be
+plotted.
+There are some issues of interpretation here (as in most places) --
+expression is not likely to be controlled too much by chromosomal
+locality. However these plots may be helpful in detecting
+deletions (of both chromatids) or amplifications, or other interesting
+features of the genome.
+
+In this section we will show how one can explore a particular
+chromosome for an amplicon.
+The data arise from a study of breast cancer in the Iglehart
+Laboratory.
+
+\begin{center}
+<<f22,fig=TRUE, echo=FALSE>>=
+ par(mfrow=c(1,1))
+ mycols <- c("red", "darkgreen", "blue")[eset$cov3]
+ alongChrom(eset, "1", chrObj, plotFormat="cumulative",
+ col=mycols)
+@
+\end{center}
+
+\end{document}
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/debian-med/r-bioc-geneplotter.git
More information about the debian-med-commit
mailing list