pepStat: Statistical analysis of peptide microarrays

#' peptideSet methods
#'
#' Methods for handling peptideSet objects
#' @name peptideSet-methods
#' @rdname peptideSet-methods
#'
#' @section Accessors:
#' \describe{
#'  \item{\code{nrow(x)}:}{The number of peptides in x.}
#'  \item{\code{ncol(x)}:}{The number of samples in x.}
#'  \item{\code{start(x)}:}{Get the starts of the peptides.}
#'  \item{\code{end(x)}:}{Get the ends of the peptides.}
#'  \item{\code{width(x)}:}{Get the widths of the peptides.}
#'  \item{\code{position(x)}:}{Get the coordinates of the central amino-acid of
#'  each peptide, given by: \code{round((start(x) + end(x))/2)}.}
#'  \item{\code{ranges(x)}:}{Returns a \code{GRanges} object that contains
#'  the annotations for the peptides.}
#'  \item{\code{ranges(x)<- value}}{Set annotations for the peptides.}
#'  \item{\code{values(x)}:}{Returns a \code{SplitDataFrameList}. Accessor for the
#'  values of the featureRange slot.}
#'  \item{\code{clade(x)}:}{If available, returns the clade information for each
#'  peptide as a \code{matrix}.}
#'  \item{\code{peptide(x)}:}{Get the sequence of the peptides.}
#'  \item{\code{peptide(x) <- value}}{Set the sequence of the peptides.}
#'  \item{\code{featureID(x)}:}{Get the ID of the peptides.}
#'  \item{\code{pepZscore(x)}:}{If available, returns a \code{matrix} of the zScores
#'  for each peptide.}
#'  \item{\code{pepZscore(x) <- value}}{Set the zScores for each peptide}
#' }
#'
#' @aliases
#' start,peptideSet-method
#' end,peptideSet-method
#' width,peptideSet-method
#' position
#' position-method
#' position,peptideSet-method
#' ranges,peptideSet-method
#' ranges<-,peptideSet-method
#' values,peptideSet-method
#' clade
#' clade-methods
#' clade,GRanges-method
#' clade,peptideSet-method
#' peptide
#' peptide<-
#' peptide-method
#' peptide,peptideSet-method
#' peptide<-,peptideSet,character-method
#' featureID
#' featureID-method
#' featureID,peptideSet-method
#' pepZscore
#' pepZscore<-
#' pepZscore-method
#' pepZscore,peptideSet-method
#' pepZscore<-,peptideSet,data.frame-method
#' pepZscore,GRanges-method
#' pepZscore<-,GRanges,data.frame-method
#' [,peptideSet,ANY,ANY,ANY-method
#' subset,peptideSet-method
#' show,peptideSet-method
#' summary,peptideSet-method
#'
#' @exportMethod "start"
#' @exportMethod "end"
#' @exportMethod "width"
#' @exportMethod "position"
#' @exportMethod "ranges"
#' @exportMethod "values"
#' @exportMethod "ranges<-"
#' @exportMethod "clade"
#' @exportMethod "peptide"
#' @exportMethod "pepZscore"
#' @exportMethod "featureID"
#' @exportMethod "peptide<-"
#' @exportMethod "pepZscore<-"
#'
#' @section Display:
#' \describe{
#'  \item{\code{show(object)}:}{Display a peptideSet object.}
#'  \item{\code{summary(object)}:}{Summarize a peptideSet object.}
#' }
#'
#' @exportMethod "show"
#' @exportMethod "summary"
#'
#' @section Subset:
#' \describe{
#'  \item{\code{x[i, j]}:}{Subset x by peptides (i), or samples (j).}
#'  \item{\code{subset(x, subset, drop=FALSE)}:}{Subset x given an expression 'subset'.}
#' }
#'
#' @exportMethod "["
#' @exportMethod "subset"
#'
#' @importMethodsFrom IRanges lapply ranges ranges<- values values<- width cbind
#' rbind
NULL


setMethod("show", "peptideSet",function(object){
  cat("Object of class 'peptideSet' contains","\n")
  print(as(object,"ExpressionSet"))
  print(ranges(object))
})


