R/classes.R

Defines functions unique.TestResults as.data.frame.MArrayLM as.data.frame.EListRaw as.data.frame.MAList as.matrix.vsn as.matrix.LumiBatch as.matrix.PLMset as.matrix.marrayNorm as.matrix.MArrayLM as.matrix.EList as.matrix.MAList as.matrix.RGList as.MAList summary.EList .setdimnames dimnames.MArrayLM dimnames.EList dimnames.MAList dimnames.RGList dim.MArrayLM dim.EList dim.MAList dim.RGList printHead

Documented in as.data.frame.EListRaw as.data.frame.MAList as.data.frame.MArrayLM as.MAList as.matrix.EList as.matrix.LumiBatch as.matrix.MAList as.matrix.MArrayLM as.matrix.marrayNorm as.matrix.PLMset as.matrix.RGList as.matrix.vsn dim.EList dim.MAList dim.MArrayLM dimnames.EList dimnames.MAList dimnames.MArrayLM dimnames.RGList dim.RGList printHead summary.EList unique.TestResults

#  CLASSES.R
#  This file defines data classes and extends standard base R methods to them.
#  Other non-data classes are defined elsewhere in limma. See plotMDS.R for
#  the "MDS" class, decideTests.R for the "TestResults" class and
#  geneset-roast.R for the "Roast" class,


setClass("RGList",
#  Class to hold initial read-in two-color data
representation("list")
)

setClass("MAList",
#  Class to hold normalized, rotated two-color data
representation("list")
)

setClass("EListRaw",
#  Class to hold one channel data on raw scale
representation("list")
)

setClass("EList",
#  Class to hold one channel data on log scale
representation("list")
)

setClass("MArrayLM",
#  Class to hold linear model fit
representation("list")
)

printHead <- function(x)
#  Print leading 5 elements or rows of atomic object
#  Gordon Smyth
#  May 2003.  Last modified 4 March 2017.
{
	if(is.atomic(x)) {
		d <- dim(x)
		if(length(d)<2) which <- "OneD"
		if(length(d)==2) which <- "TwoD"
		if(length(d)>2) which <- "Array"
	} else {
		if(inherits(x,"data.frame")) {
			d <- dim(x)
			which <- "TwoD"
		} else {
			if(is.call(x))
				which <- "Call"
			else {
				if(is.recursive(x))
					which <- "Recursive"
				else
					which <- "Other"
			}
		}
	}
	switch(which,
	OneD={
		n <- length(x)
		if(n > 20) {
			print(x[1:5])
			cat(n-5,"more elements ...\n")
		} else
			print(x)
	},
	TwoD={
		n <- d[1]
		if(n > 10) {
			print(x[1:5,,drop=FALSE])
			cat(n-5,"more rows ...\n")
		} else
			print(x)
	},
	Array={
		n <- d[1]
		if(n > 10) {
			dn <- dimnames(x)
			dim(x) <- c(d[1],prod(d[-1]))
			x <- x[1:5,,drop=FALSE]
			dim(x) <- c(5,d[-1])
			if(!is.null(dn[[1]])) dn[[1]] <- dn[[1]][1:5]
			dimnames(x) <- dn
			print(x)
			cat(n-5,"more rows ...\n")
		} else
			print(x)
	},
	Recursive={
		n <- length(x)
		if(n) {
			i <- names(x)
			if(is.null(i)) i <- seq_len(n)
			for (what in i) {
				y <- x[[what]]
				cat("$",what,"\n",sep="")
				Recall(y)
				cat("\n")
			}
		}
	},
	Call=,Other=print(x)
	)
}

setClass("LargeDataObject")
setIs("RGList","LargeDataObject")
setIs("MAList","LargeDataObject")
setIs("EListRaw","LargeDataObject")
setIs("EList","LargeDataObject")
setIs("MArrayLM","LargeDataObject")

