R/plotPlate.R

In SamGG/cellGrowth: Fitting cell population growth models

#' Plot of a well plate directly from a file using a lattice xyplot
#' 
#' All plot parameters are passed to the \code{\link{xyplot}} function
#' @title Plot of a well plate
#' @param file file name
#' @param labels \code{vector} of characters indicating the label of the wells
#' @param fileParser the file parser which reads the file generated by the machine
#' @param getWellIds function or vector. If getWellIds is a function its parameter is the parsed data of the file parsed by \code{fileParser}. It should return a vector containing the well identifiers, e.g. A01, A02, .. You can as well set the well identifiers as a vector directly
#' @param calibration calibration function applied to the raw data (before scaleY is applied)
#' @param extractRowColumn function which converts well identifiers into row and column names
#' @param cex plot parameter
#' @param scaleX factor which scales the x-axis
#' @param scaleY function how to convert the y-axis ( e.g. log2 )
#' @param strip.lines height in lines of the labels
#' @param strip.cex text-size of the labels
#' @param xlab plot parameter
#' @param ylab plot parameter
#' @param main plot parameter
#' @param scales plot parameter
#' @param ... optional plot parameter. See details
#' @export
#' @examples 
#' plotPlate( system.file("extdata", "tecan_genios.txt", package="cellGrowth"), fileParser=readGenios)
#' @author Andreas Neudecker

plotPlate = function (
		file,
		labels=NULL,
		fileParser=readYeastGrower, 
		getWellIds=getWellIdsTecan,
		calibration=identity,
		extractRowColumn=getRowColumn,
		cex=0.05,
		scaleX=1,
		scaleY=log2,
		strip.lines=1.05,
		strip.cex=0.8,
		xlab="time",
		ylab="log2(OD)",
		main=basename(file),
		scales=list(x=list(rot=45)),
		...
)
{
	## get data from file
	dat = fileParser(file)
	
	## use aliases to match to well index
	if ( is.function ( getWellIds ))
		wellIds = getWellIds( dat )
	else
		wellIds = getWellIds
	
	
	if ( !is.null(labels)){
		l = as.character(labels)
		names(l) = names(labels)
		labels = l[wellIds]
	}
	
	# extract row / column and label
	
	row = extractRowColumn(wellIds)$row
	column = extractRowColumn(wellIds)$column
	
	wellIdsUnique = unique(paste(row,column))
	rowUnique = unique (row)
	columnUnique = unique(column)
	
	nwell <- dim(dat$OD)[2]	# number of wells
	
	## calibration
	if ( !is.function(calibration) )
	{
		warning("Calibration function is not a function. No calibration is done.")
		calibration = identity
	}

	y = sapply(dat$OD,calibration)

	## negative ODs?
	if ( !all(y>=0))
	{
		warning(paste("Negative ODs found in", file,". If you are using a calibration function, this might be the problem. Values are set to NAs"), sep="")
		y[y<0] = NA
	}
	
	# convert OD to log(OD)
	dat$OD = scaleY(y)

	## some data manipulation
	data <- data.frame(
			time=rep(dat$time,nwell),
			OD=c(as.matrix(dat$OD)),
			well=rep(wellIds,each=length(dat$time)),
			row=rep(row,each=length(dat$time)),
			column=rep(column,each=length(dat$time))
	)

	## custom strip function
	strip.plate = function (
				which.given,
				which.panel,
				var.name,
				bg=trellis.par.get("strip.background")$col[which.given],
				label.bg = "#FB8072",
				rowColumn.bg = "#B3DE69",
				...
			)
	{
			if ( is.null(labels) && which.given==1 && which.panel[2] == 1)
			{
				## column numbers
				strip.default(
						which.given=1,
						which.panel=which.panel[1],
						var.name=var.name,
						bg=rowColumn.bg,
						...)
				return()
			}
			if ( !is.null(labels) && which.given==1 && which.panel[2] == 1){
				## column numbers
				var.name[2] = columnUnique[which.panel[1]]
				strip.default(
						which.given=2,
						which.panel=which.panel,
						strip.names=TRUE,
						strip.levels=FALSE,
						var.name=var.name,
						bg=rowColumn.bg,
						...)
				## label
				strip.default(
						which.given=1,
						which.panel=which.panel,
						strip.names=TRUE,
						strip.levels=FALSE,
						bg=label.bg,
						var.name=labels[wellIdsUnique==paste(rowUnique[which.panel[2]],columnUnique[which.panel[1]])],
						...)
				return()
			}
			if ( !is.null(labels) && which.given==1)
			{
				strip.default(
						which.given=1,
						which.panel=which.panel[1],
						strip.names=TRUE,
						strip.levels=FALSE,
						bg=label.bg,
						var.name=labels[wellIdsUnique==paste(rowUnique[which.panel[2]],columnUnique[which.panel[1]])],
						...
				)
				
			}
	}

	strip.plate.left = function (
			which.given,
			which.panel,
			var.name,
			bg=trellis.par.get("strip.background")$col[which.given],
			rowColumn.bg = "#B3DE69",
			horizontal=FALSE,
			...
	)
	{
		if ( which.given==2 && which.panel[1] == 1)
		{
			strip.default(
					horizontal=horizontal,
					which.given=1,
					bg=rowColumn.bg,
					which.panel=which.panel[2],
					var.name=labels[wellIdsUnique==paste(rowUnique[which.panel[2]],columnUnique[which.panel[1]])],
					...
			)
			
		}
	}
	if ( is.null (labels))
		hs = c(strip.lines,rep(0,length(rowUnique)-1))
	else
		hs = c(strip.lines*2,rep(strip.lines,length(rowUnique)-1))
	
	ws = c(strip.lines,rep(0,length(columnUnique)-1))
	
	print(xyplot(OD~scaleX*time|factor(column)+factor(row),data,
					strip.lines = strip.lines,
					strip = strip.plate,
					strip.left = strip.plate.left,
					par.strip.text=list(lines=0.5*strip.lines,cex=strip.cex),
					cex=cex,
					xlab=xlab,
					ylab=ylab,
					main=main,
					scales=scales,
					par.settings=list(
							layout.heights=list(strip=hs),
							layout.widths=list(strip.left=ws)
					),
					as.table=TRUE,...))
}