@@ -17,24 +17,12 @@ Depends:

     R (>= 3.4.0),

     Rcpp (>= 0.11.0)

 Imports:

-    RColorBrewer (>= 1.0.5),

-    gplots (>= 2.8.0),

-    graphics,

-    grDevices,

     methods,

-    cluster,

-    shiny,

-    stats,

-    utils,

-    doParallel,

-    foreach,

-    ggplot2,

-    reshape2,

-    SingleCellExperiment,

-    SummarizedExperiment

+    gplots,

+    graphics,

+    S4Vectors

 Suggests:

     testthat,

-    lintr,

     knitr,

     rmarkdown,

     BiocStyle

@@ -49,21 +37,9 @@ RoxygenNote: 5.0.1

 Collate:

     'class-CogapsParams.R'

     'CoGAPS.R'

-    'GWCoGAPS.R'

+    'DistributedCogaps.R'

+    'Package.R'

     'RcppExports.R'

-    'cellMatchR.R'

     'class-CogapsResult.R'

-    'createGWCoGAPSSets.R'

-    'createscCoGAPSSets.R'

-    'distributedCogaps.R'

-    'generateSeeds.R'

-    'package.R'

-    'patternMarkers.R'

-    'patternMatch4Parallel.R'

-    'patternMatcher.R'

-    'plotPatternMarkers.R'

-    'postFixed4Parallel.R'

-    'postFixed4SC.R'

-    'reOrderBySet.R'

-    'reorderByPatternMatch.R'

-    'scCoGAPS.R'

+    'methods-CogapsParams.R'

+    'methods-CogapsResult.R'

@@ -1,79 +1,28 @@

 # Generated by roxygen2: do not edit by hand

 export(CoGAPS)

-export(GWCoGAPS)

-export(GWCoGapsFromCheckpoint)

 export(binaryA)

 export(buildReport)

 export(calcCoGAPSStat)

 export(calcGeneGSStat)

 export(calcZ)

-export(cellMatchR)

 export(computeGeneGSProb)

-export(createGWCoGAPSSets)

-export(createscCoGAPSSets)

 export(getMeanChiSq)

 export(getParam)

 export(patternMarkers)

 export(patternMatch)

-export(patternMatch4Parallel)

 export(plot.CogapsResult)

+export(plotPatternMarkers)

 export(plotResiduals)

 export(reconstructGene)

-export(scCoGAPS)

 export(setParam)

 exportClasses(CogapsParams)

 exportClasses(CogapsResult)

-import(doParallel)

-import(foreach)

-import(ggplot2)

-import(shiny)

 importClassesFrom(S4Vectors,Annotated)

 importClassesFrom(S4Vectors,DataFrame)

 importClassesFrom(S4Vectors,character_OR_NULL)

-importFrom(RColorBrewer,brewer.pal)

-importFrom(Rcpp,evalCpp)

-importFrom(cluster,agnes)

-importFrom(gplots,heatmap.2)

-importFrom(gplots,plotCI)

-importFrom(grDevices,colorRampPalette)

-importFrom(grDevices,dev.new)

-importFrom(grDevices,dev.off)

-importFrom(grDevices,pdf)

-importFrom(grDevices,rainbow)

-importFrom(graphics,abline)

-importFrom(graphics,close.screen)

-importFrom(graphics,hist)

-importFrom(graphics,legend)

-importFrom(graphics,lines)

-importFrom(graphics,matplot)

-importFrom(graphics,mtext)

-importFrom(graphics,par)

+importFrom(gplots,bluered)

 importFrom(graphics,plot)

-importFrom(graphics,points)

-importFrom(graphics,screen)

-importFrom(graphics,split.screen)

-importFrom(graphics,title)

 importFrom(methods,callNextMethod)

-importFrom(methods,is)

 importFrom(methods,new)

-importFrom(reshape2,melt)

-importFrom(stats,D)

-importFrom(stats,as.dist)

-importFrom(stats,as.hclust)

