setGeneric("nsamples", function(x) standardGeneric("nsamples"))
setGeneric("nfeatures", function(x) standardGeneric("nfeatures"))
setGeneric("sampleNames", function(x) standardGeneric("sampleNames"))
setGeneric("sampleNames<-", function(x, value) standardGeneric("sampleNames<-"))
setGeneric("featureNames", function(x) standardGeneric("featureNames"))
setGeneric("featureNames<-", function(x, value) standardGeneric("featureNames<-"))
#' @rdname dimensions
#' @aliases dim
#' @title Get dimemsions
#' @description Get number of samples, features, or both dimensions of an HTSet
#' object
#' @seealso \code{\link{HTSet-class}}
#' @param x \code{\link{HTSet-class}}
#' @return A integer vector with length of 2. The first is the number of
#' features, and the second is number of samples.
#' @export
setMethod(
"dim", signature = "HTSet",
function(x){
return(dim(x@edata))
}
)
#' @rdname dimensions
#' @aliases nsamples
#' @return integer, number of samples
#' @export
setMethod(
"nsamples", signature = "HTSet",
function(x){
return(ncol(x@edata))
}
)
#' @rdname dimensions
#' @aliases nfeatures
#' @return integer, number of features
#' @export
setMethod(
"nfeatures", signature = "HTSet",
function(x){
return(nrow(x@edata))
}
)
#' @rdname sampleNames-HTSet-method
#' @aliases sampleNames
#' @title Get or set the sample names of an HTSet object
#' @description Get or set the sample names of an \code{\link{HTSet}} object.
#'
#' @param x \code{\link{HTSet-class}}
#'
#' @return A character vector.
#' @export
setMethod(
"sampleNames", signature = "HTSet",
function(x){
return(colnames(x@edata))
}
)
#' @rdname sampleNames-HTSet-method
#' @aliases sampleNames<-
#' @param value A character vector. The length must match number of samples.
#' @export
setReplaceMethod(
"sampleNames", signature = "HTSet",
function(x, value){
colnames(x@edata) = value
if(!is.null(x@pdata))
rownames(x@pdata) = value
validObject(x)
return(x)
}
)
#' @rdname featureNames-HTSet-method
#' @aliases featureNames
#' @title Get or set the feature names of an HTSet object
#' @description Get or set the feature names of an \code{\link{HTSet-class}}
#' object.
#'
#' @param x \code{\link{HTSet-class}}
#'
#' @return A character vector.
#' @export
setMethod(
"featureNames", signature = "HTSet",
function(x){
return(rownames(x@edata))
}
)
#' @rdname featureNames-HTSet-method
#' @aliases featureNames<-
#' @param value A character vector. The length must match number of features.
#' @export
setReplaceMethod(
"featureNames", signature = "HTSet",
function(x, value){
rownames(x@edata) = value
if(!is.null(x@fdata))
rownames(x@fdata) = value
validObject(x)
return(x)
}
)
#' @title Subset samples
#' @description Get a subset of samples of an HTSet object.
#' @param object \code{\link{HTSet-class}}
#' @param samples The samples to subset. Can be character, logical, or integers.
#' @return \code{\link{HTSet-class}}
#' @export
subset_samples = function(object, samples){
stopifnot(is(object, "HTSet"))
msg = "The \"samples\" provided not valid. Please verify."
if(is.character(samples)){
if(any(! samples %in% sampleNames(object)))
stop(msg)
}
if(is.numeric(samples)){
if(max(samples) > nsamples(object))
stop(msg)
}
if(is.logical(samples)){
if(length(samples) != nsamples(object))
stop(msg)
}
edata = object@edata[, samples]
pdata = object@pdata[samples, ]
new_obj = HTSet(edata, object@fdata, pdata, object@assay)
return(new_obj)
}
#' @title Subset features
#' @description Get a subset of features of an HTSet object.
#' @param object \code{\link{HTSet-class}}
#' @param features The features to subset. Can be character, logical, or integers.
#' @return \code{\link{HTSet-class}}
#' @export
subset_features = function(object, features){
stopifnot(is(object, "HTSet"))
msg = "The \"features\" provided not valid. Please verify."
if(is.character(features)){
if(any(! features %in% featureNames(object)))
stop(msg)
}
if(is.numeric(features)){
if(max(features) > nfeatures(object))
stop(msg)
}
if(is.logical(features)){
if(length(features) != nfeatures(object))
stop(msg)
}
edata = object@edata[features, ]
fdata = object@fdata[features, ]
new_obj = HTSet(edata, fdata, object@pdata, object@assay)
return(new_obj)
}
#' @title Summarize by feature variable
#' @description This function summarize the edata according to the given feature
#' variable.
#' @param object \code{\link{HTSet-class}}
#' @param feature_var character. Must come from the column names of the
#' fdata. Length equals to 1.
#' @return \code{\link{HTSet-class}}
#' @export
#' @author Chenghao Zhu
#' @importFrom magrittr %>%
#' @import dplyr
#' @import reshape2
summarize_feature = function(object, feature_var){
stopifnot(is(object, "HTSet"))
if(length(feature_var) != 1)
stop("Invalid feature_var")
if(!is.character(feature_var))
stop("Invalid feature_var")
if(!feature_var %in% colnames(object@fdata))
stop(paste0("The feature_var '", feature_var, "' does not exist"))
edata = object@edata %>%
as.data.frame %>%
mutate(feature_var = object@fdata[,feature_var]) %>%
melt(id.var = "feature_var",
variable.name = "sample_id",
value.name = "expr") %>%
group_by(feature_var, sample_id) %>%
summarize(expr = sum(expr, na.rm = TRUE)) %>%
dcast(feature_var~sample_id, value.var = "expr")
rownames(edata) = edata$feature_var
edata = select(edata, -feature_var) %>%
as.matrix
object@edata = edata
object@fdata = NULL
validObject(object)
return(object)
}
#' @title Transform by sample
#' @description Transform the edata in a sample-wise manner (MARGIN = 2).
#' @param object \code{\link{HTSet-class}}
#' @param FUN function to apply.
#' @param ... additional arguments to pass to the function
#' @return \code{\link{HTSet-class}}
#' @export
transform_by_sample = function(object, FUN, ...){
if(length(FUN(1:nfeatures(object))) != nfeatures(object))
stop("Function invalid")
edata = apply(object@edata, 2, FUN, ...)
rownames(edata) = featureNames(object)
colnames(edata) = sampleNames(object)
object@edata = edata
validObject(object)
return(object)
}
#' @title Transform by feature
#' @description Transform the edata in a feature-wise manner (MARGIN = 2).
#' @param object \code{\link{HTSet-class}}
#' @param FUN function to apply.
#' @param ... additional arguments to pass to the function
#' @return \code{\link{HTSet-class}}
#' @export
transform_by_feature = function(object, FUN, ...){
if(length(FUN(1:nsamples(object))) != nsamples(object))
stop("Function invalid")
edata = t(apply(object@edata, 1, FUN, ...))
rownames(edata) = featureNames(object)
colnames(edata) = sampleNames(object)
object@edata = edata
validObject(object)
return(object)
}
# setAs(
# "HTSet", "ExpressionSet",
# function(from){
# stopifnot(requireNamespace("Biobase"))
#
# edata = from@edata
# pdata = from@pdata
# fdata = from@fdata
#
# Biobase::ExpressionSet(
# assayData = edata,
# phenoData = Biobase::AnnotatedDataFrame(pdata),
# featureData = Biobase::AnnotatedDataFrame(fdata)
# )
# }
# )
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.