@@ -1,5 +1,5 @@

 Package: CoGAPS

-Version: 3.1.3

+Version: 3.3.0

 Date: 2018-04-24

 Title: Coordinated Gene Activity in Pattern Sets

 Author: Thomas Sherman, Wai-shing Lee, Conor Kelton, Ondrej Maxian, Jacob Carey,

@@ -51,31 +51,18 @@ Collate:

     'CoGAPS.R'

     'GWCoGAPS.R'

     'RcppExports.R'

-    'binaryA.R'

-    'calcCoGAPSStat.R'

-    'calcGeneGSStat.R'

-    'calcZ.R'

     'cellMatchR.R'

     'class-CogapsResult.R'

     'createGWCoGAPSSets.R'

     'createscCoGAPSSets.R'

-    'gapsInterPattern.R'

-    'gapsIntraPattern.R'

     'generateSeeds.R'

     'package.R'

     'patternMarkers.R'

     'patternMatch4Parallel.R'

     'patternMatcher.R'

-    'plotAtoms.R'

-    'plotDiag.R'

-    'plotGAPS.R'

-    'plotP.R'

     'plotPatternMarkers.R'

-    'plotSmoothPatterns.R'

     'postFixed4Parallel.R'

     'postFixed4SC.R'

     'reOrderBySet.R'

-    'reconstructGene.R'

     'reorderByPatternMatch.R'

-    'residuals.R'

     'scCoGAPS.R'

@@ -3,7 +3,6 @@

 export(CoGAPS)

 export(GWCoGAPS)

 export(GWCoGapsFromCheckpoint)

-export(MergeResultsWithSCE)

 export(binaryA)

 export(buildReport)

 export(calcCoGAPSStat)

@@ -13,14 +12,13 @@ export(cellMatchR)

 export(computeGeneGSProb)

 export(createGWCoGAPSSets)

 export(createscCoGAPSSets)

+export(getMeanChiSq)

 export(getParam)

 export(patternMarkers)

 export(patternMatch4Parallel)

-export(plotAtoms)

-export(plotGAPS)

-export(plotP)

+export(plot.CogapsResult)

+export(plotResiduals)

 export(reconstructGene)

-export(residuals)

 export(scCoGAPS)

 export(setParam)

 exportClasses(CogapsParams)

@@ -29,6 +27,9 @@ import(doParallel)

 import(foreach)

 import(ggplot2)

 import(shiny)

+importClassesFrom(S4Vectors,Annotated)

+importClassesFrom(S4Vectors,DataFrame)

+importClassesFrom(S4Vectors,character_OR_NULL)

 importClassesFrom(SingleCellExperiment,SingleCellExperiment)

 importClassesFrom(SummarizedExperiment,SummarizedExperiment)

 importFrom(RColorBrewer,brewer.pal)

@@ -178,6 +178,8 @@ checkDataMatrix <- function(data, uncertainty, params)

 {

     if (sum(data < 0) > 0 | sum(uncertainty < 0) > 0)

         stop("negative values in data and/or uncertainty matrix")

-    if (nrow(data) == params@nPatterns || ncol(data) == params@nPatterns)

+    if (nrow(data) <= params@nPatterns | ncol(data) <= params@nPatterns)

         stop("nPatterns must be less than dimensions of data")

+    if (sum(dim(uncertainty)) != 2 & sum(uncertainty < 1e-5) > 0)

+        warning("small values in uncertainty matrix detected")

 }

\ No newline at end of file

@@ -20,9 +20,14 @@

 #' createGWCoGAPSSets(SimpSim.D, SimpSim.S, nSets=2, sim_name)

 #' result <- GWCoGAPS(sim_name, nFactor=3, nEquil=200, nSample=200)

 #' @export

