Nothing
###########################################################
### Define generic functions
#' Combine \code{exprso} Objects
#'
#' \code{conjoin} combines two or more \code{exprso} objects based on their class.
#'
#' When applied to two or more \code{ExprsArray} objects, this function returns one
#' \code{ExprsArray} object as output. This only works on \code{ExprsArray} objects
#' that have not undergone feature selection. Any missing annotations in \code{@annot}
#' will get replaced with \code{NA} values. Note that all combined \code{ExprsArray}
#' objects must initially have had the same features in the same order.
#'
#' When applied to two or more \code{ExprsModel} objects, this function returns one
#' \code{ExprsEnsemble} object as output. In this way, this function works similar to
#' the \code{\link{buildEnsemble}} method for \code{ExprsModel} objects.
#'
#' When applied to two or more \code{ExprsPipeline} objects, this function returns one
#' \code{ExprsPipeline} object as output. To keep track of which \code{ExprsPipeline}
#' objects contributed initially to the resultant object, the source gets flagged in
#' the \code{summary} slot. For each \code{ExprsPipeline} object, if the \code{summary}
#' lacks a \code{boot} column, all \code{summary} entries will receive one unique ID.
#' However, if the \code{summary} contains a \code{boot} column (e.g., as generated by
#' \code{\link{plMonteCarlo}}), all models belonging to each bootstrap will receive
#' one unique ID. Afterwards, the old \code{boot} columns will get renamed to \code{unboot}
#' while the newly assigned unique IDs become the new \code{boot} column. This
#' complicated indexing system treats all models derived from one unique cut to a
#' training set as if they had belonged to the same "pseudo-bootstrap". These "pseudo-bootstraps"
#' will get handled like true bootstraps downstream by functions built around
#' \code{\link{pipeFilter}} and \code{\link{buildEnsemble}}.
#'
#' When applied to two or more \code{ExprsEnsemble} objects, this function returns one
#' \code{ExprsEnsemble} object as output. The resultant object contains all models
#' found within each of the supplied \code{ExprsEnsemble} objects.
#'
#' @param object An \code{ExprsArray}, \code{ExprsModel}, \code{ExprsPipeline}, or
#' \code{ExprsEnsemble} object.
#' @param ... Two or more objects of the same class.
#' @return An \code{ExprsArray}, \code{ExprsModel}, \code{ExprsPipeline}, or
#' \code{ExprsEnsemble} object.
#' @export
setGeneric("conjoin",
function(object, ...) standardGeneric("conjoin")
)
###########################################################
### Conjoin
#' @describeIn conjoin Method to join \code{ExprsArray} objects.
#' @export
setMethod("conjoin", "ExprsArray",
function(object, ...){
# Prepare list of ExprsArray objects
args <- list(...)
index <- unlist(lapply(args, function(arg) inherits(arg, "ExprsArray")))
args <- append(list(object), args[index])
if(!length(args) > 1 | any(!sapply(args, function(e) identical(class(e), class(object))))){
stop("User must provide additional ExprsArray objects of the same class!")
}
if(any(!sapply(args, function(e) is.null(e@preFilter) | is.null(e@reductionModel)))){
stop("This function is not equipped to handle objects that have undergone feature selection!")
}
# Prepare single matrix for @exprs and @annot each
exprs <- as.matrix(do.call(cbind, lapply(args, function(a) a@exprs)))
annot <- do.call(plyr::rbind.fill, lapply(args, function(a) a@annot))
rownames(annot) <- unlist(lapply(args, function(a) rownames(a@annot)))
# Return single ExprsArray object
new(class(object), exprs = exprs, annot = annot, preFilter = NULL, reductionModel = NULL)
}
)
#' @describeIn conjoin Method to join \code{ExprsModel} objects.
#' @export
setMethod("conjoin", "ExprsModel",
function(object, ...){
# Prepare list of ExprsModel objects
args <- list(...)
index <- unlist(lapply(args, function(arg) inherits(arg, "ExprsModel")))
machs <- append(object, args[index])
# Return single ExprsEnsemble object
new("ExprsEnsemble", machs = machs)
}
)
#' @describeIn conjoin Method to join \code{ExprsPipeline} objects.
#' @export
setMethod("conjoin", "ExprsPipeline",
function(object, ...){
# Prepare list of ExprsPipeline objects
args <- list(...)
index <- unlist(lapply(args, function(arg) class(arg) == "ExprsPipeline"))
args.summary <- append(list(object@summary), lapply(args[index], function(pl) pl@summary))
args.machs <- append(list(object@machs), lapply(args[index], function(pl) pl@machs))
# Initialize the conjoin boot counter
b <- 1
# Apply conjoin boot counter to each ExprsPipeline object
pls <- lapply(args.summary,
function(pl){
# Initialize the conjoin boot container
pl <- cbind("join" = 0, pl)
if(!"boot" %in% colnames(pl)){
# Add conjoin boot counter
pl$join <- b
b <<- b + 1
}else{
# For each boot in $boot
for(i in 1:length(unique(pl$boot))){
# Change each unique boot to conjoin boot counter
pl$join[pl$boot == i] <- b
b <<- b + 1
}
# Rename $boot to $unboot
colnames(pl)[colnames(pl) == "boot"] <- "unboot"
}
# Rename $join to $boot
colnames(pl)[colnames(pl) == "join"] <- "boot"
return(pl)
}
)
# Return single ExprsPipeline object
new("ExprsPipeline", summary = do.call(plyr::rbind.fill, pls), machs = unlist(args.machs))
}
)
#' @describeIn conjoin Method to join \code{ExprsEnsemble} objects.
#' @export
setMethod("conjoin", "ExprsEnsemble",
function(object, ...){
# Prepare list of ExprsEnsemble objects
args <- list(...)
index <- unlist(lapply(args, function(arg) class(arg) == "ExprsEnsemble"))
machs <- unlist(append(list(object@machs), lapply(args[index], function(pl) pl@machs)))
# Return single ExprsEnsemble object
new("ExprsEnsemble", machs = machs)
}
)
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.