-importFrom(stats,complete.cases)

-importFrom(stats,cor)

-importFrom(stats,cutree)

-importFrom(stats,hclust)

-importFrom(stats,heatmap)

-importFrom(stats,loess)

-importFrom(stats,runif)

-importFrom(stats,sd)

-importFrom(stats,update)

-importFrom(stats,variable.names)

-importFrom(stats,weighted.mean)

-importFrom(utils,file_test)

-importFrom(utils,read.table)

-importFrom(utils,str)

-importFrom(utils,write.table)

 useDynLib(CoGAPS)

similarity index 93%

rename from R/distributedCogaps.R

rename to R/DistributedCogaps.R

@@ -127,7 +127,7 @@ patternMatch <- function(allPatterns, allParams)

         indx <- which(sapply(cc$PatsByClust, function(x) ncol(x) > allParams$gaps@maxNS))

     }

-    # created matrix of mean patterns - weighted by R closeness of fit

+    # create matrix of mean patterns - weighted by coefficient of determination

     PatsByCDSWavg <- t(sapply(1:length(cc$PatsByClust), function(z)

         apply(cc$PatsByClust[[z]], 1, function(x) weighted.mean(x, (cc$RtoMeanPattern[[z]])^3))))

     rownames(PatsByCDSWavg) <- lapply(1:length(cc$PatsByClust), function(x) paste("Pattern", x))

@@ -137,13 +137,15 @@ patternMatch <- function(allPatterns, allParams)

     return(apply(PatsByCDSWavg, 1, function(row) row / max(row)))

 }

+#' @importFrom cluster agnes

+#' @importFrom stats cutree as.hclust

 corcut <- function(allPatterns, allParams)

 {

     corr.dist <- cor(allPatterns)

     corr.dist <- 1 - corr.dist

-    clust <- agnes(x=corr.dist, diss=TRUE, "complete")

-    patternIds <- cutree(as.hclust(clust), k=allParams$gaps@cut)

+    clust <- cluster::agnes(x=corr.dist, diss=TRUE, "complete")

+    patternIds <- stats::cutree(stats::as.hclust(clust), k=allParams$gaps@cut)

     RtoMeanPattern <- list()

     PatsByClust <- list()

deleted file mode 100644

@@ -1,238 +0,0 @@

-#' GWCoGAPS

-#'

-#' @details calls the C++ MCMC code and performs Bayesian

-#' matrix factorization returning the two matrices that reconstruct

-#' the data matrix for whole genome data;

-#' @param simulationName name of this simulation

-#' @param nFactor number of patterns (basis vectors, metagenes), which must be

-#' greater than or equal to the number of rows of FP

-#' @param nCores number of cores for parallelization. If left to the default NA, nCores = nSets.

-#' @param cut number of branches at which to cut dendrogram used in patternMatch4Parallel

-#' @param minNS minimum of individual set contributions a cluster must contain

-#' @param manualMatch logical indicating whether or not to stop after initial phase for manual pattern matching

-#' @param consensusPatterns fixed pattern matrix to be used to ensure reciprocity of A weights accross sets 

-#' @param ... additional parameters to be fed into \code{gapsRun} and \code{gapsMapRun}

-#' @return list of A and P estimates

-#' @seealso \code{\link{gapsRun}}, \code{\link{patternMatch4Parallel}}, and \code{\link{gapsMapRun}}

-#' @examples

-#' data(SimpSim)

-#' sim_name <- "example"

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

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

-#' @export

-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")

-    }

-

-    if (is.null(consensusPatterns))

-    {

-        allDataSets <- preInitialPhase(simulationName, nCores)

-        unmatchedPatterns <- runInitialPhase(simulationName, allDataSets, nFactor, ...)

-        if (saveUnmatchedPatterns)

-        {

-            save(unmatchedPatterns, file=paste(simulationName, "_unmatched_patterns.RData"))

-        }

-        if (manualMatch)

-        {

-            saveRDS(unmatchedPatterns,file=paste(simulationName,"_initial.rds", sep=""))

-            stop("Please provide consensus patterns upon restarting.")

-        }

-        matchedPatternSets <- postInitialPhase(unmatchedPatterns, length(allDataSets), cut, minNS)

-        save(matchedPatternSets, file=paste(simulationName, "_matched_ps.RData", sep=""))

-        consensusPatterns <- matchedPatternSets[[1]]

-    } 

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