-GWCoGAPS <- function(simulationName, nFactor, nCores=NA, cut=NA, minNS=NA,

+GWCoGAPS <- function(simulationName, nFactor=3, nCores=NA, cut=NA, minNS=NA,

 manualMatch=FALSE, consensusPatterns=NULL, saveUnmatchedPatterns=FALSE, ...)

 {

+    if (!is.null(list(...)$nPatterns))

+    {

+        nFactor <- list(...)$nPatterns

+    }

+

     if (!is.null(list(...)$checkpointFile))

     {

         stop("checkpoint file name automatically set in GWCoGAPS - don't pass this parameter")

@@ -162,7 +167,7 @@ runInitialPhase <- function(simulationName, allDataSets, nFactor, ...)

 postInitialPhase <- function(initialResult, nSets, cut, minNS)

 {

-    nFactor <- ncol(initialResult[[1]]@Amean)

+    nFactor <- ncol(initialResult[[1]]@featureLoadings)

     BySet <- reOrderBySet(AP=initialResult, nFactor=nFactor, nSets=nSets)

     #run postpattern match function

@@ -177,7 +182,7 @@ postInitialPhase <- function(initialResult, nSets, cut, minNS)

 runFinalPhase <- function(simulationName, allDataSets, consensusPatterns, nCores, ...)

 {    

-    if (length(dim(consensusPatterns)) != 2)

+    if (class(consensusPatterns) != "matrix")

     {

         stop("consensusPatterns must be a matrix")

     }

@@ -197,6 +202,7 @@ runFinalPhase <- function(simulationName, allDataSets, consensusPatterns, nCores

     # final number of factors

     nFactorFinal <- nrow(consensusPatterns)

+    message(paste("final number of patterns:", nFactorFinal))

     # run fixed CoGAPS

     finalResult <- foreach(i=1:length(allDataSets)) %dopar%

@@ -219,6 +225,14 @@ postFinalPhase <- function(finalResult, consensusPatterns)

 {

     Aresult <- postFixed4Parallel(finalResult, consensusPatterns)

     finalResult <- list("Amean"=Aresult$A, "Asd"=Aresult$Asd,"Pmean"=consensusPatterns)

-    class(finalResult) <- append(class(finalResult), "CoGAPS")

-    return(finalResult)

+    

+    return(new("CogapsResult",

+        Amean       = Aresult$A,

+        Asd         = Aresult$Asd,

+        Pmean       = consensusPatterns,

+        Psd         = NULL,

+        seed        = 0,

+        meanChiSq   = 0,

+        diagnostics = list()

+    ))

 }

deleted file mode 100644

@@ -1,28 +0,0 @@

-#' Binary Heatmap for Standardized A Matrix

-#'

-#' @details creates a binarized heatmap of the A matrix

-#' in which the value is 1 if the value in Amean is greater than

-#' threshold * Asd and 0 otherwise

-#' @param Amean the mean estimate for the A matrix

-#' @param Asd the standard deviations on Amean

-#' @param threshold the number of standard deviations above zero

-#' that an element of Amean must be to get a value of 1

-#' @return plots a heatmap of the A Matrix

-#' @examples

-#' data(SimpSim)

-#' binaryA(SimpSim.result$Amean, SimpSim.result$Asd, threshold=3)

-#' @export

-binaryA <-function(Amean, Asd, threshold=3)

-{

-    BinA_Map <- ifelse(Amean/Asd > threshold,1,0)

-    colnames(BinA_Map) <- colnames(BinA_Map, do.NULL=FALSE, prefix = "Pattern ")

-    rownames(BinA_Map) <- rep(" ",nrow(BinA_Map))

-

-    heatmap.2(BinA_Map, Rowv = FALSE, Colv = FALSE,dendrogram="none",

-        scale="none",col = brewer.pal(3,"Blues"), trace="none",

-        density.info="none",cexCol=1.3,srtCol=45,

-        lmat=rbind(c(0, 3),c(2,1),c(0,4) ),

-        lwid=c(1,10),lhei=c(1, 4, 1.2 ),

-        main="Heatmap of Standardized A Matrix")

-    mtext(paste("(Threshold = ", threshold, ")"))

-}

deleted file mode 100644

@@ -1,130 +0,0 @@

-#' Calculate Gene Set Statistics

-#'

-#' @details calculates the gene set statistics for each

-#' column of A using a Z-score from the elements of the A matrix,

-#' the input gene set, and permutation tests

-#' @param Amean A matrix mean values

-#' @param Asd A matrix standard deviations

-#' @param GStoGenes data.frame or list with gene sets

-#' @param numPerm number of permutations for null

-#' @return gene set statistics for each column of A

-#' @examples

-#' data('SimpSim')

-#' calcCoGAPSStat(SimpSim.result$Amean, SimpSim.result$Asd, GStoGenes=GSets,

-#' numPerm=500)

-#' @export

-calcCoGAPSStat <- function (Amean, Asd, GStoGenes, numPerm=500)

-{

-    # test for std dev of zero, possible mostly in simple simulations

-    if (sum(Asd==0) > 0)

-        Asd[Asd==0] <- 1e-6

-

-    # calculate Z scores

-    zMatrix <- calcZ(Amean,Asd)

-

-    # check input arguments

-    if (!is(GStoGenes, "data.frame") && !is(GStoGenes, "list") && !is(GStoGenes,"GSA.genesets"))

-    {

-        stop("GStoGenes must be a data.frame,GSA.genesets, or list with format specified in the users manual.")

-    }

-

-    if (is(GStoGenes, "GSA.genesets"))

-    {

-        names(GStoGenes$genesets) <- GStoGenes$geneset.names

-        GStoGenes <- GStoGenes$genesets

-    }

-

-    if (is(GStoGenes, "list"))

-    {

-        GStoGenesList <- GStoGenes

-    }

-    else

-    {

-        GStoGenesList <- list()

-        for (i in 1:dim(GStoGenes)[2])

-        {

-            GStoGenesList[[as.character(colnames(GStoGenes)[i])]] <- as.character(unique(GStoGenes[,i]))

-        }

-    }

-

-    # get dimensions

-    numGS   <- length(names(GStoGenesList))

-    numPatt <- dim(zMatrix)[2]

-    numG    <- dim(zMatrix)[1]+0.9999

-

-    # initialize matrices

-    statsUp   <- matrix(ncol = numGS, nrow = numPatt)

-    statsDown <- matrix(ncol = numGS, nrow = numPatt)

-    actEst    <- matrix(ncol = numGS, nrow = numPatt)

-    results   <- list()

-    zPerm     <- matrix(ncol=numPerm,nrow=numPatt)

-

-    # do permutation test

-    for (gs in 1:numGS)

-    {

-        genes <- GStoGenesList[[names(GStoGenesList)[gs]]]

-        index <- rownames(zMatrix) %in% genes

-        zValues <- zMatrix[index,1]

-        numGenes <- length(zValues)

-        label <- as.character(numGenes)

-

-        if (!any(names(results)==label))

-        {

-            for (p in 1:numPatt)

-            {

-                for (j in 1:numPerm)

-                {

-                    temp <- floor(runif(numGenes,1,numG))

-                    temp2 <- zMatrix[temp,p]

-                    zPerm[p,j] <- mean(temp2)

-                }

-            }

-            results[[label]] <- zPerm

-        }

-    }

-

-    # get p-value

-    for (p in 1:numPatt)

-    {

-        for (gs in 1:numGS)

-        {

-            genes <- GStoGenesList[[names(GStoGenesList)[gs]]]

-            index <- rownames(zMatrix) %in% genes

-            zValues <- zMatrix[index,p]

-            zScore <- mean(zValues)

-

-            numGenes <- length(zValues)

-            label <- as.character(numGenes)

-

-            permzValues <- results[[label]][p,]

-            ordering <- order(permzValues)

-            permzValues <- permzValues[ordering]

-

-            statistic <- sum(zScore > permzValues)

-            statUpReg <- 1 - statistic/length(permzValues)

-            statsUp[p,gs] <- max(statUpReg, 1/numPerm)

-

-            statistic <- sum(zScore < permzValues)

-            statDownReg <- 1 - statistic/length(permzValues)

-            statsDown[p,gs] <- max(statDownReg,1/numPerm)

-

-            activity <- 1 - 2*max(statUpReg, 1/numPerm)

-            actEst[p,gs] <- activity

-        }

-    }

-

-    # format output

-    colnames(statsUp) <- names(GStoGenesList)

-    colnames(statsDown) <- names(GStoGenesList)

-    colnames(actEst) <- names(GStoGenesList)

-

-    rownames(statsUp) <- colnames(zMatrix)

-    rownames(statsDown) <- colnames(zMatrix)

-    rownames(actEst) <- colnames(zMatrix)

-

-    results[['GSUpreg']] <- statsUp

-    results[['GSDownreg']] <- statsDown

-    results[['GSActEst']] <- actEst

-

-    return(results)

-}

deleted file mode 100644

@@ -1,97 +0,0 @@

-#' Probability Gene Belongs in Gene Set

-#'

-#' @details calculates the probability that a gene

-#' listed in a gene set behaves like other genes in the set within

-#' the given data set

-#' @param Amean A matrix mean values

-#' @param Asd A matrix standard deviations

-#' @param GSGenes data.frame or list with gene sets

-#' @param numPerm number of permutations for null

-#' @param Pw weight on genes

-#' @param nullGenes logical indicating gene adjustment

-#' @return gene similiarity statistic

-#' @examples

-#' data("SimpSim")

-#' calcGeneGSStat(SimpSim.result$Amean, SimpSim.result$Asd, GSGenes=GSets[[1]],

-#' numPerm=500)

-#' @export

-calcGeneGSStat  <- function(Amean, Asd, GSGenes, numPerm, Pw=rep(1,ncol(Amean)),

-nullGenes=FALSE)

-{

-    gsStat <- calcCoGAPSStat(Amean, Asd, data.frame(GSGenes), numPerm=numPerm)

-    gsStat <- gsStat$GSUpreg

-    gsStat <- -log(gsStat)

-

-    if (!all(is.na(Pw)))

-    {

-        if (length(Pw) != length(gsStat))

-        {

-            stop('Invalid weighting')

-        }

-        gsStat <- gsStat*Pw

-    }

-

-    if (nullGenes)

-    {

-        ZD <- Amean[setdiff(row.names(Amean), GSGenes),] /

-            Asd[setdiff(row.names(Amean), GSGenes),]

-    }

-    else

-    {

-        ZD <- Amean[GSGenes,]/Asd[GSGenes,]

-    }

-    outStats <- apply(sweep(ZD,2,gsStat,FUN="*"),1,sum) / (sum(gsStat))

-    outStats <- outStats / apply(ZD,1,sum)

-    outStats[which(apply(ZD,1,sum) < 1e-6)] <- 0

-

-    if (sum(gsStat) < 1e-6)

-    {

-        return(0)

-    }

-    return(outStats)

-}

-

-#' Compute Gene Probability

-#'

-#' @details Computes the p-value for gene set membership using the CoGAPS-based

-#' statistics developed in Fertig et al. (2012).  This statistic refines set

-#' membership for each candidate gene in a set specified in \code{GSGenes} by

-#' comparing the inferred activity of that gene to the average activity of the

-#' set.

-#' @param Amean A matrix mean values

-#' @param Asd A matrix standard deviations

-#' @param GSGenes data.frame or list with gene sets

-#' @param Pw weight on genes

-#' @param numPerm number of permutations for null

-#' @param PwNull - logical indicating gene adjustment

-#' @return A vector of length GSGenes containing the p-values of set membership

-#' for each gene containined in the set specified in GSGenes.

-#' @examples

-#' data("SimpSim")

-#' computeGeneGSProb(SimpSim.result$Amean, SimpSim.result$Asd, GSGenes=GSets[[1]],

-#' numPerm=500)

-#' @export

-computeGeneGSProb <- function(Amean, Asd, GSGenes, Pw=rep(1,ncol(Amean)),

-numPerm=500, PwNull=FALSE)

-{

-    geneGSStat <- calcGeneGSStat(Amean=Amean, Asd=Asd, Pw=Pw,

-        GSGenes=GSGenes, numPerm=numPerm)

-

-    if (PwNull)

-    {

-        permGSStat <- calcGeneGSStat(Amean=Amean, Asd=Asd,

-            GSGenes=GSGenes, numPerm=numPerm, Pw=Pw,

-            nullGenes=TRUE)

-    }

-    else

-    {

-        permGSStat <- calcGeneGSStat(Amean=Amean, Asd=Asd,

-            GSGenes=GSGenes, numPerm=numPerm,

-            nullGenes=TRUE)

-    }

-

-    finalStats <- sapply(GSGenes, function(x)

-        length(which(permGSStat > geneGSStat[x])) / length(permGSStat))

-

-    return(finalStats)

-}

deleted file mode 100644

@@ -1,21 +0,0 @@

-#' Compute Z-Score Matrix

-#'

-#' @details calculates the Z-score for each element based on input mean

-#' and standard deviation matrices

-#' @param meanMat matrix of mean values

-#' @param sdMat matrix of standard deviation values

-#' @return matrix of z-scores

-#' @examples

-#' data(SimpSim)

-#' calcZ(SimpSim.result$Amean, SimpSim.result$Asd)

-#' @export

-calcZ <- function(meanMat, sdMat)

-{

-    if (nrow(meanMat) != nrow(sdMat) | ncol(meanMat) != ncol(sdMat))

-        stop("meanMat and sdMat dimensions don't match")

-

-    zMat <- meanMat / sdMat

-    rownames(zMat) <- rownames(meanMat)

-    colnames(zMat) <- colnames(meanMat)

-    return(zMat)

-}

@@ -67,8 +67,8 @@ ignore.NA=FALSE, bySet=FALSE, plotDen=FALSE, ...)

             }

         }

-        AByClust[sapply(AByClust,is.null)] <- NULL

-        RtoMeanPattern[sapply(RtoMeanPattern,is.null)] <- NULL

+        #AByClust[sapply(AByClust,is.null)] <- NULL

+        #RtoMeanPattern[sapply(RtoMeanPattern,is.null)] <- NULL

         return(list("RtoMeanPattern"=RtoMeanPattern, "AByClust"=AByClust))

     }   

@@ -123,82 +123,92 @@ setGeneric("parseDirectParams", function(object, args)

 #' @rdname setParam-methods

 #' @aliases setParam

 setMethod("setParam", signature(object="CogapsParams"),

-    function(object, whichParam, value)

-    {

-        slot(object, whichParam) <- value

-        validObject(object)

-        return(object)

-    }

-)

+function(object, whichParam, value)

+{

+    slot(object, whichParam) <- value

+    validObject(object)

+    return(object)

+})

 #' @rdname getParam-methods

 #' @aliases getParam

 setMethod("getParam", signature(object="CogapsParams"),

-    function(object, whichParam)

-    {

-        slot(object, whichParam)

-    }

-)

+function(object, whichParam)

+{

+    slot(object, whichParam)

+})

 #' @rdname parseOldParams-methods

 #' @aliases parseOldParams

 setMethod("parseOldParams", signature(object="CogapsParams"),

-    function(object, oldArgs)

+function(object, oldArgs)

+{

+    helper <- function(arg, params, newArg)

     {

-        helper <- function(arg, params, newArg)

+        if (!is.null(oldArgs[[arg]]))

         {

-            if (!is.null(oldArgs[[arg]]))

-            {

-                warning(paste("parameter", arg, "is deprecated, it will still",

-                    "work, but setting", newArg, "in the params object is the",

-                    "preferred method"))

-                params <- setParam(params, newArg, oldArgs[[arg]])

-                oldArgs[[arg]] <- NULL

-            }            

-            return(params)

-        }

+            warning(paste("parameter", arg, "is deprecated, it will still",

+                "work, but setting", newArg, "in the params object is the",

+                "preferred method"))

+            params <- setParam(params, newArg, oldArgs[[arg]])

+            oldArgs[[arg]] <- NULL

+        }            

+        return(params)

+    }

-        object <- helper("nFactor", object, "nPatterns")

-        object <- helper("nIter", object, "nIterations")

-        object <- helper("nEquil", object, "nIterations")

-        object <- helper("nSample", object, "nIterations")

-        object <- helper("nOutR", object, "outputFrequency")

-        object <- helper("nOutput", object, "outputFrequency")

-        object <- helper("maxGibbmassA", object, "maxGibbsMassA")

-        object <- helper("max_gibbmass_paraA", object, "maxGibbsMassA")

-        object <- helper("maxGibbmassP", object, "maxGibbsMassP")

-        object <- helper("max_gibbmass_paraP", object, "maxGibbsMassP")

-        object <- helper("checkpointFile", object, "checkpointOutFile")

-        object <- helper("singleCellRNASeq", object, "singleCell")

-

-        if (!is.null(oldArgs$nSnapshots) | !is.null(oldArgs$sampleSnapshots) | !is.null(oldArgs$numSnapshots))

-        {

-            warning("snapshots not currently supported in release build")

-            oldArgs$nSnapshots <- NULL

-            oldArgs$sampleSnapshots <- NULL

-            oldArgs$numSnapshots <- NULL

-        }

-        if (!is.null(oldArgs$fixedPatterns))

-            stop("pass fixed matrix in with 'fixedMatrix' argument")

-        if (!is.null(oldArgs$S))

-            stop("pass uncertainty matrix in with 'uncertainty', not 'S'")

+    object <- helper("nFactor", object, "nPatterns")

+    object <- helper("nIter", object, "nIterations")

+    object <- helper("nEquil", object, "nIterations")

+    object <- helper("nSample", object, "nIterations")

+    object <- helper("nOutR", object, "outputFrequency")

+    object <- helper("nOutput", object, "outputFrequency")

+    object <- helper("maxGibbmassA", object, "maxGibbsMassA")

+    object <- helper("max_gibbmass_paraA", object, "maxGibbsMassA")

+    object <- helper("maxGibbmassP", object, "maxGibbsMassP")

+    object <- helper("max_gibbmass_paraP", object, "maxGibbsMassP")

+    object <- helper("singleCellRNASeq", object, "singleCell")

-        return(object)

+    if (!is.null(oldArgs$nSnapshots) | !is.null(oldArgs$sampleSnapshots) | !is.null(oldArgs$numSnapshots))

+    {

+        warning("snapshots not currently supported in release build")

+        oldArgs$nSnapshots <- NULL

+        oldArgs$sampleSnapshots <- NULL

+        oldArgs$numSnapshots <- NULL

     }

-)

+    if (!is.null(oldArgs$fixedPatterns))

+        stop("pass fixed matrix in with 'fixedMatrix' argument")

+    if (!is.null(oldArgs$S))

+        stop("pass uncertainty matrix in with 'uncertainty', not 'S'")

+

+    return(object)

+})

 #' @rdname parseDirectParams-methods

 #' @aliases parseDirectParams

 setMethod("parseDirectParams", signature(object="CogapsParams"),

-    function(object, args)

+function(object, args)

+{

+    for (s in slotNames(object))

     {

-        for (s in slotNames(object))

+        if (!is.null(args[[s]]))

         {

-            if (!is.null(args[[s]]))

-            {

-                object <- setParam(object, s, args[[s]])

-            }

+            object <- setParam(object, s, args[[s]])

         }

-        return(object)

     }

-)

\ No newline at end of file

+    return(object)

+})

