R/MetaGenomic_utility.R

In Fuschi/JAX: What the Package Does (One Line, Title Case)

#----------------------------------#
#'@export
MetaGenomic$set(which="active",
				name="nsample",
				value=function(){
					return(nrow(self$data))
				})

#----------------------------------#
#'@export
MetaGenomic$set(which="active",
				name="ntaxa",
				value=function(){
					return(ncol(self$data))
				})

#----------------------------------#
#'@export
MetaGenomic$set(which="active",
				name="sample_name",
				value=function(){
					return(rownames(self$data))
				})

#----------------------------------#
#'@export
MetaGenomic$set(which="active",
				name="taxa_name",
				value=function(){
					return(colnames(self$data))
				})

#----------------------------------#
#'@export
MetaGenomic$set(which="active",
				name="ranks",
				value=function(){
					return(colnames(self$taxa))
				})

#----------------------------------#
#'@export
MetaGenomic$set(which="active",
				name="nranks",
				value=function(){
					return(ncol(self$taxa))
				})


#----------------------------------#
#'@export
MetaGenomic$set(which="active",
				name="meta_info",
				value=function(){
					return(colnames(self$meta))
				})

#----------------------------------#
#'@export
MetaGenomic$set(which="active",
				name="mdata",
				value=function(){
					return(as.matrix(self$data))
				})

#----------------------------------#
#'@export
MetaGenomic$set(which="active",
				name="clr_data",
				value=function(){

					x <- self$mdata
					#Replace zero with min value
					if(any(x==0)){
						x[x==0] <- min(x[x>0])
					}

					x <- log(x)
					x <- sweep(x, 1, rowMeans(x), "-")
					x <- as.matrix(x)

					return(x)
				})

#----------------------------------#
#'@export
MetaGenomic$set(which="public",
				name="aggregate",
				value=function(rank){

					#---------------------------------------------------#
					assert(rank %in% self$ranks, cat("rank must be equal to one of the following choices {",self$ranks,"}"))
					#---------------------------------------------------#

					different.taxa <- unique(self$taxa[,rank])
					data.aggregate <- data.frame(matrix(NA, nrow=self$nsample, ncol=length(different.taxa),
														dimnames=list(self$sample_name,different.taxa)))

					for(taxa.i in different.taxa){
						idx <- which(taxa.i == self$taxa[,rank])
						data.aggregate[,taxa.i] <- apply(X=self$data, MARGIN=1, function(x) sum(x[idx]) )
					}

					taxa_lvls_aggregate <- self$ranks[1:which(self$ranks==rank)]
					taxa.aggregate <- data.frame(matrix(NA, nrow=length(different.taxa), ncol=length(taxa_lvls_aggregate),
														dimnames=list(different.taxa, taxa_lvls_aggregate)))
					for(taxa.i in different.taxa){

						idx <- which(taxa.i == self$taxa[,rank])
						tmp <- self$taxa[idx, taxa_lvls_aggregate]
						if(!all(apply(tmp, 1, function(x) all(tmp[1,]==x)))){
							stop("find identical taxa name with different taxonomic higher description")
						}

						taxa.aggregate[taxa.i,] <- tmp[1,]
					}

					return(MetaGenomic$new(data=data.aggregate, meta=self$meta, taxa=taxa.aggregate))

				})