-    return(postFinalPhase(finalResult, consensusPatterns))

-}

-

-#' Restart a GWCoGaps Run from Checkpoint

-#'

-#' @inheritParams GWCoGAPS

-#' @return list of A and P estimates

-#' @importFrom utils file_test

-#' @examples

-#' data(SimpSim)

-#' sim_name <- "example"

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

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

-#' result <- GWCoGapsFromCheckpoint(sim_name, 2)

-#' @export

-GWCoGapsFromCheckpoint <- function(simulationName, nCores, cut=NA, minNS=NA, ...)

-{

-    # find data files

-    allDataSets <- preInitialPhase(simulationName, nCores)

-

-    # figure out phase from file signature

-    initialCpts <- list.files(full.names=TRUE, pattern=paste(simulationName,

-        "_initial_cpt_[0-9]+.out", sep=""))

-    finalCpts <- list.files(full.names=TRUE, pattern=paste(simulationName,

-        "_final_cpt_[0-9]+.out", sep=""))

-

-    if (length(finalCpts))

-    {

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

-        {

-            # load data set and shift values so gene minimum is zero

-            load(allDataSets[[i]])

-            sampleD <- sweep(sampleD, 1, apply(sampleD, 1, function(x)

-                pmin(0,min(x))))

-    

-            # run CoGAPS with fixed patterns

-            cptFileName <- paste(simulationName, "_final_cpt_", i, ".out",

-                sep="")

-            CoGapsFromCheckpoint(sampleD, sampleS, cptFileName)

-        }

-        load(paste(simulationName, "_matched_ps.RData", sep=""))

-    }

-    else if (file_test("-f", paste(simulationName, "_matched_ps.RData", sep="")))

-    {

-        load(paste(simulationName, "_matched_ps.RData", sep=""))

-        consensusPatterns<-matchedPatternSets[[1]]

-        finalResult <- runFinalPhase(simulationName, allDataSets,

-            consensusPatterns, nCores, ...)

-    }

-    else if (length(initialCpts))

-    {

-        # initial phase - always needs to be run to get matchedPatternSets

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

-        {

-            # load data set and shift values so gene minimum is zero

-            load(allDataSets[[i]])

-            sampleD <- sweep(sampleD, 1, apply(sampleD, 1, function(x)

-                pmin(0,min(x))))

-

-            # run CoGAPS from checkpoint

-            cptFileName <- paste(simulationName, "_initial_cpt_", i, ".out",

-                sep="")

-            CoGapsFromCheckpoint(sampleD, sampleS, cptFileName)

-        }

-        matchedPatternSets <- postInitialPhase(initialResult,

-            length(allDataSets), cut, minNS)

-        save(matchedPatternSets, file=paste(simulationName, "_matched_ps.RData",

-            sep=""))

-        consensusPatterns<-matchedPatternSets[[1]]

-        finalResult <- runFinalPhase(simulationName, allDataSets,

-            consensusPatterns, nCores, ...)

-    }

-    else

-    {

-        stop("no checkpoint files found")

-    }

-    return(postFinalPhase(finalResult, consensusPatterns))

-}

-

-preInitialPhase <- function(simulationName, nCores)

-{

-    # find data files

-    fileSig <- paste(simulationName, "_partition_[0-9]+.RData", sep="")

-    allDataSets <- list.files(full.names=TRUE, pattern=fileSig)

-

-    # establish the number of cores that we are able to use

-    if (is.na(nCores))

-    {

-        nCores <- length(allDataSets)

-    }

-    registerDoParallel(cores=nCores)

-    return(allDataSets)

-}