+

+setMethod("show", signature("CogapsParams"),

+function(object)

+{

+    cat("An Object of class \"CogapsParams\"\n")

+    cat("nPatterns          ", object@nPatterns, "\n")

+    cat("nIterations        ", object@nIterations, "\n")

+    cat("outputFrequency    ", object@outputFrequency, "\n")

+    cat("nCores             ", object@nCores, "\n")

+    cat("singleCell         ", object@singleCell, "\n")

+    cat("seed               ", object@seed, "\n")

+    cat("messages           ", object@messages, "\n")

+    cat("checkpointInterval ", object@checkpointInterval, "\n")

+    cat("checkpointOutFile  ", object@checkpointOutFile, "\n")

+})

\ No newline at end of file

@@ -2,65 +2,491 @@

 #' @export

 #'

 #' @description Contains all output from Cogaps run

-setClass("CogapsResult", slots=c(

-    Amean = "matrix",

-    Asd = "matrix",

-    Pmean = "matrix",

-    Psd = "matrix",

-    seed = "numeric",

-    meanChiSq = "numeric",

-    diagnostics = "list"

-))

+#' @importClassesFrom S4Vectors DataFrame Annotated character_OR_NULL

+setClass("CogapsResult", contains="Annotated", slots=c(

+    sampleFactors = "ANY",      # Pmean transpose

+    featureLoadings = "ANY",    # Amean

+    featureStdDev = "ANY",      # Asd

+    sampleStdDev = "ANY",       # Psd

+    NAMES = "character_OR_NULL",

+    factorData = "DataFrame"),

+)

 #' Constructor for CogapsResult

 #' @return initialized CogapsResult object

 #' @importFrom methods callNextMethod

 setMethod("initialize", "CogapsResult",

-function(.Object, ...)

+function(.Object, Amean, Pmean, Asd, Psd, seed, meanChiSq, diagnostics, ...)

 {

+    .Object@featureLoadings <- Amean

+    .Object@sampleFactors <- t(Pmean)

+

+    if (!is.null(Asd))

+        .Object@featureStdDev <- Asd

+    if (!is.null(Psd))

+        .Object@sampleStdDev <- t(Psd)

+

+    .Object@metadata[["seed"]] <- seed

+    .Object@metadata[["meanChiSq"]] <- meanChiSq

+    .Object@metadata[["diagnostics"]] <- diagnostics

+

     .Object <- callNextMethod(.Object, ...)

     .Object

 })