setAs(from="peptideSet",to="ExpressionSet",function(from){
			ExpressionSet(assayData(from)
					,phenoData=phenoData(from)
					,experimentData=experimentData(from)
					,annotation=annotation(from)
					,protocolData=protocolData(from)
					)
})

setMethod("summary", signature("peptideSet"),
    function(object) {
      cat("   Sample name(s): ",sampleNames(object@phenoData)," \n")
      cat("   The total number of probes is: ",length(peptide(object))," \n")
      cat("   Preprocessing Information \n")
      cat("     - Transformation:",preproc(object@experimentData)$transformation, "\n")
      cat("     - Normalization:",preproc(object@experimentData)$normalization, "\n")
    }
)

# Subset by peptide/sample
setMethod("[", signature("peptideSet", i = "ANY", j = "ANY"),
          function(x, i, j, ..., drop = FALSE) {
            if (!missing(i)) {
              sdata <- exprs(x)[i, j, drop = drop]
              featureRange <- ranges(x)[i, ]
            } else {
              sdata <- exprs(x)[, j, drop = drop]
              featureRange <- ranges(x)
            }
            newSet<-new('peptideSet',
                        exprs = as.matrix(sdata),
                        featureRange = featureRange,
                        experimentData = x@experimentData)

            if (!missing(j)) {
             pData(newSet) <- pData(x)[j,]
             sampleNames(newSet) <- sampleNames(x)[j]
            } else {
              pData(newSet) <- pData(x)
            }
            newSet
          })

setMethod("subset", signature(x = "peptideSet"),
          function (x, subset, drop = FALSE, ...) {
            if (missing(subset)){
              r <- rep(TRUE,nrow(x))
            }
            else {
              e <- substitute(subset)#class(e) = call
              r <- eval(e, pData(x), parent.frame())
              if (!is.logical(r))
                stop("'subset' must evaluate to logical")
              r <- r & !is.na(r)
              vars<-r
            }
            x[, vars, drop = drop]
          })


setGeneric("position", function(x, ...) standardGeneric("position"))
setMethod("position", "peptideSet", function(x){
			round((start(ranges(x))+end(ranges(x)))/2)
		})

setMethod("start", "peptideSet", function(x){
			start(ranges(x))
		})

setMethod("end", "peptideSet", function(x){
			end(ranges(x))
		})

setMethod("width", "peptideSet", function(x){
			width(ranges(x))
		})

setMethod("values", "peptideSet", function(x){
			values(ranges(x))
		})

setMethod("values<-", "peptideSet", function(x, value){
			values(ranges(x)) <- value
			return(x)
		})

setReplaceMethod("ranges", "peptideSet",
		function(x, value)
		{
			x@featureRange <- value
			x
		})

setMethod("ranges", "peptideSet",
		function(x)
		{
			x@featureRange
		})

setGeneric("peptide", function(x, ...) standardGeneric("peptide"))
setMethod("peptide", "peptideSet",
		function(x, type=NULL)
		{
			validTypes<-c("peptide", "aligned", "trimmed")
			if (is.null(type)){
				type <- "peptide"
			}

			if (type%in%validTypes){
				peptides <- values(ranges(x))[, type]
			}
      else {
				warning("'",type, "' is not a valid type! The accepted types are: ",
                paste(validTypes, collapse =", "),".")
			}
      return(peptides)
		})

setGeneric("peptide<-", function(object, value) standardGeneric("peptide<-"))
setReplaceMethod("peptide", signature("peptideSet", "character"), function(object, value){
  values(ranges(object))[, "peptide"] <- value
  return(object)
})

setGeneric("featureID", function(x, ...) standardGeneric("featureID"))
setMethod("featureID", "peptideSet",
		function(x, type=NULL){
			if (is.null(type))
			{
				values(ranges(x))[["featureID"]]
			}
		})

