R/prepareMatrix.R

In prozor: Minimal Protein Set Explaining Peptide Spectrum Matches

.makePrecursorID <- function(pepprot, sep="|"){
    tmp = pepprot[,c("peptideModSeq","precursorCharge")]
    tmp = apply(tmp,2,as.character)
    apply(tmp, 1, paste, collapse = sep)
}
#' given table of peptide protein assigments generate matrix
#'
#' @param data generated by annotatePeptides
#' @param weighting weight type to use. Options are "one" , "AA" - amino acids, "coverage" - coverage , "inverse" - inverse peptide frequencies
#' @param sep separator for precursor (rownames)
#' @param proteinID protein ID column
#' @param peptideID peptide / precursor ID column
#' @return sparse matrix
#' @export
#' @examples
#' #library(prozor)
#' data(protpepmetashort)
#' library(Matrix)
#' colnames(protpepmetashort)
#' head(protpepmetashort)
#' dim(protpepmetashort)
#' count = prepareMatrix( protpepmetashort, peptideID = "peptideSeq" )
#' dim(count)
#' inverse = prepareMatrix( protpepmetashort, peptideID = "peptideSeq" , weight = "inverse")
#' #aa = prepareMatrix(protpepmetashort,  peptideID = "peptideSeq" , weight = "AA")
#' #xx = prepareMatrix(protpepmetashort,  peptideID = "peptideSeq" , weight = "coverage")
#' image( as.matrix(count) )
#'
#' corProt = cor( as.matrix(count) )
#' par(mfrow =c(1,2))
#' image(corProt)
#'
#' #penalise peptides matching many proteins
#' corProtn = cor( as.matrix(inverse) )
#' image(corProtn)
#'
prepareMatrix <- function(data, proteinID = "proteinID", peptideID = "strippedSequence", weighting = NULL, sep="|" ) {
    fprots = as.factor( data[,proteinID] )
    prots = as.integer( fprots )
    fpeps = as.factor( data[,peptideID] )
    peps = as.integer(fpeps)

    if (is.null(weighting)) {
        pepProt = Matrix::sparseMatrix(peps , prots, x = 1 )
    } else if (length(weighting) == nrow(data)) {
        pepProt = Matrix::sparseMatrix(peps, prots, x = weighting )
    } else if (weighting == "inverse") {
        pepProt = Matrix::sparseMatrix(peps, prots, x = 1 )
        nrPeps = rowSums(pepProt)
        pepProt <- sweep(pepProt, 1 , nrPeps, "/" )
    } else {
        stopifnot(FALSE)
    }
    colnames(pepProt) <- levels(fprots)
    rownames(pepProt) <- levels(fpeps)
    dim(pepProt)
    return(pepProt)
}