+setValidity("CogapsResult",

+    function(object)

+    {

+        if (sum(object@featureLoadings < 0) > 0 | sum(object@featureStdDev < 0) > 0)

+            "fatal error - negative values in feature x factor Matrix"

+        if (sum(object@sampleFactors < 0) > 0 | sum(object@sampleStdDev < 0) > 0)

+            "fatal error - negative values in factor x sample Matrix"

+    }

+)    

+

+################################### GENERICS ###################################

+

+#' return chi-sq of final matrices

+#' @export

+#' @docType methods

+#' @rdname getMeanChiSq-methods

+#'

+#' @param object an object of type CogapsResult

+#' @return chi-sq error

+#' data(SimpSim)

+#' result <- CoGAPS(SimpSim.D)

+#' meanChiSq(result)

+setGeneric("getMeanChiSq", function(object)

+    {standardGeneric("getMeanChiSq")})

+

+#' compute z-score matrix

+#' @export

+#' @docType methods

+#' @rdname calcZ-methods

+#'

+#' @description calculates the Z-score for each element based on input mean

+#' and standard deviation matrices

+#' @param object an object of type CogapsResult

+#' @param which either "feature" or "sample" indicating which matrix to

+#' calculate the z-score for

+#' @return matrix of z-scores

+#' @examples