-

-runInitialPhase <- function(simulationName, allDataSets, nFactor, ...)

-{

-    #generate seeds for parallelization

-    nut <- generateSeeds(chains=length(allDataSets), seed=-1)

-

-    # run CoGAPS for each set

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

-    {

-        # load data set and shift values so gene minimum is zero

-        load(allDataSets[[i]])

-        sampleD <- sweep(sampleD, 1, apply(sampleD, 1, function(x) pmin(0,min(x))))

-

-        # run CoGAPS without any fixed patterns

-        cptFileName <- paste(simulationName, "_initial_cpt_", i, ".out", sep="")

-        CoGAPS(sampleD, uncertainty=sampleS, nFactor=nFactor, seed=nut[i],

-            checkpointFile=cptFileName)

-    }

-    return(initialResult)

-}

-

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

-{

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

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

-

-    #run postpattern match function

-    if (is.na(cut))

-    {

-        cut <- nFactor

-    }

-

-    return(patternMatch4Parallel(Ptot=BySet$P, nP=nFactor, nSets=nSets, cnt=cut,

-        minNS=minNS, bySet=TRUE))

-}

-

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

-{    

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

-    {

-        stop("consensusPatterns must be a matrix")

-    }

-

-    # find data files if providing consensus patterns

-    fileSig <- paste(simulationName, "_partition_[0-9]+.RData", sep="")

-    allDataSets <- list.files(full.names=TRUE, pattern=fileSig)

-

-    if (is.na(nCores))

-    {

-        nCores <- length(allDataSets)

-    }

-    registerDoParallel(cores=nCores)

-

-    # generate seeds for parallelization

-    nut <- generateSeeds(chains=length(allDataSets), seed=-1)

-

-    # final number of factors

-    nFactorFinal <- nrow(consensusPatterns)

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

-

-    # run fixed CoGAPS

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

-    {

-        # load data set and shift values so gene minimum is zero

-        load(allDataSets[[i]])

-        sampleD <- sweep(sampleD, 1, apply(sampleD, 1, function(x) pmin(0,min(x))))

-

-        # run CoGAPS with fixed patterns

-        cptFileName <- paste(simulationName, "_final_cpt_", i, ".out", sep="")

-        CoGAPS(sampleD, uncertainty=sampleS, fixedMatrix=consensusPatterns,

-            nFactor=nFactorFinal, seed=nut[i], checkpointFile=cptFileName,

-            whichMatrixFixed='P')

-

-    }

-    return(finalResult)

-}

-

-postFinalPhase <- function(finalResult, consensusPatterns)

-{

-    Aresult <- postFixed4Parallel(finalResult, consensusPatterns)

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

-    

-    return(new("CogapsResult",

-        Amean       = Aresult$A,

-        Asd         = Aresult$Asd,

-        Pmean       = consensusPatterns,

-        Psd         = NULL,

-        seed        = 0,

-        meanChiSq   = 0,

-        diagnostics = list()

-    ))

-}

similarity index 76%

rename from R/package.R

rename to R/Package.R

@@ -21,21 +21,6 @@

 #' Bioinformatics. 2010 Nov 1;26(21):2792-3

 #' @docType package

 #' @name CoGAPS-package

-#' @importFrom Rcpp evalCpp

-#' @importFrom gplots heatmap.2 plotCI

-#' @importFrom stats variable.names sd update heatmap runif

-#' @importFrom graphics matplot title abline close.screen hist legend lines mtext par plot points screen split.screen

-#' @importFrom grDevices dev.new dev.off pdf colorRampPalette rainbow

-#' @importFrom methods is

-#' @importFrom utils read.table write.table str

-#' @importFrom RColorBrewer brewer.pal

-#' @importFrom stats cor loess as.dist cutree as.hclust complete.cases D hclust weighted.mean

-#' @import foreach

-#' @importFrom cluster agnes 

-#' @import doParallel

-#' @import shiny

-#' @importFrom reshape2 melt

