Nothing
###########################################################################/**
# @RdocClass AromaMicroarrayDataSetTuple
#
# @title "The AromaMicroarrayDataSetTuple class"
#
# \description{
# @classhierarchy
# }
#
# @synopsis
#
# \arguments{
# \item{...}{Arguments passed to @see "R.filesets::GenericDataFileSetList".}
# \item{.setClass}{The name of the class of the input set.}
# }
#
# \section{Fields and Methods}{
# @allmethods "public"
# }
#
# @author
#
#*/###########################################################################
setConstructorS3("AromaMicroarrayDataSetTuple", function(..., .setClass="AromaMicroarrayDataSet") {
extend(GenericDataFileSetList(..., .setClass=.setClass), "AromaMicroarrayDataSetTuple")
})
setMethodS3("as.AromaMicroarrayDataSetTuple", "AromaMicroarrayDataSetTuple", function(this, ...) {
# Nothing to do
this
})
setMethodS3("as.character", "AromaMicroarrayDataSetTuple", function(x, ...) {
# To please R CMD check
this <- x
s <- sprintf("%s:", class(this)[1])
s <- c(s, paste("Name:", getName(this)))
s <- c(s, paste("Tags:", paste(getTags(this), collapse=",")))
s <- c(s, paste("Chip types:", paste(getChipTypes(this), collapse=", ")))
dsList <- getSets(this)
for (ds in dsList) {
s <- c(s, as.character(ds))
}
GenericSummary(s)
}, private=TRUE)
setMethodS3("indexOf", "AromaMicroarrayDataSetTuple", function(this, arrays=NULL, ...) {
# Argument 'arrays':
if (is.numeric(arrays)) {
n <- length(this)
arrays <- Arguments$getIndices(arrays, max=n)
} else {
arrays <- NextMethod("indexOf", arrays, onMissing="error")
}
arrays
}, protected=TRUE)
setMethodS3("getAsteriskTags", "AromaMicroarrayDataSetTuple", function(this, ...) {
""
}, protected=TRUE)
setMethodS3("getTags", "AromaMicroarrayDataSetTuple", function(this, collapse=NULL, ...) {
# Get tags of chip-effect set
dsList <- getSets(this)
# Get data set tags
tags <- lapply(dsList, FUN=getTags)
# Keep common tags
tags <- getCommonListElements(tags)
tags <- tags[[1]]
tags <- unlist(tags, use.names=FALSE)
# Add optional tuple tags
tags <- c(tags, this$.tags)
# In case this$.tags is not already split
tags <- strsplit(tags, split=",", fixed=TRUE)
tags <- unlist(tags)
# Update asterisk tags
tags[tags == "*"] <- getAsteriskTags(this, collapse=",")
# Remove empty tags
tags <- Arguments$getTags(tags, collapse=NULL)
# Remove duplicated tags
tags <- locallyUnique(tags)
# Collapsed or split?
tags <- Arguments$getTags(tags, collapse=collapse)
tags
})
###########################################################################/**
# @RdocMethod nbrOfChipTypes
#
# @title "Gets the number of chip types"
#
# \description{
# @get "title" used in the model.
# }
#
# @synopsis
#
# \arguments{
# \item{...}{Not used.}
# }
#
# \value{
# Returns an @integer.
# }
#
# @author
#
# \seealso{
# @seemethod "getChipTypes".
# @seeclass
# }
#*/###########################################################################
setMethodS3("nbrOfChipTypes", "AromaMicroarrayDataSetTuple", function(this, ...) {
length(getChipTypes(this, ...))
})
setMethodS3("getFullNames", "AromaMicroarrayDataSetTuple", function(this, arrays=NULL, exclude=NULL, translate=TRUE, ...) {
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Local functions
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
getFullNameOfList <- function(cfList, ...) {
# Get sample name
names <- sapply(cfList, FUN=getName)
names <- names[!is.na(names)]
# Sanity check
.stop_if_not(length(names) > 0)
name <- names[1]
# Get chip-effect tags *common* across chip types
tags <- lapply(cfList, FUN=getTags, ...)
tags <- lapply(tags, FUN=function(x) {
# To avoid warning on na.omit(NULL)
if (length(x) > 0) na.omit(x) else x
})
tags <- lapply(tags, FUN=setdiff, exclude)
tags <- getCommonListElements(tags)
tags <- tags[[1]]
tags <- unlist(tags, use.names=FALSE)
tags <- locallyUnique(tags)
fullname <- paste(c(name, tags), collapse=",")
fullname
} # getFullNameOfList()
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Validate arguments
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Argument 'arrays':
arrays <- indexOf(this, arrays)
# Argument 'exclude':
exclude <- Arguments$getCharacters(exclude)
fullnames <- c()
for (ii in arrays) {
cfList <- getFileList(this, ii, ...)
# Call local function
fullname <- getFullNameOfList(cfList, translate=translate)
fullnames <- c(fullnames, fullname)
}
fullnames
})
setMethodS3("getChipTypes", "AromaMicroarrayDataSetTuple", function(this, fullname=FALSE, merge=FALSE, collapse="+", ...) {
dsList <- getSets(this)
chipTypes <- sapply(dsList, FUN=getChipType, fullname=fullname)
# Invariant for order
# chipTypes <- sort(chipTypes)
# Merge to a single string?
if (merge) {
chipTypes <- mergeByCommonTails(chipTypes, collapse=collapse)
}
chipTypes
})
setMethodS3("getSets", "AromaMicroarrayDataSetTuple", function(this, ...) {
res <- NextMethod("getSets")
# Name sets by their chip types
chipTypes <- sapply(res, FUN=getChipType)
chipTypes <- gsub(",monocell", "", chipTypes)
names(res) <- chipTypes
res
})
setMethodS3("byPath", "AromaMicroarrayDataSetTuple", abstract=TRUE, static=TRUE, protected=TRUE)
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.