+#' data(SimpSim)

+#' result <- CoGAPS(SimpSim.D)

+#' feature_zscore <- calcZ(result)

+setGeneric("calcZ", function(object, which="feature")

+    {standardGeneric("calcZ")})

+

+#' reconstruct gene

+#' @export

+#' @docType methods

+#' @rdname reconstructGene-methods

+#'

+#' @param object an object of type CogapsResult

+#' @param genes an index of the gene or genes of interest

+#' @return the D' estimate of a gene or set of genes

+#' @examples

+#' data(SimpSim)

+#' result <- CoGAPS(SimpSim.D)

+#' D_estimate <- reconstructGene(result)

+setGeneric("reconstructGene", function(object, genes=NULL)

+    {standardGeneric("reconstructGene")})

+

+#' binary heatmap for standardized feature matrix

+#' @export

+#' @docType methods

+#' @rdname binaryA-methods

+#'

+#' @description creates a binarized heatmap of the A matrix

+#' in which the value is 1 if the value in Amean is greater than

+#' threshold * Asd and 0 otherwise

+#' @param object an object of type CogapsResult

+#' @param threshold the number of standard deviations above zero

+#' that an element of Amean must be to get a value of 1

+#' @return plots a heatmap of the A Matrix

+#' @examples

+#' data(SimpSim)