-#' @import ggplot2

 #' @useDynLib CoGAPS

 NULL

deleted file mode 100644

@@ -1,125 +0,0 @@

-#' cellMatchR

-#' @export

-#'

-#' @param Atot a matrix containing the total by set estimates of Pmean output from \code{reOrderBySet}

-#' @param nSets number of parallel sets used to generate \code{Atot}

-#' @param cnt  number of branches at which to cut dendrogram

-#' @param minNS minimum of individual set contributions a cluster must contain

-#' @param maxNS maximum of individual set contributions a cluster must contain

-#' @param ignore.NA logical indicating whether or not to ignore NAs from potential over dimensionalization. Default is FALSE.

-#' @param bySet logical indicating whether to return list of matched set solutions from \code{Atot}

-#' @param plotDen plot

-#' @param ... additional parameters for \code{agnes}

-#' @return a matrix of concensus patterns by samples. If \code{bySet=TRUE} then a list of the set contributions to each

-#' concensus pattern is also returned.

-cellMatchR <- function(Atot, nSets, cnt, minNS=NA, maxNS=NA,

-ignore.NA=FALSE, bySet=FALSE, plotDen=FALSE, ...)

-{

-    if (is.na(minNS))

-    {

-        minNS <- nSets / 2

-    }

-    if (is.na(maxNS))

-    {

-        maxNS <- nSets + minNS

-    }

-    if (!ignore.NA)

-    {

-        if (anyNA(Atot))

-        {

-            warning(paste("Non-sparse matrixes produced. Reducing the number",

-                "of patterns asked for and rerun."))

-        }

-    }

-    else

-    {

-        Atot <- Atot[complete.cases(Atot),]

-    }

-

-    corcut <- function(Atot, minNS, cnt, cluster.method)

-    {

-        corr.dist <- cor(Atot)

-        corr.dist <- 1-corr.dist

-

-        clust <- agnes(x=corr.dist, diss=TRUE, cluster.method)

-        #clust=fastcluster::hclust(dist(corr.dist))

-        cut <- cutree(as.hclust(clust),k=cnt)

-

-        cls <- sort(unique(cut))

-        cMNs <- matrix(ncol=cnt,nrow=dim(Atot)[1])

-        colnames(cMNs) <- cls

-        rownames(cMNs) <- rownames(Atot)

-

-        RtoMeanPattern <- list()

-        AByClust <- list()

-        for (i in cls)

-        {

-            if (!is.null(dim(Atot[,cut == i])))

-            {

-                if (dim(Atot[,cut == i])[2] >= minNS)

-                {

-                    cMNs[,i] <- rowMeans(Atot[,cut==i])

-                    AByClust[[i]] <- Atot[,cut==i]

-                    nIN <- sum(cut==i)

-                    RtoMeanPattern[[i]] <- sapply(1:nIN, function(j) 

-                        round(cor(x=Atot[,cut==i][,j], y=cMNs[,i]),3))

-                }

-            }

-        }

-

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

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

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

-    }   

-

-    cc <- corcut(Atot, minNS, cnt, cluster.method)

-

-    ### split by maxNS

-    indx <- which(unlist(lapply(cc$AByClust, function(x) dim(x)[1] > maxNS)))

-    i <- 1

-    while (length(indx) > 0)

-    { 

-        icc <- corcut(cc$AByClust[[indx[1]]], minNS, 2, cluster.method)

-        if (length(icc[[2]]) == 0)

-        {

-            indx <- indx[-1]

-            next

-        }

-        else

-        {

-            cc$AByClust[[indx[1]]] <- icc[[2]][[1]]

-            cc$RtoMeanPattern[[indx[1]]] <- icc[[1]][[1]]

-            if (length(icc[[2]]) > 1)

-            {

-                cc$AByClust<-append(cc$AByClust,icc[[2]][2])

-                cc$RtoMeanPattern<-append(cc$RtoMeanPattern,icc[[1]][2])

-            } 

-            indx <- which(unlist(lapply(cc$AByClust,function(x) dim(x)[1]>maxNS)))

-        }

-    }

-

-    #weighted.mean(AByClustDrop[[1]],RtoMPDrop[[1]])

-    AByCDSWavg <- t(sapply(1:length(cc$AByClust), function(z)

-        apply(cc$AByClust[[z]], 1, function(x)

-            weighted.mean(x, (cc$RtoMeanPattern[[z]])^3))))

-    rownames(AByCDSWavg) <- lapply(1:length(cc$AByClust), function(x)

-        paste("Pattern",x))

-    #scale As

-    Amax <- apply(AByCDSWavg, 1, max)

-    AByCDSWavgScaled <- t(sapply(1:dim(AByCDSWavg)[1], function(x)

-        AByCDSWavg[x,] / Amax[x]))

-    rownames(AByCDSWavgScaled) <- rownames(AByCDSWavg)

-

-    if (bySet)

-    {  

-        return(list("consenusAs"=t(AByCDSWavgScaled),"ABySet"=cc))

-    }

-    else

-    {

-        return(AByCDSWavgScaled)

-    }

-}