setGeneric("split")
setMethod("split", "peptideSet", function(x, f, byrow = TRUE){
  if(is.vector(f) | is.factor(f))
  {
    f <- as.factor(f)
    if(byrow)
    {
      lapply(1:nlevels(f),
             function(i, pSet, f){pSet[f == levels(f)[i],]}, x, f)
    }
    else
    {
      lapply(1:nlevels(f),
             function(i, pSet, f){pSet[, f == levels(f)[i]]}, x, f)
    }
  }
  else
  {
    lapply(1:ncol(f), function(i, pSet, f){pSet[f[, i], ]}, x, f)
  }
})


setMethod("cbind", "peptideSet", function(..., deparse.level=1){
 args <- list(...)

 names <- unlist(sapply(args, function(x){sampleNames(x)}))
 pd.list <- lapply(args, function(x){pData(x)})
 pd<-do.call(rbind, pd.list)

 eSet.list <- lapply(args, function(x){exprs(x)})
 eSet <- do.call(cbind, eSet.list)

 newSet<-new('peptideSet',
             exprs = as.matrix(eSet),
             featureRange = args[[1]]@featureRange,
             experimentData = args[[1]]@experimentData)
 pData(newSet) <- pd
 sampleNames(newSet) <- names
 newSet
})

setGeneric("write.pSet",
           function(x, bg.correct=FALSE, ...) standardGeneric("write.pSet"))
setMethod("write.pSet", "peptideSet", function(x, bg.correct=FALSE, ...){
  if (bg.correct) {
    exprs<-.bgCorrect.pSet(x)
  } else {
    exprs<-exprs(x)
  }
  y <- cbind(peptide(x), start(x), end(x), featureID(x), exprs)
  colnames(y)[1:4] <- c("peptide", "start", "end", "annotation")
  write.csv(y, ...)
})


#clade acessor
setGeneric("clade",
                def = function(object)
                        standardGeneric("clade"))

setMethod("clade",
          signature = signature(object = "GRanges"),
          definition = function(object){
            if(is.null(object$clade)){
              stop("The object does not have clade information!")
            }
            cladeList <- unique(unlist(
              strsplit(levels(as.factor(object$clade)), ","))) #List of all possible clades
            len <- length(object)
            retMatrix <- matrix(FALSE, nrow = len, ncol = length(cladeList))
            pepClades <- strsplit(as.character(object$clade), split = ",") #clades for each peptide
            for(pepIdx in 1:len){
              tmpList <- cladeList %in% pepClades[[pepIdx]]
              retMatrix[pepIdx, ] <- tmpList
            }
            rownames(retMatrix) <- names(object)
            colnames(retMatrix) <- cladeList
            return(retMatrix)
          })


setMethod("clade",
                signature = signature(object="peptideSet"),
                definition = function(object){ clade(object@featureRange)
                })

setGeneric("pepZscore", function(object) standardGeneric("pepZscore"))
setMethod("pepZscore", signature("GRanges"), function(object){
  vals <- as.data.frame(values(object))
  zs <- c("z1", "z2", "z3", "z4", "z5")
  zIns <- zs[zs %in% colnames(vals)]
  return(vals[,zIns])
})

setMethod("pepZscore", signature("peptideSet"), function(object){
  pepZscore(ranges(object))
})

setGeneric("pepZscore<-", function(object, value) standardGeneric("pepZscore<-"))
setReplaceMethod("pepZscore", signature("GRanges", "data.frame"), function(object, value){
  zs <- c("z1", "z2", "z3", "z4", "z5")
  if(!all(zs %in% colnames(value))){
    stop("The given data.frame does not contain the required colum names: 'z1', 'z2', 'z3', 'z4', 'z5'")
  }
  for(z in zs){
    object[[z]] <- value[[z]]
  }
  return(object)
})


setReplaceMethod("pepZscore", signature("peptideSet", "data.frame"), function(object, value){
  pepZscore(ranges(object)) <- value
  return(object)
})

setMethod("colnames", "peptideSet", function(x){ colnames(ranges(x)) })

# setReplaceMethod("rownames", signature("peptideSet", "character"),
#                  function(x, value){
#                    rownames(ranges(x)) <- value
#                    rownames(exprs(x)) <- value
#                    return(x)
#                    })