+#' result <- CoGAPS(SimpSim.D)

+#' binMatrix <- binaryA(result, threshold=3)

+setGeneric("binaryA", function(object, threshold=3)

+    {standardGeneric("binaryA")})

+

+#' plot of residuals

+#' @export

+#' @docType methods

+#' @rdname plotResiduals-methods

+#'

+#' @description calculate residuals and produce heatmap

+#' @param object an object of type CogapsResult

+#' @param data original data matrix run through GAPS

+#' @param uncertainty original standard deviation matrix run through GAPS

+#' @return creates a residual plot

+#' @examples

+#' data(SimpSim)

+#' result <- CoGAPS(SimpSim.D)

+#' plotResiduals(result, SimpSim.D)

+setGeneric("plotResiduals", function(object, data, uncertainty=NULL)

+    {standardGeneric("plotResiduals")})

+

+#' calculate gene set statistics

+#' @export

+#' @docType methods

+#' @rdname calcCoGAPSStat-methods

+#'

+#' @description calculates the gene set statistics for each

+#' column of A using a Z-score from the elements of the A matrix,

+#' the input gene set, and permutation tests

+#' @param object an object of type CogapsResult

+#' @param GStoGenes data.frame or list with gene sets

+#' @param numPerm number of permutations for null

+#' @return gene set statistics for each column of A