-

-# pattern first then file name

-# dont overwrite

-# some elements are negative

\ No newline at end of file

@@ -120,95 +120,3 @@ setGeneric("parseOldParams", function(object, oldArgs)

 setGeneric("parseDirectParams", function(object, args)

     {standardGeneric("parseDirectParams")})

-#' @rdname setParam-methods

-#' @aliases setParam

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

-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)

-})

-

-#' @rdname parseOldParams-methods

-#' @aliases parseOldParams

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

-function(object, oldArgs)

-{

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

-    {

-        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)

-    }

-

-    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")

-

-    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)

-{

-    for (s in slotNames(object))

-    {

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

-        {

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

-        }

-    }

-    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")

-})

@@ -3,14 +3,10 @@

 #'

 #' @description Contains all output from Cogaps run

 #' @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"),

-)

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

+    sampleStdDev = "ANY",   # Psd transpose

+    featureStdDev = "ANY",  # Asd

+))

 #' Constructor for CogapsResult

 #' @return initialized CogapsResult object

@@ -194,369 +190,21 @@ setGeneric("computeGeneGSProb", function(object, GStoGenes, numPerm=500,

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

     {standardGeneric("computeGeneGSProb")})

-################################## METHODS #####################################

-

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

-function(object)

-{

-    nFeatures <- nrow(object@featureLoadings)

-    nSamples <- nrow(object@sampleFactors)

-    nPatterns <- ncol(object@featureLoadings)

-

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

-        "samples"))

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

-})

-

+#' compute pattern markers statistic

 #' @export

-#' @importFrom graphics plot

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

-{

-    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:nFactors)

-    {

-        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("top", paste("Pattern", 1:nFactors, sep = ""), pch = 1:nFactors,

-        lty=1, cex=0.8, col=colors, bty="y", ncol=5)

-}

-

-#' @rdname getMeanChiSq-methods

-#' @aliases getMeanChiSq

-setMethod("getMeanChiSq", signature(object="CogapsResult"),

-function(object)

-{

-    object@metadata$meanChiSq

-})

-

-#' @rdname calcZ-methods

-#' @aliases calcZ

-setMethod("calcZ", signature(object="CogapsResult"),

-function(object, which)

-{

-    if (which == "feature")

-    {

-        object@featureLoadings / object@featureStdDev

-    }

-    else if (which == "sample")

-    {

-        object@sampleFactors / object@sampleStdDev

-    }

-    else

-    {

-        stop("\"which\" must be either \"feature\" or \"sample\"")

-    }

-})

-

-#' @rdname reconstructGene-methods

-#' @aliases reconstructGene

-setMethod("reconstructGene", signature(object="CogapsResult"),

-function(object, genes)

-{

-    D <- object@featureLoadings %*% t(object@sampleFactors)

-    if (!is.null(genes))

-    {

-        D <- D[genes,]

-    }

-    return(D)

-})