setMethod("show","LargeDataObject",
#  Print and show method large data objects
#  Gordon Smyth
#  May 2003
function(object) {
	cat("An object of class \"",class(object),"\"\n",sep="")
	for (what in names(object)) {
		x <- object[[what]]
		cat("$",what,"\n",sep="")
		printHead(x)
		cat("\n")
	}
	for (what in setdiff(slotNames(object),".Data")) {
		x <- slot(object,what)
		if(length(x) > 0) {
			cat("@",what,"\n",sep="")
			printHead(x)
			cat("\n")
		}
	}
})

dim.RGList <- function(x) if(is.null(x$R)) c(0,0) else dim(as.matrix(x$R))
dim.MAList <- function(x) if(is.null(x$M)) c(0,0) else dim(as.matrix(x$M))
dim.EListRaw <- dim.EList <- function(x) if(is.null(x$E)) c(0,0) else dim(as.matrix(x$E))
dim.MArrayLM <- function(x) if(is.null(x$coefficients)) c(0,0) else dim(as.matrix(x$coefficients))
#length.RGList <- length.MAList <- length.EListRaw <- length.EList <- length.MArrayLM <- function(x) prod(dim(x))

dimnames.RGList <- function(x) dimnames(x$R)
dimnames.MAList <- function(x) dimnames(x$M)
dimnames.EListRaw <- dimnames.EList <- function(x) dimnames(x$E)
dimnames.MArrayLM <- function(x) dimnames(x$coefficients)
.setdimnames <- function(x, value)
#  Dimension names for RGList-like objects
#  Gordon Smyth
#  17 Dec 2005. Last modified 23 March 2009.
{
	exprmatrices <- c("R","G","Rb","Gb","M","A","E","Eb","weights")
	for (a in exprmatrices) if(!is.null(x[[a]])) dimnames(x[[a]]) <- value
	for(a in names(x$other)) dimnames(x$other[[a]]) <- value
	if(!is.null(x$targets)) row.names(x$targets) <- value[[2]]
	if(!is.null(x$design)) rownames(x$design) <- value[[2]]
	x
}
#assign("dimnames<-.RGList",.setdimnames)
#assign("dimnames<-.MAList",.setdimnames)
"dimnames<-.RGList" <- .setdimnames
"dimnames<-.MAList" <- .setdimnames
"dimnames<-.EListRaw" <- "dimnames<-.EList" <- .setdimnames

summary.MArrayLM <- summary.MAList <- summary.RGList <- summary.EListRaw <- summary.EList <- function(object,...) summary(unclass(object))

as.MAList <- function(object) {
#	Convert marrayNorm object to MAList
#	Gordon Smyth
#	20 Sep 2003.  Last modified 20 Dec 2003.

	MA <- new("MAList")
	ifposlen <- function(x) if(length(x)) return(x) else return(NULL)
	MA$A <- ifposlen(object@maA)
	MA$M <- ifposlen(object@maM)
	MA$weights <- ifposlen(object@maW)
	MA$printer$ngrid.r <- ifposlen(object@maLayout@maNgr)
	MA$printer$ngrid.c <- ifposlen(object@maLayout@maNgc)
	MA$printer$nspot.r <- ifposlen(object@maLayout@maNsr)
	MA$printer$nspot.c <- ifposlen(object@maLayout@maNsc)
	MA$printer$notes <- ifposlen(object@maLayout@maNotes)
	MA$genes <- ifposlen(object@maGnames@maInfo)
	MA$genes$Labels <- ifposlen(object@maGnames@maLabels)
	attr(MA$genes,"notes") <- ifposlen(object@maGnames@maNotes)
	MA$genes$Sub <- ifposlen(object@maLayout@maSub)
	MA$genes$Plate <- ifposlen(object@maLayout@maPlate)
	MA$genes$Controls <- ifposlen(object@maLayout@maControls)
	MA$targets <- ifposlen(object@maTargets@maInfo)
	MA$targets$Labels <- ifposlen(object@maTargets@maLabels)
	MA$notes <- ifposlen(object@maNotes)
	MA$maNormCall <- ifposlen(object@maNormCall)
	MA
} 