+#' @examples

+#' data('SimpSim')

+#' result <- CoGAPS(SimpSim.D)

+#' calcCoGAPSStat(result, GStoGenes=GSets, numPerm=500)

+setGeneric("calcCoGAPSStat", function(object, GStoGenes, numPerm=500)

+    {standardGeneric("calcCoGAPSStat")})

+

+#' probability gene belongs in gene set

+#' @export

+#' @docType methods

+#' @rdname calcGeneGSStat-methods

+#'

+#' @description calculates the probability that a gene

+#' listed in a gene set behaves like other genes in the set within

+#' the given data set

+#' @param object an object of type CogapsResult

+#' @param GSGenes data.frame or list with gene sets

+#' @param numPerm number of permutations for null

+#' @param Pw weight on genes

+#' @param nullGenes logical indicating gene adjustment

+#' @return gene similiarity statistic

+#' @examples

+#' data(SimpSim)

+#' result <- CoGAPS(SimpSim.D)

+#' calcGeneGSStat(result, GSGenes=GSets[[1]], numPerm=500)

+setGeneric("calcGeneGSStat", function(object, GStoGenes, numPerm,

+Pw=rep(1,ncol(Amean)), nullGenes=FALSE)

+    {standardGeneric("calcGeneGSStat")})

+

