R/support_methods.R
In xdomingoal/erah-devel: Automated Spectral Deconvolution, Alignment, and Metabolite Identification in GC/MS-Based Untargeted Metabolomics
#' @rdname idList
#' @title Identification list
#' @description The list of identified metabolites in a given experiment
#' @usage idList(object, id.database = mslib)
#' @param object A 'MetaboSet' S4 object containing the experiment data. The experiment has to be previously deconvolved, aligned and identified.
#' @param id.database The mass-spectra library to be compared with the empirical spectra. By default, the MassBank - Mass Bank of North America (MoNa) database are employed (mslib object).
#' @details Returns an identification table containing the names, match scores, and other variables for a given experiment.
#' @return
#' \code{idList} returns an S3 object:
#' \item{AlignID}{The unique Tag for found metabolite by eRah. Each metabolite found by eRah for a given experiment has an unique AlignID tag number.}
#' \item{tmean}{The mean compound retention time.}
#' \item{Name.X}{the name of the Xst/nd/rd... hit. idList return as many X (hits) as n.putative selected with \code{\link{identifyComp}}.}
#' \item{FoundIn}{The number of samples in which the compound has been detected (the number of samples where the compound area is non-zero).}
#' \item{MatchFactor.X}{The match factor/score of spectral similarity (spectral correlation).}
#' \item{DB.Id.X}{The identification number of the library. Each metbolite in the reference library has a different DB.Id number.}
#' \item{CAS.X}{the CAS number of each identified metabolite.}
#' @seealso \code{\link{alignList}} \code{\link{dataList}}
#' @importFrom tibble as_tibble
#' @export
setGeneric('idList',function(object, id.database=mslib){
standardGeneric('idList')
})
#' @rdname idList
setMethod('idList',signature = 'MetaboSet',
function(object, id.database=mslib) {
#if(!(any(unlist(lapply(object@Data@FactorList,function(x) {is.null(x$AlignID)} ))==FALSE))) stop("Factors must be aligned and identified first")
if(nrow(object@Results@Identification)==0) stop("Factors must be identified first")
if(object@Results@Parameters@Identification$database.name!=id.database@name)
{
error.msg <- paste("This experiment was not processed with the database selected. Please use ", object@Results@Parameters@Identification$database.name, sep="")
stop(error.msg)
}
n.putative <- object@Results@Parameters@Identification$n.putative
id.general <- object@Results@Identification[,c("AlignID","tmean","FoundIn")]
id.list.up <- NULL
for(current.putative in 1:n.putative)
{
current.column <- paste("DB.Id.",current.putative, sep="")
current.column.match <- paste("MatchFactor.",current.putative, sep="")
current.column.cas <- paste("CAS.",current.putative, sep="")
current.column.form <- paste("Formula.",current.putative, sep="")
current.column.name <- paste("Name.",current.putative, sep="")
id.found <- as.numeric(as.vector(object@Results@Identification[,current.column]))
met.name <- unlist(lapply(id.database@database[c(id.found)], function(x) x$Name))
met.cas <- unlist(lapply(id.database@database[c(id.found)], function(x) x$CAS))
met.form <- unlist(lapply(id.database@database[c(id.found)], function(x) x$Formula))
id.list <- object@Results@Identification[,c(current.column.match,current.column)]
del.na <- which(is.na(id.list[,1]))
if(length(del.na)!=0) id.list <- id.list[-del.na,]
id.list <- cbind(id.list,met.name,met.cas,met.form)
colnames(id.list)[ncol(id.list):(ncol(id.list)-2)] <- c(current.column.form,current.column.cas,current.column.name)
cas.no.na <- apply(id.list,1,function(x) {if(as.vector(x[current.column.cas])=="NA"){
x[current.column.cas]=""
} else{
x[current.column.cas]
}
})
id.list[,current.column.cas] <- cas.no.na
id.list <- id.list[,c(current.column.name,current.column.match,current.column,current.column.cas,current.column.form)]
id.list.up <- cbind(id.list.up,as.matrix(id.list))
}
if(length(del.na)!=0) id.general <- id.general[-del.na,]
id.list <- cbind(id.general,id.list.up)
if(!is.null(object@Results@Parameters@Alignment$min.samples)){
id.list <- id.list[which(id.list$FoundIn>=object@Results@Parameters@Alignment$min.samples),]
}
if(!is.null(object@Results@Identification$RI.error.1))
{
#RI.errTab <- cbind(object@Results@Identification$AlignID, object@Results@Identification$RI.error.1)
selColsbyName <- c('AlignID', sapply(1:n.putative, function(x) paste('RI.error.', x, sep='')))
selColsbyName <- selColsbyName[selColsbyName %in% colnames(object@Results@Identification)]
RI.errTab <- object@Results@Identification[,selColsbyName]
#colnames(RI.errTab) <- c("AlignID", "RI.err")
id.list <- merge(id.list[,1:ncol(id.list)], RI.errTab, by = "AlignID")
#id.list <- id.list[c(1:5,ncol(id.list),6:(ncol(id.list)-1))]
}
return(as_tibble(id.list[order(as.numeric(as.vector(id.list[,"tmean"]))),], row.names=1:nrow(id.list)))
}
)
# factorList <- function(object, sample)
# {
# if(is.null(object@Data@FactorList[[sample]]$AlignID))
# {
# return(as.data.frame(object@Data@FactorList[[sample]][,c("ID","RT","Peak Height","Area")]))
# }else{
# return(as.data.frame(object@Data@FactorList[[sample]][,c("ID","AlignID","RT","Peak Height","Area")]))
# }
# }
#' @rdname alignList
#' @title Alignment list
#' @description The list of aligned metabolites and their relative quantification for each sample in a given experiment
#' @usage alignList(object, by.area = TRUE)
#' @param object A 'MetaboSet' S4 object containing the experiment data. The experiment has to be previously deconvolved, aligned and (optionally) identified.
#' @param by.area if TRUE (default), eRah outputs quantification by the area of the deconvolved chromatographic peak of each compound. If FALSE, eRah outputs the intensity of the deconvolved chromatographic peak.
#' @details Returns an alignment table containing the list of aligned metabolites and their relative quantification for each sample in a given experiment.
#' @return
#' \code{alignList} returns a data frame object:
#' \item{AlignID}{The unique Tag for found metabolite by eRah. Each metabolite found by eRah for a given experiment has an unique AlignID tag number.}
#' \item{Factor}{the Factor tag name. Each metabolite has an unique 'Factor' name to enhance visual interpretation.}
#' \item{tmean}{The mean compound retention time.}
#' \item{FoundIn}{The number of samples in which the compound has been detected (the number of samples where the compound area is non-zero).}
#' \item{Quantification}{As many columns as samples and as many rows as metabolites, where each column name has the name of each sample.}
#' @seealso \code{\link{idList}} \code{\link{dataList}}
#' @export
setGeneric('alignList',function(object, by.area=TRUE){
standardGeneric('alignList')
})
#' @rdname alignList
setMethod('alignList',signature = 'MetaboSet',
function(object, by.area=TRUE) {
if(!(any(unlist(lapply(object@Data@FactorList,function(x) {is.null(x$AlignID)} ))==FALSE))) stop("Factors must be aligned first")
height <- FALSE
if(by.area==FALSE) height <- TRUE
if(height==TRUE)
{
del.in <- which(colnames(object@Results@Alignment)=="Spectra")
alList <- object@Results@Alignment[,-del.in]
if(!is.null(object@Results@Parameters@Alignment$min.samples)){
alList <- alList[which(alList$FoundIn>=object@Results@Parameters@Alignment$min.samples),]
}
return(alList)
}else{
# align.inds <- as.numeric(as.vector(object@Results@Alignment[,"AlignID"]))
# align.area <- lapply(object@Data@FactorList,function(x) {
# #search.for <- which(x$"AlignID" %in% align.inds)
# search.for <- unlist(sapply(align.inds, function(i) which(as.numeric(as.vector(x$"AlignID"))==i)))
# as.numeric(as.vector(x$"Area"[search.for]))
# })
# if(!is.matrix(align.area))
# {
# del.list <- as.vector(which(unlist(lapply(align.area,length))==0))
# if(length(del.list)!=0) align.area <- align.area[-del.list]
# align.area <- unlist(align.area)
# dim(align.area) <- c(length(align.inds), length(align.area)/length(align.inds))
# }
# del.in <- which(colnames(object@Results@Alignment)=="Spectra")
# area.list <- cbind(object@Results@Alignment[,c("AlignID","Factor","tmean","FoundIn")],align.area)
# colnames(area.list) <- colnames(object@Results@Alignment[,-del.in])
# return(area.list)
empty.samples <- which(lapply(object@Data@FactorList,nrow)==0)
if(length(empty.samples)!=0) object@Data@FactorList <- object@Data@FactorList[-empty.samples]
factors.list <- object@Data@FactorList
align.inds <- as.numeric(as.vector(object@Results@Alignment[,"AlignID"]))
align.area <- lapply(factors.list,function(x) {
#search.for <- which(x$"AlignID" %in% align.inds)
search.for <- (sapply(align.inds, function(i) which(as.numeric(as.vector(x$"AlignID"))==i)))
if(inherits(search.for,"list"))
{
fill.inds <- unlist(lapply(search.for, length))
fill.vector <- rep(0,length(align.inds))
fill.vector[fill.inds==1] <- as.numeric(as.vector(x$"Area"[unlist(search.for)]))
}else{
fill.vector <- as.numeric(as.vector(x$"Area"[search.for]))
}
fill.vector
})
if(!is.matrix(align.area))
{
del.list <- as.vector(which(unlist(lapply(align.area,length))==0))
if(length(del.list)!=0) align.area <- align.area[-del.list]
align.area <- unlist(align.area)
dim(align.area) <- c(length(align.inds), length(align.area)/length(align.inds))
}
del.in <- which(colnames(object@Results@Alignment)=="Spectra")
area.list <- cbind(object@Results@Alignment[,c("AlignID","Factor","tmean","FoundIn")],align.area)
colnames(area.list) <- colnames(object@Results@Alignment[,-del.in])
if(!is.null(object@Results@Parameters@Alignment$min.samples)){
area.list <- area.list[which(area.list$FoundIn>=object@Results@Parameters@Alignment$min.samples),]
}
return(as_tibble(area.list))
}
}
)
#' @rdname dataList
#' @title Data list
#' @description The final eRah list of aligned and identified metabolites and their relative quantification for each sample in a given experiment
#' @usage dataList(Experiment, id.database = mslib, by.area = TRUE)
#' @param Experiment A 'MetaboSet' S4 object containing the experiment data. The experiment has to be previously deconvolved, aligned and identified.
#' @param id.database The mass-spectra library to be compared with the empirical spectra. By default, the MassBank - Mass Bank of North America (MoNa) database are employed (mslib object).
#' @param by.area if TRUE (default), eRah outputs quantification by the area of the deconvolved chromatographic peak of each compound. If FALSE, eRah outputs the intensity of the deconvolved chromatographic peak.
#' @details Returns an identification and alignment table containing the list of aligned and identifed metabolites (names) and their relative quantification for each sample in a given experiment.
#' @return
#' \code{alignList} returns an S3 object:
#' \item{AlignID}{The unique Tag for found metabolite by eRah. Each metabolite found by eRah for a given experiment has an unique AlignID tag number.}
#' \item{tmean}{The mean compound retention time.}
#' \item{FoundIn}{The number of samples in which the compound has been detected (the number of samples where the compound area is non-zero).}
#' \item{Name.X}{the name of the Xst/nd/rd... hit. idList return as many X (hits) as n.putative selected with \code{\link{identifyComp}}.}
#' \item{MatchFactor.X}{The match factor/score of spectral similarity (spectral correlation).}
#' \item{DB.Id.X}{The identification number of the library. Each metbolite in the reference library has a different DB.Id number.}
#' \item{CAS.X}{the CAS number of each identified metabolite.}
#' \item{Quantification}{As many columns as samples and as many rows as metabolites, where each column name has the name of each sample.}
#' @seealso \code{\link{idList}} \code{\link{alignList}}
#' @export
setGeneric('dataList',function(Experiment, id.database=mslib, by.area=TRUE){
standardGeneric('dataList')
})
#' @rdname dataList
setMethod('dataList',signature = 'MetaboSet',
function(Experiment, id.database=mslib, by.area=TRUE){
ID.table <- idList(Experiment, id.database)
Al.table <- alignList(Experiment, by.area)
Al.table <- Al.table[, !(names(Al.table) %in% c("FoundIn","tmean","Factor"))]
data.table <- merge(ID.table, Al.table, by="AlignID")
as_tibble(data.table)
}
)
#' expClasses-method
#' @rdname expClasses
#' @description The classes of a given experiment.
#' @param object A 'MetaboSet' S4 object containing the experiment.
#' @details Returns the classes details of the experiment.
#' @seealso metaData phenoData
#' @export
setGeneric('expClasses',function(object){
standardGeneric('expClasses')
})
#' @rdname expClasses
setMethod('expClasses',signature = 'MetaboSet',
function(object){
if(nrow(object@MetaData@Phenotype)==0) stop("No Phenotype data has been attached to this experiment.")
pn <- object@MetaData@Phenotype
samples.name <- names(object@Data@FactorList)
indx <- apply(as.matrix(samples.name),1,function(x) which(pn[,"sampleID"]==x))
class.names <- unlist(pn[indx,"class"],use.names = F)
samples.class.type <- levels(as.factor(class.names))
empty.samples <- which(lapply(object@Data@FactorList,nrow)==0)
classes.list <- matrix(c(samples.name, class.names, rep("Processed", length(samples.name))), ncol=3)
classes.list[empty.samples,3] <- "Not processed"
colnames(classes.list) <- c("Sample ID", "Class Type", "Processing Status")
classes.summary <- as.data.frame(classes.list, row.names=1:nrow(classes.list))
classes.string <- paste(samples.class.type, collapse=", ")
cat("Experiment containing ", nrow(classes.summary), " samples in ", length(samples.class.type), " different type of classes named: ",classes.string, ". \n \n", sep="")
print(classes.summary)
#return(new("expClasses", classes.type=samples.class.type, classes.summary=classes.summary))
}
)
#' @rdname sampleInfo
#' @title Information of the samples
#' @description Returns basic information on the samples.
#' @usage sampleInfo(Experiment, N.sample = 1)
#' @param Experiment A 'MetaboSet' S4 object containing the experiment.
#' @param N.sample Integer. The number of the sample to query.
#' @details Returns details on a given sample of the experiment, such as name, start time, end time, minium and maximum adquired m/z and scans per second.
#' @seealso \code{\link{plotChr}}
#' @export
setGeneric('sampleInfo',function(Experiment, N.sample=1){
standardGeneric('sampleInfo')
})
#' @rdname sampleInfo
setMethod('sampleInfo',signature = 'MetaboSet',
function(Experiment, N.sample=1){
sampleRD <- load.file(paste(Experiment@MetaData@DataDirectory, Experiment@MetaData@Instrumental$filename[[N.sample]], sep="/"))
max.rt <- (nrow(sampleRD@data)/(sampleRD@scans.per.second*60)) + sampleRD@start.time/60
min.rt <- sampleRD@start.time/60
cat(" Name: \t", as.vector(Experiment@MetaData@Instrumental$filename[[N.sample]]), "\n", "Start Time: \t", min.rt, "\n", "End Time: \t", max.rt, "\n", "Min MZ: \t", sampleRD@min.mz, "\n", "Max MZ: \t", sampleRD@max.mz, "\n", "Scans/sec: \t", sampleRD@scans.per.second)
}
)
#' metaData-method
#' @rdname metaData
#' @description Displays the Experiment metadata
#' @param object A 'MetaboSet' S4 object containing the experiment.
#' @seealso \code{\link{phenoData}}
#' @export
setGeneric('metaData',function(object){
standardGeneric('metaData')
})
#' @rdname metaData
setMethod('metaData',signature = 'MetaboSet',
function(object){
object@MetaData@Instrumental
}
)
#' phenoData-method
#' @rdname phenoData
#' @description Displays the Experiment phenotypic data (if included).
#' @param object A 'MetaboSet' S4 object ciontaining the experiment.
#' @seealso \code{\link{metaData}}
#' @export
setGeneric('phenoData',function(object){
standardGeneric('phenoData')
})
#' @rdname phenoData
setMethod('phenoData',signature = 'MetaboSet',
function(object) {
object@MetaData@Phenotype
}
)
xdomingoal/erah-devel documentation built on Feb. 11, 2024, 11:11 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
#' @rdname idList
#' @title Identification list
#' @description The list of identified metabolites in a given experiment
#' @usage idList(object, id.database = mslib)
#' @param object A 'MetaboSet' S4 object containing the experiment data. The experiment has to be previously deconvolved, aligned and identified.
#' @param id.database The mass-spectra library to be compared with the empirical spectra. By default, the MassBank - Mass Bank of North America (MoNa) database are employed (mslib object).
#' @details Returns an identification table containing the names, match scores, and other variables for a given experiment.
#' @return
#' \code{idList} returns an S3 object:
#' \item{AlignID}{The unique Tag for found metabolite by eRah. Each metabolite found by eRah for a given experiment has an unique AlignID tag number.}
#' \item{tmean}{The mean compound retention time.}
#' \item{Name.X}{the name of the Xst/nd/rd... hit. idList return as many X (hits) as n.putative selected with \code{\link{identifyComp}}.}
#' \item{FoundIn}{The number of samples in which the compound has been detected (the number of samples where the compound area is non-zero).}
#' \item{MatchFactor.X}{The match factor/score of spectral similarity (spectral correlation).}
#' \item{DB.Id.X}{The identification number of the library. Each metbolite in the reference library has a different DB.Id number.}
#' \item{CAS.X}{the CAS number of each identified metabolite.}
#' @seealso \code{\link{alignList}} \code{\link{dataList}}
#' @importFrom tibble as_tibble
#' @export
setGeneric('idList',function(object, id.database=mslib){
standardGeneric('idList')
})
#' @rdname idList
setMethod('idList',signature = 'MetaboSet',
function(object, id.database=mslib) {
#if(!(any(unlist(lapply(object@Data@FactorList,function(x) {is.null(x$AlignID)} ))==FALSE))) stop("Factors must be aligned and identified first")
if(nrow(object@Results@Identification)==0) stop("Factors must be identified first")
if(object@Results@Parameters@Identification$database.name!=id.database@name)
{
error.msg <- paste("This experiment was not processed with the database selected. Please use ", object@Results@Parameters@Identification$database.name, sep="")
stop(error.msg)
}
n.putative <- object@Results@Parameters@Identification$n.putative
id.general <- object@Results@Identification[,c("AlignID","tmean","FoundIn")]
id.list.up <- NULL
for(current.putative in 1:n.putative)
{
current.column <- paste("DB.Id.",current.putative, sep="")
current.column.match <- paste("MatchFactor.",current.putative, sep="")
current.column.cas <- paste("CAS.",current.putative, sep="")
current.column.form <- paste("Formula.",current.putative, sep="")
current.column.name <- paste("Name.",current.putative, sep="")
id.found <- as.numeric(as.vector(object@Results@Identification[,current.column]))
met.name <- unlist(lapply(id.database@database[c(id.found)], function(x) x$Name))
met.cas <- unlist(lapply(id.database@database[c(id.found)], function(x) x$CAS))
met.form <- unlist(lapply(id.database@database[c(id.found)], function(x) x$Formula))
id.list <- object@Results@Identification[,c(current.column.match,current.column)]
del.na <- which(is.na(id.list[,1]))
if(length(del.na)!=0) id.list <- id.list[-del.na,]
id.list <- cbind(id.list,met.name,met.cas,met.form)
colnames(id.list)[ncol(id.list):(ncol(id.list)-2)] <- c(current.column.form,current.column.cas,current.column.name)
cas.no.na <- apply(id.list,1,function(x) {if(as.vector(x[current.column.cas])=="NA"){
x[current.column.cas]=""
} else{
x[current.column.cas]
}
})
id.list[,current.column.cas] <- cas.no.na
id.list <- id.list[,c(current.column.name,current.column.match,current.column,current.column.cas,current.column.form)]
id.list.up <- cbind(id.list.up,as.matrix(id.list))
}
if(length(del.na)!=0) id.general <- id.general[-del.na,]
id.list <- cbind(id.general,id.list.up)
if(!is.null(object@Results@Parameters@Alignment$min.samples)){
id.list <- id.list[which(id.list$FoundIn>=object@Results@Parameters@Alignment$min.samples),]
}
if(!is.null(object@Results@Identification$RI.error.1))
{
#RI.errTab <- cbind(object@Results@Identification$AlignID, object@Results@Identification$RI.error.1)
selColsbyName <- c('AlignID', sapply(1:n.putative, function(x) paste('RI.error.', x, sep='')))
selColsbyName <- selColsbyName[selColsbyName %in% colnames(object@Results@Identification)]
RI.errTab <- object@Results@Identification[,selColsbyName]
#colnames(RI.errTab) <- c("AlignID", "RI.err")
id.list <- merge(id.list[,1:ncol(id.list)], RI.errTab, by = "AlignID")
#id.list <- id.list[c(1:5,ncol(id.list),6:(ncol(id.list)-1))]
}
return(as_tibble(id.list[order(as.numeric(as.vector(id.list[,"tmean"]))),], row.names=1:nrow(id.list)))
}
)
# factorList <- function(object, sample)
# {
# if(is.null(object@Data@FactorList[[sample]]$AlignID))
# {
# return(as.data.frame(object@Data@FactorList[[sample]][,c("ID","RT","Peak Height","Area")]))
# }else{
# return(as.data.frame(object@Data@FactorList[[sample]][,c("ID","AlignID","RT","Peak Height","Area")]))
# }
# }
#' @rdname alignList
#' @title Alignment list
#' @description The list of aligned metabolites and their relative quantification for each sample in a given experiment
#' @usage alignList(object, by.area = TRUE)
#' @param object A 'MetaboSet' S4 object containing the experiment data. The experiment has to be previously deconvolved, aligned and (optionally) identified.
#' @param by.area if TRUE (default), eRah outputs quantification by the area of the deconvolved chromatographic peak of each compound. If FALSE, eRah outputs the intensity of the deconvolved chromatographic peak.
#' @details Returns an alignment table containing the list of aligned metabolites and their relative quantification for each sample in a given experiment.
#' @return
#' \code{alignList} returns a data frame object:
#' \item{AlignID}{The unique Tag for found metabolite by eRah. Each metabolite found by eRah for a given experiment has an unique AlignID tag number.}
#' \item{Factor}{the Factor tag name. Each metabolite has an unique 'Factor' name to enhance visual interpretation.}
#' \item{tmean}{The mean compound retention time.}
#' \item{FoundIn}{The number of samples in which the compound has been detected (the number of samples where the compound area is non-zero).}
#' \item{Quantification}{As many columns as samples and as many rows as metabolites, where each column name has the name of each sample.}
#' @seealso \code{\link{idList}} \code{\link{dataList}}
#' @export
setGeneric('alignList',function(object, by.area=TRUE){
standardGeneric('alignList')
})
#' @rdname alignList
setMethod('alignList',signature = 'MetaboSet',
function(object, by.area=TRUE) {
if(!(any(unlist(lapply(object@Data@FactorList,function(x) {is.null(x$AlignID)} ))==FALSE))) stop("Factors must be aligned first")
height <- FALSE
if(by.area==FALSE) height <- TRUE
if(height==TRUE)
{
del.in <- which(colnames(object@Results@Alignment)=="Spectra")
alList <- object@Results@Alignment[,-del.in]
if(!is.null(object@Results@Parameters@Alignment$min.samples)){
alList <- alList[which(alList$FoundIn>=object@Results@Parameters@Alignment$min.samples),]
}
return(alList)
}else{
# align.inds <- as.numeric(as.vector(object@Results@Alignment[,"AlignID"]))
# align.area <- lapply(object@Data@FactorList,function(x) {
# #search.for <- which(x$"AlignID" %in% align.inds)
# search.for <- unlist(sapply(align.inds, function(i) which(as.numeric(as.vector(x$"AlignID"))==i)))
# as.numeric(as.vector(x$"Area"[search.for]))
# })
# if(!is.matrix(align.area))
# {
# del.list <- as.vector(which(unlist(lapply(align.area,length))==0))
# if(length(del.list)!=0) align.area <- align.area[-del.list]
# align.area <- unlist(align.area)
# dim(align.area) <- c(length(align.inds), length(align.area)/length(align.inds))
# }
# del.in <- which(colnames(object@Results@Alignment)=="Spectra")
# area.list <- cbind(object@Results@Alignment[,c("AlignID","Factor","tmean","FoundIn")],align.area)
# colnames(area.list) <- colnames(object@Results@Alignment[,-del.in])
# return(area.list)
empty.samples <- which(lapply(object@Data@FactorList,nrow)==0)
if(length(empty.samples)!=0) object@Data@FactorList <- object@Data@FactorList[-empty.samples]
factors.list <- object@Data@FactorList
align.inds <- as.numeric(as.vector(object@Results@Alignment[,"AlignID"]))
align.area <- lapply(factors.list,function(x) {
#search.for <- which(x$"AlignID" %in% align.inds)
search.for <- (sapply(align.inds, function(i) which(as.numeric(as.vector(x$"AlignID"))==i)))
if(inherits(search.for,"list"))
{
fill.inds <- unlist(lapply(search.for, length))
fill.vector <- rep(0,length(align.inds))
fill.vector[fill.inds==1] <- as.numeric(as.vector(x$"Area"[unlist(search.for)]))
}else{
fill.vector <- as.numeric(as.vector(x$"Area"[search.for]))
}
fill.vector
})
if(!is.matrix(align.area))
{
del.list <- as.vector(which(unlist(lapply(align.area,length))==0))
if(length(del.list)!=0) align.area <- align.area[-del.list]
align.area <- unlist(align.area)
dim(align.area) <- c(length(align.inds), length(align.area)/length(align.inds))
}
del.in <- which(colnames(object@Results@Alignment)=="Spectra")
area.list <- cbind(object@Results@Alignment[,c("AlignID","Factor","tmean","FoundIn")],align.area)
colnames(area.list) <- colnames(object@Results@Alignment[,-del.in])
if(!is.null(object@Results@Parameters@Alignment$min.samples)){
area.list <- area.list[which(area.list$FoundIn>=object@Results@Parameters@Alignment$min.samples),]
}
return(as_tibble(area.list))
}
}
)
#' @rdname dataList
#' @title Data list
#' @description The final eRah list of aligned and identified metabolites and their relative quantification for each sample in a given experiment
#' @usage dataList(Experiment, id.database = mslib, by.area = TRUE)
#' @param Experiment A 'MetaboSet' S4 object containing the experiment data. The experiment has to be previously deconvolved, aligned and identified.
#' @param id.database The mass-spectra library to be compared with the empirical spectra. By default, the MassBank - Mass Bank of North America (MoNa) database are employed (mslib object).
#' @param by.area if TRUE (default), eRah outputs quantification by the area of the deconvolved chromatographic peak of each compound. If FALSE, eRah outputs the intensity of the deconvolved chromatographic peak.
#' @details Returns an identification and alignment table containing the list of aligned and identifed metabolites (names) and their relative quantification for each sample in a given experiment.
#' @return
#' \code{alignList} returns an S3 object:
#' \item{AlignID}{The unique Tag for found metabolite by eRah. Each metabolite found by eRah for a given experiment has an unique AlignID tag number.}
#' \item{tmean}{The mean compound retention time.}
#' \item{FoundIn}{The number of samples in which the compound has been detected (the number of samples where the compound area is non-zero).}
#' \item{Name.X}{the name of the Xst/nd/rd... hit. idList return as many X (hits) as n.putative selected with \code{\link{identifyComp}}.}
#' \item{MatchFactor.X}{The match factor/score of spectral similarity (spectral correlation).}
#' \item{DB.Id.X}{The identification number of the library. Each metbolite in the reference library has a different DB.Id number.}
#' \item{CAS.X}{the CAS number of each identified metabolite.}
#' \item{Quantification}{As many columns as samples and as many rows as metabolites, where each column name has the name of each sample.}
#' @seealso \code{\link{idList}} \code{\link{alignList}}
#' @export
setGeneric('dataList',function(Experiment, id.database=mslib, by.area=TRUE){
standardGeneric('dataList')
})
#' @rdname dataList
setMethod('dataList',signature = 'MetaboSet',
function(Experiment, id.database=mslib, by.area=TRUE){
ID.table <- idList(Experiment, id.database)
Al.table <- alignList(Experiment, by.area)
Al.table <- Al.table[, !(names(Al.table) %in% c("FoundIn","tmean","Factor"))]
data.table <- merge(ID.table, Al.table, by="AlignID")
as_tibble(data.table)
}
)
#' expClasses-method
#' @rdname expClasses
#' @description The classes of a given experiment.
#' @param object A 'MetaboSet' S4 object containing the experiment.
#' @details Returns the classes details of the experiment.
#' @seealso metaData phenoData
#' @export
setGeneric('expClasses',function(object){
standardGeneric('expClasses')
})
#' @rdname expClasses
setMethod('expClasses',signature = 'MetaboSet',
function(object){
if(nrow(object@MetaData@Phenotype)==0) stop("No Phenotype data has been attached to this experiment.")
pn <- object@MetaData@Phenotype
samples.name <- names(object@Data@FactorList)
indx <- apply(as.matrix(samples.name),1,function(x) which(pn[,"sampleID"]==x))
class.names <- unlist(pn[indx,"class"],use.names = F)
samples.class.type <- levels(as.factor(class.names))
empty.samples <- which(lapply(object@Data@FactorList,nrow)==0)
classes.list <- matrix(c(samples.name, class.names, rep("Processed", length(samples.name))), ncol=3)
classes.list[empty.samples,3] <- "Not processed"
colnames(classes.list) <- c("Sample ID", "Class Type", "Processing Status")
classes.summary <- as.data.frame(classes.list, row.names=1:nrow(classes.list))
classes.string <- paste(samples.class.type, collapse=", ")
cat("Experiment containing ", nrow(classes.summary), " samples in ", length(samples.class.type), " different type of classes named: ",classes.string, ". \n \n", sep="")
print(classes.summary)
#return(new("expClasses", classes.type=samples.class.type, classes.summary=classes.summary))
}
)
#' @rdname sampleInfo
#' @title Information of the samples
#' @description Returns basic information on the samples.
#' @usage sampleInfo(Experiment, N.sample = 1)
#' @param Experiment A 'MetaboSet' S4 object containing the experiment.
#' @param N.sample Integer. The number of the sample to query.
#' @details Returns details on a given sample of the experiment, such as name, start time, end time, minium and maximum adquired m/z and scans per second.
#' @seealso \code{\link{plotChr}}
#' @export
setGeneric('sampleInfo',function(Experiment, N.sample=1){
standardGeneric('sampleInfo')
})
#' @rdname sampleInfo
setMethod('sampleInfo',signature = 'MetaboSet',
function(Experiment, N.sample=1){
sampleRD <- load.file(paste(Experiment@MetaData@DataDirectory, Experiment@MetaData@Instrumental$filename[[N.sample]], sep="/"))
max.rt <- (nrow(sampleRD@data)/(sampleRD@scans.per.second*60)) + sampleRD@start.time/60
min.rt <- sampleRD@start.time/60
cat(" Name: \t", as.vector(Experiment@MetaData@Instrumental$filename[[N.sample]]), "\n", "Start Time: \t", min.rt, "\n", "End Time: \t", max.rt, "\n", "Min MZ: \t", sampleRD@min.mz, "\n", "Max MZ: \t", sampleRD@max.mz, "\n", "Scans/sec: \t", sampleRD@scans.per.second)
}
)
#' metaData-method
#' @rdname metaData
#' @description Displays the Experiment metadata
#' @param object A 'MetaboSet' S4 object containing the experiment.
#' @seealso \code{\link{phenoData}}
#' @export
setGeneric('metaData',function(object){
standardGeneric('metaData')
})
#' @rdname metaData
setMethod('metaData',signature = 'MetaboSet',
function(object){
object@MetaData@Instrumental
}
)
#' phenoData-method
#' @rdname phenoData
#' @description Displays the Experiment phenotypic data (if included).
#' @param object A 'MetaboSet' S4 object ciontaining the experiment.
#' @seealso \code{\link{metaData}}
#' @export
setGeneric('phenoData',function(object){
standardGeneric('phenoData')
})
#' @rdname phenoData
setMethod('phenoData',signature = 'MetaboSet',
function(object) {
object@MetaData@Phenotype
}
)
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.