#  Gordon Smyth, 28 Oct 2004, 23 March 2009
as.matrix.RGList <- function(x,...) normalizeWithinArrays(x,method="none")$M
as.matrix.MAList <- function(x,...) as.matrix(x$M)
as.matrix.EListRaw <- as.matrix.EList <- function(x,...) as.matrix(x$E)
as.matrix.MArrayLM <- function(x,...) x$coefficients
as.matrix.marrayNorm <- function(x,...) x@maM
#  13 July 2006
as.matrix.PLMset <- function(x,...) x@chip.coefs
#  19 Dec 2006, 18 May 2007
as.matrix.ExpressionSet <- as.matrix.LumiBatch <- function(x,...) env=x@assayData[["exprs"]]
#  16 Sep 2007
as.matrix.vsn <- function(x,...) x@hx

as.data.frame.MAList <- function(x, row.names = NULL, optional = FALSE, ...)
#	Convert MAList object to data.frame
#	Gordon Smyth
#	10 Dec 2009.
{
	if(is.null(row.names) && !is.null(rownames(x$M))) row.names <- makeUnique(rownames(x$M))
	if(is.null(x$genes)) {
		y <- as.data.frame(x$M,row.names=row.names,check.names=FALSE)
	} else {
		if(is.vector(x$genes)) x$genes <- data.frame(ID=x$genes,stringsAsFactors=FALSE)
		y <- data.frame(x$genes,x$M,row.names=row.names,check.names=FALSE,stringsAsFactors=FALSE)
	}
	y
}

as.data.frame.EList <- as.data.frame.EListRaw <- function(x, row.names = NULL, optional = FALSE, ...)
#	Convert EList object to data.frame
#	Gordon Smyth
#	11 Dec 2009.
{
	if(is.null(row.names) && !is.null(rownames(x$E))) row.names <- makeUnique(rownames(x$E))
	if(is.null(x$genes)) {
		y <- as.data.frame(x$E,row.names=row.names,check.names=FALSE)
	} else {
		if(is.vector(x$genes)) x$genes <- data.frame(ID=x$genes,stringsAsFactors=FALSE)
		y <- data.frame(x$genes,x$E,row.names=row.names,check.names=FALSE,stringsAsFactors=FALSE)
	}
	y
}

as.data.frame.MArrayLM <- function(x, row.names = NULL, optional = FALSE, ...)
#	Convert MArrayLM object to data.frame
#	Gordon Smyth
#	6 April 2005.  Last modified 13 Jan 2006.
{
	x <- unclass(x)
	if(is.null(x$coefficients)) {
		warning("NULL coefficients, returning empty data.frame")
		return(data.frame())
	}
	cn <- names(x)
	nprobes <- NROW(x$coefficients)
	ncoef <- NCOL(x$coefficients)
	include.comp <- cn[unlist(lapply(x,NROW))==nprobes]
	other.comp <- setdiff(names(x),include.comp)
	if(length(other.comp)) for (a in other.comp) x[[a]] <- NULL
#	coef.comp <- c("coefficients","stdev.unscaled","t","p.value","lods")
#	for (a in coef.comp) if(!is.null(x[[a]]) && NCOL(x[[a]])==1) colnames(x[[a]]) <- paste(a,colnames(x[[a]]),sep=".")
	if(ncoef==1) x <- lapply(x,drop)
	as.data.frame(x,row.names=row.names,optional=optional)
}

unique.TestResults <- function(x,...) unique(x@.Data,...)

head.RGList <- head.MAList <- head.EListRaw <- head.EList <- head.MArrayLM <- head.TestResults <-
function (x, n = 6L, ...) 
{
	stopifnot(length(n) == 1L)
	n <- if (n < 0L) 
		max(nrow(x) + n, 0L)
	else
		min(n, nrow(x))
	x[seq_len(n),]
}

tail.RGList <- tail.MAList <- tail.EListRaw <- tail.EList <- tail.MArrayLM <- tail.TestResults <-
function (x, n = 6L, ...) 
{
	stopifnot(length(n) == 1L)
	nrx <- nrow(x)
	n <- if (n < 0L) 
		max(nrx + n, 0L)
	else
		min(n, nrx)
	x[seq.int(to = nrx, length.out = n),]
}
hdeberg/limma documentation built on Dec. 20, 2021, 3:43 p.m.