-

-#' @rdname binaryA-methods

-#' @aliases binaryA

-setMethod("binaryA", signature(object="CogapsResult"),

-function(object, threshold)

-{

-    binA <- ifelse(calcZ(object) > threshold, 1, 0)

-

-    heatmap.2(binA, 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 Feature Matrix")

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

-})

-

-#' @rdname plotResiduals-methods

-#' @aliases plotResiduals

-setMethod("plotResiduals", signature(object="CogapsResult"),

-function(object, data, uncertainty)

-{

-    data <- as.matrix(data)

-    if (is.null(uncertainty))

-        uncertainty <- pmax(0.1 * data, 0.1)

-    uncertainty <- as.matrix(uncertainty)

-

-    M <- reconstructGene(object)

-    resid <- (data - M) / uncertainty

-    

-    scaledRdYlBu <- colorRampPalette(brewer.pal(9,"RdYlBu"))(100)

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

-        scale="none", col = scaledRdYlBu, trace="none", density.info="none",

-        cexCol=1.33, 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 Residuals")

-})

-

-setMethod("patternMarkers", signature(object="CogapsResult"),

-function(object, threshold="all", lp=NA, full=FALSE)

-{

-    nGenes <- nrow(object@featureLoadings)

-    nPatterns <- ncol(object@featureLoadings)

-

-    # find the A with the highest magnitude

-    Arowmax <- t(apply(object@featureLoadings, 1, function(x) x/max(x)))

-

-    if (!is.na(lp))

-    {

-        if (length(lp) != nPatterns)

-        {

-            warning("lp length must equal the number of columns of the Amatrix")

-        }

-        sstat <- apply(Arowmax, 1, function(x) sqrt(t(x-lp)%*%(x-lp)))

-        ssranks <-rank(sstat)

-        ssgenes.th <- names(sort(sstat,decreasing=FALSE,na.last=TRUE))

-    }

-    else

-    {

-        # determine which genes are most associated with each pattern

-

-        sstat <- matrix(NA, nrow=nGenes, ncol=nPatterns,

-            dimnames=dimnames(object@featureLoadings))

-        ssranks <- matrix(NA, nrow=nGenes, ncol=nPatterns,

-            dimnames=dimnames(object@featureLoadings))

-        ssgenes <- matrix(NA, nrow=nGenes, ncol=nPatterns, dimnames=NULL)

-        for (i in 1:nP)

-        {

-            lp <- rep(0,dim(Amatrix)[2])

-            lp[i] <- 1

-            sstat[,i] <- unlist(apply(Arowmax, 1, function(x) sqrt(t(x-lp)%*%(x-lp))))

-            ssranks[,i]<-rank(sstat[,i])

-            ssgenes[,i]<-names(sort(sstat[,i],decreasing=FALSE,na.last=TRUE))

-        }

-        if (threshold=="cut")

-        {

-            geneThresh <- sapply(1:nP,function(x) min(which(ssranks[ssgenes[,x],x] > apply(ssranks[ssgenes[,x],],1,min))))

-            ssgenes.th <- sapply(1:nP,function(x) ssgenes[1:geneThresh[x],x])

-        }

-        else if (threshold=="all")

-        {

-            pIndx<-unlist(apply(sstat,1,which.min))

-            gBYp <- list()

-            for(i in sort(unique(pIndx)))

-            {

-                gBYp[[i]]<-sapply(strsplit(names(pIndx[pIndx==i]),"[.]"),function(x) x[[1]][1])

-            }

-            ssgenes.th <- lapply(1:max(sort(unique(pIndx))), function(x)

-                ssgenes[which(ssgenes[,x] %in% gBYp[[x]]),x])

-        }

-        else

-        {

-            stop("Threshold arguement not viable option")

-        }

-    }

-    if (full)

-    {

-        return(list("PatternMarkers"=ssgenes.th, "PatternRanks"=ssranks,

-            "PatternMarkerScores"=sstat))

-    }

-    else