## ----setClass------------------------------------------------------------ .AnnMat <- setClass("AnnMat", representation(matData="matrix", rowData="data.frame", colData="data.frame")) ## ----generating-function------------------------------------------------- am0 <- .AnnMat() am1 <- .AnnMat( matData=matrix(1:10, 2, dimnames=list(letters[1:2], LETTERS[1:5])), rowData=data.frame(roi_id=1:2), colData=data.frame( sample_id=1:5, treatment=c("A", "A", "B", "B", "B"))) ## ----getters------------------------------------------------------------- setGeneric("rowData", function(x, ...) standardGeneric("rowData")) setGeneric("colData", function(x, ...) standardGeneric("colData")) setGeneric("matData", function(x, ...) standardGeneric("matData")) ## ----getter-methods------------------------------------------------------ setMethod("rowData", "AnnMat", function(x, ...) x@rowData) setMethod("colData", "AnnMat", function(x, ...) x@colData) setMethod("matData", "AnnMat", function(x, ...) x@matData) ## ----dim-getGeneic------------------------------------------------------- getGeneric("dim") ## ----dim-setMethod------------------------------------------------------- setMethod("dim", "AnnMat", function(x) dim(matData(x))) setMethod("dimnames", "AnnMat", function(x) dimnames(matData(x))) ## ----nrow-for-free------------------------------------------------------- dim(am1) nrow(am1) ## ----show---------------------------------------------------------------- setMethod("show", "AnnMat", function(object) { cat("class:", class(object), "\n") cat("dim:", dim(object), "\n") cat("rowData names():", names(rowData(object)), "\n") cat("colData names():", names(colData(object)), "\n") }) am1 ## ----update-------------------------------------------------------------- df <- data.frame(x=1:5, y=5:1) df[,"x"] <- log(df$x) ## ----subset-assign-df---------------------------------------------------- head(get("[<-.data.frame")) ## ----setter-matData------------------------------------------------------ setGeneric("matData<-", function(x, ..., value) standardGeneric("matData<-")) ## ----setter-matData-impl------------------------------------------------- setReplaceMethod("matData", c("AnnMat", "matrix"), function(x, ..., value) { x@matData <- value x }) ## ----setter-dimnames-impl------------------------------------------------ setReplaceMethod("dimnames", c("AnnMat", "list"), function(x, value) { dimnames(matData(x)) <- value value }) ## ----setValidity--------------------------------------------------------- setValidity("AnnMat", function(object) { msg <- NULL if (nrow(rowData(object)) != nrow(matData(object))) msg <- c(msg, "number of rowData rows and matData rows differ") if (nrow(colData(object)) != ncol(matData(object))) msg <- c(msg, "number of colData rows and matData columns differ") if (is.null(msg)) TRUE else msg }) ## ----validity-action----------------------------------------------------- .AnnMat(matData=matrix(1:10, 2), rowData=data.frame(roi_id=1:2), colData=data.frame(sample_id=1:5)) cat(try({ .AnnMat(matData=matrix(1:10, 2), rowData=data.frame(roi_id=1:5), colData=data.frame(sample_id=1:2)) })) ## ----subsetting---------------------------------------------------------- getGeneric("[") ## ----subset-facade------------------------------------------------------- setMethod("[", c("AnnMat", "ANY", "ANY"), function(x, i, j, ..., drop=TRUE) { ## FIXME: warn user about ignoring 'drop'? initialize(x, matData=matData(x)[i, j, drop=FALSE], rowData=rowData(x)[i,,drop=FALSE], colData=colData(x)[,j,drop=FALSE], ...) }) setMethod("[", c("AnnMat", "ANY", "missing"), function(x, i, j, ..., drop=TRUE) { initialize(x, matData=matData(x)[i,,drop=FALSE], rowData=rowData(x)[i,,drop=FALSE]) }) setMethod("[", c("AnnMat", "missing", "ANY"), function(x, i, j, ..., drop=TRUE) { initialize(x, matData=matData(x)[,j,drop=FALSE], colData=colData(x)[j,,drop=FALSE]) }) setMethod("[", c("AnnMat", "missing", "missing"), function(x, i, j, ..., drop=TRUE) { initialize(x, ...) })