imgplot {DAAGbio}R Documentation

Image plot of spotted expression array data

Description

Creates an image of graduated colors that represent the values of a statistic for each spot on a spotted microarray. By default, the only the 5 shown. The initial version was based on plot.spatial in the sma package.

Usage

imgplot(z = DAAGbio::coralRG$R[, 1], layout = DAAGbio::coralRG$printer, crit1 = 0.05,
crit2 = crit1, key.side=2,
lohi.colors = c("#9E0142", "#D53E4F", "#F46D43", "#FDAE61", "#ABDDA4",
"#66C2A5", "#3288BD", "#5E4FA2"), nacolor = "#FFFF00",
boxplot.side = 1, split = "quantiles")

Arguments

z

values to be plotted

layout

layout of spots, in the order (rows of grids, columns of grids, rows of spots in a grid, columns in a grid)

crit1

Choose the lower threshold to include this proportion at the high end

crit2

Choose the upper threshold to include this proportion of values at the low end

key.side

Side on which the color key should appear

lohi.colors

Graduated sequence of colors

nacolor

Use this color for NAs

boxplot.side

Show boxplot on this side of figure region

split

Specify "intervals" or "quantiles", as required

Value

A plot is created on the current graphics device

Author(s)

J. H. Maindonald

Examples

## The function is currently defined as
function (z=DAAGbio::coralRG$R[,1], layout=cDAAGbio::oralRG$printer, crit1 = 0.05,
            crit2 = crit1, key.side=2,
            lohi.colors=c("#9E0142","#D53E4F","#F46D43","#FDAE61",
              "#ABDDA4","#66C2A5","#3288BD","#5E4FA2"),
            nacolor="#FFFF00", boxplot.side=1, split="quantiles")
{
  "block2matrix" <-
    function(z, sr=3, sc=2, gr=2, gc=2){
      ## Assumes that values in the vector z are  in row major
      ## order within blocks of dimension sr x sc, with blocks
      ## in row major order within a gr x gc array of grids.
      ## Elements in the vector that is returned are in row
      ## major order wrt the sr*gr x sc*gc matrix of values on
      ## the slide. (It is given the dimensions of a matrix.)
      xy <- array(z, dim=c(sc, sr, gc, gr))
      xy <- aperm(xy, c(1,3,2,4))
      dim(xy) <- c(sc*gc, gr*sr)
      xy}
  quantile.na <- function (z, ...)
    {
      tmp <- !(is.na(z) | is.infinite(z))
      quantile(z[tmp], ...)
    }
  length.na <- function (z, ...)
    {
      tmp <- !(is.na(z) | is.infinite(z))
      length(z[tmp], ...)
    }
    if(is.matrix(z))warning("z is a matrix, You probably want a column vector")
  bplot <- function(z, boxplot.side=1){
    xrange <- range(z,na.rm=TRUE)
    iqr <- diff(quantile(xrange, c(.25,.75)))
    bwex <- diff(xrange)/(3*iqr)
    xhi <- max(z,na.rm=TRUE)
    xusr <- par()$usr[c(1:2)]
    xpos=pretty(z[!is.na(z)], n=5)
    z <- xusr[1]+(z-xrange[1])*diff(xusr)/diff(xrange)
    newpos <- xusr[1]+(xpos-xrange[1])*diff(xusr)/diff(xrange)
    par(xpd=TRUE)
    atvert <- switch(boxplot.side, par()$usr[3]-par()$cxy[2]*0.8,
                     "", par()$usr[4]+par()$cxy[2]*0.8, "")
    if(atvert!=""){
      boxplot(z, at=atvert, boxwex=bwex, add=TRUE, horizontal=TRUE, xaxt="n")
      axis(side=boxplot.side, line=1.5,
           at=newpos, labels=xpos, cex.axis=0.75, mgp=c(2, 0.5, 0))
    }
    par(xpd=FALSE)
  }
  if (crit1 >= 1)
    crit1 <- crit1/(length.na(z))
  if (crit2 >= 1)
    crit2 <- crit2/(length.na(z))
  tmpind <- (z > quantile.na(z, probs = 1 - crit2)) | (z <
                                  quantile.na(z, probs = crit1))
  n <- prod(unlist(layout))
  n.all <- length(z)
  n.na <- sum(is.na(z))
  nhalf <- length(lohi.colors)%/%2
  n2 <- 2*nhalf
  n.one <- length(lohi.colors)
  plo <- crit1*(0:nhalf)/nhalf
  phi <- 1-crit2*(nhalf:0)/nhalf
  quiles1 <- quantile.na(z, plo)
  quiles2 <- quantile.na(z, phi)
  if(split=="intervals"){
    quiles1[2:nhalf] <- quiles1[1]+(quiles1[nhalf+1]-quiles1[1])*
      (1:(nhalf-1))/nhalf
    quiles2[2:nhalf] <- quiles2[1]-(quiles2[nhalf+1]-quiles2[1])*
      ((nhalf-1):1)/nhalf
    plo[-1] <- sapply(quiles1[-1],
                      function(x, z)sum(z<=x, na.rm=TRUE)/length.na(z), z=z)
    phi[-1] <- sapply(quiles2[-1],
                      function(x, z)sum(z<=x, na.rm=TRUE)/length.na(z), z=z)
  }

  if(crit1+crit2<1){
    quiles <- c(quiles1,quiles2)
    frac <- c(plo, phi)
    colpal <- c(lohi.colors[1:nhalf],"#FFFFFF",
                lohi.colors[(n.one-nhalf+1):(n.one)])
    midbreak <- TRUE
  }
  else {colpal <- lohi.colors
        midbreak <- FALSE
        quiles <- quantile.na(z, (0:n.one)/n.one)
        frac <- c(plo, phi[-1])
      }
  dups <- duplicated(quiles)
  if(any(dups)){
    cats <- seq(along=quiles[-1])
    filledcats <- cats[!dups]
    cutcats <- as.integer(cut(z, quiles[!dups], include.lowest=TRUE))
    fullm <- filledcats[cutcats]}
  else fullm <- as.integer(cut(z, quiles, include.lowest=TRUE))
  n.one <- length(colpal)
  nrects <- length(quiles)
  if(any(is.na(z))){
    nacat <- TRUE
    fullm[is.na(fullm)] <- max(unique(fullm[!is.na(fullm)]))+1
    colpal <- c(colpal, nacolor)
  }
  else nacat <- FALSE
  if ((length(as.vector(z)) != n) & (!is.null(names(z)))) {
    y <- fullm[tmpind]
    fullm <- rep(NA, n)
    fullm[as.integer(names(y))] <- y
  }
  else fullm[!tmpind] <- NA
  if ((length(as.vector(z)) != n) & (is.null(names(z)))) {
    stop(paste("Error: Length of vector is different from total number\n",
               "of spots and vector has no row.name.\n"))
  }
#################################################################
  gc <- layout$ngrid.c
  gr <- layout$ngrid.r
  sc <- layout$nspot.c
  sr <- layout$nspot.r
  full <- block2matrix(fullm, sr, sc, gr, gc)
  image(1:ncol(full), 1:nrow(full), t(full), axes = FALSE,
        xlab = "", ylab = "", col=colpal)
  box()
  abline(v = ((gr - 1):1) * (sr) + 0.5)
  abline(h = (1:(gc - 1)) * (sc) + 0.5)
#################################################################
  if(boxplot.side%in%c(1,3))bplot(z, boxplot.side=boxplot.side)
  if(key.side%in%c(2,4)){
    chw <- par()$cxy[1]
    barwid <- 0.75*chw
    if(key.side==2){
      x0 <- par()$usr[1]-chw-barwid
      xcutpos <- x0 - 0.4*chw
      xquilepos <- x0+barwid+0.55*chw
      srt <- 90
    }
    else {
      x0 <- par()$usr[2]+chw
      xcutpos <- x0 + barwid + 0.4*chw
      xquilepos <- x0-0.4*chw
      srt <- -90
    }
    yvals2 <- seq(from=par()$usr[3], to=par()$usr[4],
                  length=n2+midbreak+2*nacat+1)[-(n2+midbreak+2*nacat+1)]
    eps2 <- diff(yvals2[1:2])

    if(nacat){
      nlast <- length(yvals2)
      nclast <- length(colpal)
      rect(x0, yvals2[nlast], x0+barwid, yvals2[nlast]+eps2,
           col=colpal[nclast], xpd=TRUE)
      text(x0+0.5*barwid, yvals2[nlast]+0.5*eps2, "NA",
           xpd=TRUE, srt=srt)
      yvals2 <- yvals2[-((nlast-1):nlast)]
      colpal <- colpal[-nclast]
    }
    if(!midbreak){
      rect(x0, yvals2, x0+barwid, yvals2+eps2,
           col=colpal, xpd=TRUE)
      text(xcutpos, c(yvals2[1],yvals2+eps2),
           paste(signif(quiles,3)), srt=srt, xpd=TRUE, cex=0.8)
      text(xquilepos, yvals2[1], "(0%)", srt=srt, xpd=TRUE, cex=0.65)
      fracs <- frac[-c(1, length(frac))]
      text(xquilepos, yvals2[-1],
           paste("(",round(fracs*100,2),")",sep=""),
           srt=srt, xpd=TRUE, cex=0.65)
      text(xquilepos, yvals2[length(yvals2)]+eps2, "(100%)", srt=srt,
           xpd=TRUE, cex=0.65)

    }
    else {rect(x0, yvals2[1:nhalf], x0+barwid, yvals2[1:nhalf]+eps2,
               col=colpal[1:nhalf], xpd=TRUE)
          rect(x0, yvals2[(nhalf+2):(2*nhalf+1)], x0+barwid,
               yvals2[(nhalf+2):(2*nhalf+1)]+eps2,
               col=colpal[(nhalf+2):(2*nhalf+1)], xpd=TRUE)
          text(xcutpos, yvals2[1:(nhalf+1)],
               paste(signif(quiles1,3)), srt=srt, xpd=TRUE, cex=0.8)
          text(xquilepos, yvals2[2:(nhalf+1)],
               paste("(",round(plo[-1]*100,2),")",sep=""), srt=srt,
               xpd=TRUE, cex=0.65)
          text(xquilepos, yvals2[1], "(0%)", srt=srt, xpd=TRUE, cex=0.65)
          text(xcutpos,
               c(yvals2[(nhalf+2):(2*nhalf+1)], yvals2[2*nhalf+1]+eps2),
               paste(signif(quiles2,3)), srt=srt, xpd=TRUE, cex=0.8)
          text(xquilepos, yvals2[(nhalf+2):(2*nhalf+1)],
               paste("(",round(phi[-length(phi)]*100,2),")",sep=""),
               srt=srt, xpd=TRUE, cex=0.65)
          text(xquilepos, yvals2[2*nhalf+1]+eps2, "(100%)", srt=srt,
               xpd=TRUE, cex=0.65)
        }
  }
  invisible()
  }

[Package DAAGbio version 0.63-4 Index]