+#' compute gene probability

+#' @export

+#' @docType methods

+#' @rdname computeGeneGSProb-methods

+#'

+#' @description Computes the p-value for gene set membership using the CoGAPS-based

+#' statistics developed in Fertig et al. (2012).  This statistic refines set

+#' membership for each candidate gene in a set specified in \code{GSGenes} by

+#' comparing the inferred activity of that gene to the average activity of the

+#' set.

+#' @param object an object of type CogapsResult

+#' @param GSGenes data.frame or list with gene sets

+#' @param Pw weight on genes

+#' @param numPerm number of permutations for null

+#' @param PwNull - logical indicating gene adjustment

+#' @return A vector of length GSGenes containing the p-values of set membership

+#' for each gene containined in the set specified in GSGenes.

+#' @examples

+#' data(SimpSim)

+#' result <- CoGAPS(SimpSim.D)

+#' computeGeneGSProb(result, GSGenes=GSets[[1]], numPerm=500)

+setGeneric("computeGeneGSProb", function(object, GStoGenes, numPerm=500,

+Pw=rep(1,ncol(Amean)), PwNull=FALSE)

+    {standardGeneric("computeGeneGSProb")})

+

+################################## METHODS #####################################

+

 setMethod("show", signature("CogapsResult"),

 function(object)

 {

-    nGenes <- nrow(object@Amean)

-    nPatterns <- ncol(object@Amean)

-    nSamples <- ncol(object@Pmean)

+    nFeatures <- nrow(object@featureLoadings)

+    nSamples <- nrow(object@sampleFactors)

+    nPatterns <- ncol(object@featureLoadings)

-    print(paste("CogapsResult object with", nGenes, "genes and", nSamples, "samples"))

+    print(paste("CogapsResult object with", nFeatures, "features and", nSamples,

+        "samples"))

     print(paste(nPatterns, "patterns were learned"))

 })

-setMethod('plot', signature(x='CogapsResult'),

-function(x)

+#' @export

+#' @importFrom graphics plot

+plot.CogapsResult <- function(object, ...)

 {

-    colors <- rainbow(nrow(object@Pmean))

-    xlimits <- c(0, ncol(object@Pmean) + 1)

-    ylimits <- c(0, (max(object@Pmean) * 1.05))

+    nSamples <- nrow(object@sampleFactors)

+    nFactors <- ncol(object@sampleFactors)

+    colors <- rainbow(nFactors)

+    xlimits <- c(0, nSamples + 1)

+    ylimits <- c(0, max(object@sampleFactors) * 1.1)

     plot(NULL, xlim=xlimits, ylim=ylimits, ylab="Relative Amplitude")

-    for (i in 1:nrow(object@Pmean))

+    for (i in 1:nFactors)

     {

-        lines(x=1:ncol(object@Pmean), y=object@Pmean[i,], col=colors[i])

-        points(x=1:ncol(object@Pmean), y=object@Pmean[i,], col=colors[i], pch=i)

+        lines(x=1:nSamples, y=object@sampleFactors[,i], col=colors[i])

+        points(x=1:nSamples, y=object@sampleFactors[,i], col=colors[i], pch=i)

     }

-    legend("bottom", paste("Pattern", 1:nrow(object@Pmean), sep = ""),

-    pch = 1:nrow(object@Pmean), lty=1, cex=0.8, col=colors, bty="y", ncol=5)