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

 Package: CoGAPS

-Version: 2.99.0

+Version: 2.7.0

 Date: 2014-08-23

 Title: Coordinated Gene Activity in Pattern Sets

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

@@ -1,16 +1,18 @@

 # Generated by roxygen2: do not edit by hand

 export(CoGAPS)

+export(CoGapsFromCheckpoint)

 export(GWCoGAPS)

 export(binaryA)

 export(calcCoGAPSStat)

 export(calcGeneGSStat)

 export(calcZ)

 export(createGWCoGAPSSets)

+export(displayBuildReport)

 export(gapsMapRun)

 export(gapsRun)

-export(gapsRunFromCheckpoint)

 export(generateSeeds)

+export(getParam)

 export(patternMarkers)

 export(patternMatch4Parallel)

 export(patternMatcher)

@@ -25,6 +27,8 @@ export(reOrderBySet)

 export(reconstructGene)

 export(reorderByPatternMatch)

 export(residuals)

+export(setParam)

+exportClasses(GapsParams)

 import(doParallel)

 import(foreach)

 import(ggplot2)

@@ -52,7 +56,12 @@ importFrom(graphics,points)

 importFrom(graphics,screen)

 importFrom(graphics,split.screen)

 importFrom(graphics,title)

+importFrom(methods,"slot<-")

+importFrom(methods,callNextMethod)

 importFrom(methods,is)

+importFrom(methods,new)

+importFrom(methods,slot)

+importFrom(methods,validObject)

 importFrom(reshape2,melt)

 importFrom(stats,D)

 importFrom(stats,as.dist)

@@ -5,39 +5,43 @@

 #'the data matrix

 #' @param D data matrix

 #' @param S uncertainty matrix (std devs for chi-squared of Log Likelihood)

-#' @param params GapsParams object 

 #' @return list with A and P matrix estimates

+#' @importFrom methods new

 #' @export

-CoGaps <- function(D, S, params = new('GapsParams', 7, 1000, 1000), ...)

+CoGAPS <- function(D, S, ...)

 {

     # process v2 style arguments for backwards compatibility

-    params <- oldParams(params, list(...))

+    extraArgs <- list(...)

+    params <- oldParams(new('GapsParams', 7, 1000, 1000), extraArgs)

     # check data

-    checkParamsWithData(params, nrow(D), ncol(D), nrow(S), ncol(S))

-    if (any(D) < 0 | any(S) < 0) # too slow for large matrices ?

+    if (missing(D) & length(extraArgs$data))

+        D <- extraArgs$data

+    if (missing(S) & length(extraArgs$unc))

+        S <- extraArgs$unc

+    if (any(D < 0) | any(S < 0))

         stop('D and S matrix must be non-negative')

+    checkParamsWithData(params, nrow(D), ncol(D), nrow(S), ncol(S))

-    # run algorithm

-    result <- cogaps_cpp(as.matrix(D), as.matrix(S), nFactor, alphaA,

-        alphaP, nEquil, floor(nEquil/10), nSample, max_gibbmass_paraA,

-        max_gibbmass_paraP, fixedPatterns, whichMatrixFixed, seed, messages,

-        singleCellRNASeq, nOutR, numSnapshots, checkpoint_interval)

+    # run algorithm with call to C++ code

+    result <- cogaps_cpp(as.matrix(D), as.matrix(S),

+        as.matrix(params$fixedPatterns), params)

     # backwards compatible with v2

-    if (length(list(...)$GStoGenes))

+    if (!is.null(extraArgs$GStoGenes))

     {

-        warning('the GStoGenes argument is depracted with v3.0,')

-        if (list(...)$plot)

+        #warning('the GStoGenes argument is deprecated with v3.0')

+        if (is.null(extraArgs$plot) | extraArgs$plot)

             plotGAPS(result$Amean, result$Pmean)

-        GSP <- calcCoGAPSStat(result$Amean, result$Asd, list(...)$GStoGenes,

-            list(...)$nPerm)

+        if (is.null(extraArgs$nPerm))

+            extraArgs$nPerm <- 500

+        GSP <- calcCoGAPSStat(result$Amean, result$Asd, extraArgs$GStoGenes,

+            extraArgs$nPerm)

         result <- list(meanChi2=result$meanChi2, D=D, Sigma=S,

             Amean=result$Amean, Asd=result$Asd, Pmean=result$Pmean,

             Psd=result$Psd, GSUpreg=GSP$GSUpreg, GSDownreg=GSP$GSDownreg,

             GSActEst=GSP$GSActEst)

     }

-

     return(result)

 }

@@ -52,22 +56,33 @@ CoGaps <- function(D, S, params = new('GapsParams', 7, 1000, 1000), ...)

 #' @export

 CoGapsFromCheckpoint <- function(D, S, path)

 {

-    # TODO add checksum to make sure D,S are correct

     cogapsFromCheckpoint_cpp(D, S, path)

 }

+GWCoGapsFromCheckpoint <- function(fname)

+{

+    #TODO

+}

+

+#' Display Information About Package Compilation

+#' @export

+displayBuildReport <- function()

+{

+    displayBuildReport_cpp()

+}

+

 #' Backwards Compatibility with v2

 #'

 #' @param D data matrix

 #' @param S uncertainty matrix

 #' @param ... v2 style parameters

 #' @return list with A and P matrix estimates

+#' @importFrom methods new

 #' @export

 gapsRun <- function(D, S, ...)

 {

-    warning('gapsRun is depracated with v3.0, use CoGAPS')

-    params <- new('GapsParams', 7, 1000, 1000)

-    params <- oldParams(params, list(...))

+    #warning('gapsRun is deprecated with v3.0, use CoGAPS')

+    params <- oldParams(new('GapsParams', 7, 1000, 1000), list(...))

     CoGAPS(D, S, params)

 }

@@ -78,12 +93,12 @@ gapsRun <- function(D, S, ...)

 #' @param FP data.frame with rows giving fixed patterns for P

 #' @param ... v2 style parameters

 #' @return list with A and P matrix estimates

+#' @importFrom methods new

 #' @export

 gapsMapRun <- function(D, S, FP, ...)

 {

-    warning('gapsMapRun is depracated with v3.0, use CoGaps')

-    params <- new('GapsParams', 7, 1000, 1000)

-    params <- oldParams(params, list(...))

+    #warning('gapsMapRun is deprecated with v3.0, use CoGaps')

+    params <- oldParams(new('GapsParams', 7, 1000, 1000), list(...))

     CoGAPS(D, S, params)

 }

@@ -91,14 +106,15 @@ gapsMapRun <- function(D, S, FP, ...)

 oldParams <- function(params, args)

 {

     # standard params

-    if (length(args$nFactor))      params@nFactor    <- args$nFactor

-    if (length(args$nEquil))       params@nEquil     <- args$nEquil

-    if (length(args$nSample))      params@nSample    <- args$nSample

-    if (length(args$numSnapshots)) params@nSnapshots <- args$numSnapshots

+    if (length(args$nFactor))      params@nFactor    <- as.integer(args$nFactor)

+    if (length(args$nEquil))       params@nEquil     <- as.integer(args$nEquil)

+    if (length(args$nSample))      params@nSample    <- as.integer(args$nSample)

     if (length(args$alphaA))       params@alphaA     <- args$alphaA

     if (length(args$alphaP))       params@alphaP     <- args$alphaP

-    if (length(args$seed))         params@seed       <- args$seed

+    if (length(args$seed))         params@seed       <- as.integer(args$seed)

     if (length(args$messages))     params@messages   <- args$messages

+    if (length(args$numSnapshots))

+        params@nSnapshots <- as.integer(args$numSnapshots)

     # gapsMap params

     if (length(args$FP))

@@ -109,4 +125,4 @@ oldParams <- function(params, args)

     # return v3 style GapsParams

     return(params)    

-}

+}

\ No newline at end of file

@@ -1,43 +1,42 @@

-#' Genome Wide CoGAPS

+#' 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 D data matrix

-#' @param S uncertainty matrix (std devs for chi-squared of Log Likelihood)

-#' @param params GapsParams object 

-#' @param nSets number of sets for parallelization

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

-#' @param saveBySetResults logical indicating whether to save by intermediary by set results. Default is FALSE.

-#' @param fname character string used to label file output. Default is "GWCoGAPS.AP.fixed"

-#' @param PatternsMatchFN function to use for pattern matching across sets

-#' @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 ... additional parameters to be fed into \code{gapsRun} and \code{gapsMapRun}

-#' @export

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

+#'\code{GWCoGAPS} calls the C++ MCMC code and performs Bayesian

+#'matrix factorization returning the two matrices that reconstruct

+#'the data matrix for whole genome data;

+#'

+#'@param D data matrix

+#'@param S uncertainty matrix (std devs for chi-squared of Log Likelihood)

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

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

+#'@param nSets number of sets for parallelization

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

+#'@param saveBySetResults logical indicating whether to save by intermediary by set results. Default is FALSE.

+#'@param fname character string used to label file output. Default is "GWCoGAPS.AP.fixed"

+#'@param PatternsMatchFN function to use for pattern matching across sets

+#'@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 ... additional parameters to be fed into \code{gapsRun} and \code{gapsMapRun}

+#'@export

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

 #' @examples \dontrun{

 #' GWCoGAPS(nCores=NA, D, S, nFactor, nSets,saveBySetResults=TRUE, fname=fname,

 #' PatternsMatchFN = patternMatch4Parallel,numSnapshots=numSnapshots,minNS=minNS)

 #' }

 #'

-GWCoGAPS <- function(D, S, params, nSets, nCores=NA, saveBySetResults=FALSE,

+GWCoGAPS <- function(D, S, nFactor, nSets, nCores=NA, saveBySetResults=FALSE,

 fname="GWCoGAPS.AP.fixed", PatternsMatchFN = patternMatch4Parallel, Cut=NA,

 minNS=NA, ...)

 {

-    # v2 style parameters compatibility

-    params <- oldParams(params, ...)

-

     # establish the number of cores that you are able to use

     if(is.na(nCores))

-        nCores <- nSets

+        nCores<-nSets

     registerDoParallel(cores=nCores)

     # break the data into sets

     genesInSets <- createGWCoGAPSSets(data=D, nSets=nSets, keep=FALSE)

     # set gene min to 0

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

+    D <- sweep(D, 1, apply(D,1,function(x){pmin(0,min(x))}))

     #generate seeds for parallelization

     nut <- generateSeeds(chains=nSets, seed=-1)

@@ -47,15 +46,14 @@ minNS=NA, ...)

     {

         D <- as.matrix(D[genesInSets[[i]],])

         S <- as.matrix(S[genesInSets[[i]],])

-        params <- setParam(params, 'seed', nut[i])

-        CoGAPS(D=D, S=S, params)

+        gapsRun(D=D, S=S, nFactor=nFactor,seed=nut[i],...)

     }

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

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

     #run postpattern match function

     if (is.na(Cut))

-        Cut <- nFactor

+        Cut<-nFactor

     matchedPs <- patternMatch4Parallel(Ptot=BySet$P, nP=nFactor, nSets=nSets,

         cnt=Cut, minNS=minNS, bySet=TRUE)

@@ -63,29 +61,27 @@ minNS=NA, ...)

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

     if (saveBySetResults==TRUE)

     {

-        save(AP,BySet,matchedPs,file=sprintf('APbySet.%s.nP%d.set%d.Rda',fname, nFactor,nSets))

+        save(AP, BySet, matchedPs, file=sprintf('APbySet.%s.nP%d.set%d.Rda',

+            fname, nFactor, nSets))

         message(sprintf('APbySet.%s.nP%d.set%d.Rda',fname, nFactor,nSets))

     }

     PbySet <- matchedPs[["PBySet"]]

     matchedPs <- matchedPs[[1]]

-    # generate seeds for parallelization

+    #generate seeds for parallelization

     nut <- generateSeeds(chains=nSets, seed=-1)

-    # final number of factors

+    #final number of factors

     nFactorFinal <- dim(matchedPs)[1]

     # run fixed CoGAPS

-    params <- setParam('fixedMatrix', as.matrix(matchedPs))

-    params <- setParam('whichMatrixFixed', 'P')

-    params <- setParam('nFactor', nFactorFinal)

     Fixed <- foreach(i=1:nSets) %dopar%

     {

-    	D <- as.matrix(D[genesInSets[[i]],])

-    	S <- as.matrix(S[genesInSets[[i]],])

-        params <- setParam(params, 'seed', nut[i])

-        CoGAPS(D=D, S=S, params)

+        D <- as.matrix(D[genesInSets[[i]],])

+        S <- as.matrix(S[genesInSets[[i]],])

+        AP <- gapsMapRun(D, S, FP=matchedPs, nFactor=nFactorFinal,

+            fixedMatrix = "P",seed=nut[i],...)

     }

     #extract A and Asds

@@ -95,120 +91,6 @@ minNS=NA, ...)

     AP.fixed <- list("Amean"=As4fixPs$A, "Asd"=As4fixPs$Asd, "Pmean"=matchedPs,

         "PbySet"=PbySet)

     class(AP.fixed) <- append(class(AP.fixed),"CoGAPS")

-    save(AP.fixed, file=paste(fname, ".Rda", sep=""))

-    message(paste(fname, ".Rda", sep=""))

-}

-

-#' Create Gene Sets for GWCoGAPS

-#'

-#'\code{createGWCoGAPSSets} factors whole genome data into randomly generated sets for indexing;

-#'

-#'@param data data matrix with unique rownames

-#'@param nSets number of sets for parallelization

-#'@param outRDA name of output file

-#'@param keep logical indicating whether or not to save gene set list. Default is TRUE.

-#'@export

-#'@return list with randomly generated sets of genes from whole genome data

-#'@examples \dontrun{

-#'createGWCoGAPSSet(D,nSets=nSets)

-#'}

-createGWCoGAPSSets <- function(data, nSets, outRDA="GenesInCoGAPSSets.Rda",

-keep=TRUE)

-{

-    genes <- rownames(data)

-    setSize <- floor(length(genes) / nSets)

-    genesInSets <- list()

-    for (set in 1:nSets)

-    {

-        if (set != nSets)

-            genesInSets[[set]] <- sample(genes,setSize)

-        if (set == nSets)

-            genesInSets[[set]] <- genes

-        genes <- genes[!genes %in% genesInSets[[set]]]

-    }

-

-    if (!identical(sort(unlist(genesInSets)),sort(rownames(data))))

-        warning("Gene identifiers not unique!")

-    if (keep == TRUE)

-        save(list=c('genesInSets'), file=outRDA)

-    return(genesInSets)

-}

-

-#' Generate Seeds for Multiple Concurrent Runs

-#'

-#' @param chains number of seeds to generate (number of chains to run)

-#' @param seed positive values are kept, negative values will be overwritten

-#'  by a seed generated from the current time

-#' @return vector of randomly generated seeds

-#' @export

-#' @examples

-#' generateSeeds(chains=2, seed=-1)

-generateSeeds <- function(chains=2, seed=-1)

-{

-    if (chains < 2 | (as.integer(chains) != chains))

-        stop("chains must be >= 2 and an integer")

-

-    if (seed < 0)

-    {

-        secs <- as.numeric(difftime(Sys.time(), paste(Sys.Date(), "00:00"),

-            units="secs"))

-        return(seq_len(chains) * round(secs))

-    }

-    else

-    {

-        return(seq_len(chains) * seed)

-    }

-}

-

-#' reOrderBySet

-#'

-#' @description <restructures output of gapsRun into a list containing each sets solution for Amean, Pmean, and Asd>

-#' @param AP output of gapsRun in parallel

-#' @param nFactor number of patterns

-#' @param nSets number of sets

-#'

-#' @return a list containing the \code{nSets} sets solution for Amean under "A", Pmean under "P", and Asd under "Asd"

-#' @export

-#'

-#' @examples \dontrun{

-#' reOrderBySet(AP,nFactor,nSets)

-#' }

-#'

-reOrderBySet<-function(AP, nFactor, nSets)

-{

-    P <- do.call(rbind,lapply(AP, function(x) x$Pmean))

-    rownames(P) <- paste(rep(1:nSets,each=nFactor),rep(1:nFactor,nSets),sep=".")

-    A <- lapply(AP, function(x) x$Amean)

-    Asd <- lapply(AP, function(x) x$Asd)

-    names(A) <- names(Asd) <- paste(rep("Set", nSets), rep(1:nSets), sep="")

-    return(list("A"=A, "Asd"=Asd, "P"=P))

-}

-

-#' postFixed4Parallel

-#'

-#' @param AP.fixed output of parallel gapsMapRun calls with same FP

-#' @param setPs data.frame with rows giving fixed patterns for P used as input for gapsMapRun

-#'

-#' @return list of two data.frames containing the A matrix estimates or their corresponding standard deviations

-#' from output of parallel gapsMapRun

-#' @export

-postFixed4Parallel <- function(AP.fixed=NA, setPs=NA)

-{

-    ASummary <- do.call(rbind,lapply(AP.fixed, function(x) x$Amean))

-    Asd <- do.call(rbind,lapply(AP.fixed, function(x) x$Asd))

-    #PSummary <- do.call(rbind,lapply(AP.fixed, function(x) x$Pmean))

-    PSummary <- AP.fixed[[1]]$Pmean

-

-    Pmax <- apply(PSummary,1,max)

-    Pneu <- sweep(PSummary,1,Pmax,FUN="/")

-    Aneu <- sweep(ASummary,2,Pmax,FUN="*")

-

-    X <- apply(Pneu,1,range)

-    Y <- apply(setPs,1,range)

-    colnames(X) <- colnames(Y)

-    if (!all.equal(X, Y, tolerance=1e-5))

-        warning("Patterns do not match fixed values.")

-

-    As4fixPs <- list("A"=Aneu, "Asd"=Asd)

-    return(As4fixPs)

-}

+    save(AP.fixed, file=paste(fname,".Rda",sep=""))

+    message(paste(fname,".Rda",sep=""))

+}

\ No newline at end of file

@@ -1,12 +1,16 @@

 # Generated by using Rcpp::compileAttributes() -> do not edit by hand

 # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393

-cogaps <- function(DMatrix, SMatrix, nFactor, alphaA, alphaP, nEquil, nEquilCool, nSample, maxGibbsMassA, maxGibbsMassP, fixedPatterns, whichMatrixFixed, seed, messages, singleCellRNASeq, numOutputs, numSnapshots, checkpointInterval) {

-    .Call('_CoGAPS_cogaps', PACKAGE = 'CoGAPS', DMatrix, SMatrix, nFactor, alphaA, alphaP, nEquil, nEquilCool, nSample, maxGibbsMassA, maxGibbsMassP, fixedPatterns, whichMatrixFixed, seed, messages, singleCellRNASeq, numOutputs, numSnapshots, checkpointInterval)

+cogaps_cpp <- function(DMatrix, SMatrix, fixedPatterns, params) {

+    .Call('_CoGAPS_cogaps_cpp', PACKAGE = 'CoGAPS', DMatrix, SMatrix, fixedPatterns, params)

 }

-cogapsFromCheckpoint <- function(fileName) {

-    .Call('_CoGAPS_cogapsFromCheckpoint', PACKAGE = 'CoGAPS', fileName)

+cogapsFromCheckpoint_cpp <- function(D, S, fileName) {

+    .Call('_CoGAPS_cogapsFromCheckpoint_cpp', PACKAGE = 'CoGAPS', D, S, fileName)

+}

+

+displayBuildReport_cpp <- function() {

+    invisible(.Call('_CoGAPS_displayBuildReport_cpp', PACKAGE = 'CoGAPS'))

 }

 run_catch_unit_tests <- function() {

new file mode 100644

@@ -0,0 +1,24 @@

+#' 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

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

+}

\ No newline at end of file

new file mode 100644

@@ -0,0 +1,127 @@

+#' 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

+#' @export

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

+{

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

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

+    {

+        #temp <- min(Asd[Asd>0])

+        Asd[Asd==0] <- .Machine$double.eps

+    }

+

+    # calculate Z scores

+    zMatrix <- calcZ(Amean,Asd)

+

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

+    {

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

+        GStoGenes <- GStoGenes$genesets

+    }

+    else if (is(GStoGenes, "list"))

+    {

+        GStoGenesList <- GStoGenes

+    }

+    else if (is(GStoGenes, "data.frame"))

+    {

+        GStoGenesList <- list()

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

+        {

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

+                as.character(unique(GStoGenes[,i]))

+        }

+    }

+    else

+    {

+        stop(paste("GStoGenes must be a data.frame, GSA.genesets, or list with",

+            "format specified in the users manual."))

+    }

+

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

+}

\ No newline at end of file

new file mode 100644

@@ -0,0 +1,80 @@

+#' 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

+#' @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) < .Machine$double.eps)] <- 0

+

+    if (sum(gsStat) < .Machine$double.eps)

+    {

+        return(0)

+    }

+    return(outStats)

+}

+

+#' Compute Gene Probability

+#'

+#' @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

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

+}

new file mode 100644

@@ -0,0 +1,32 @@

+#' 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

+#' @export

+calcZ <- function(meanMat, sdMat)

+{

+    # find matrix dimensions

+    nrows <- dim(meanMat)[1]

+    ncols <- dim(meanMat)[2]

+

+    check <- dim(sdMat)[1]

+    if (nrows != check)

+    {

+        stop("Number of rows in the mean and standard deviation of A do not agree.")

+    }

+

+    check <- dim(sdMat)[2]

+    if (ncols != check)

+    {

+        stop("Number of columns in the mean and standard deviation of A do not agree.")

+    }

+

+    # compute the matrix of z scores

+    zMat <- meanMat/sdMat

+    rownames(zMat) <- rownames(meanMat)

+    colnames(zMat) <- colnames(meanMat)

+

+    return(zMat)

+}

\ No newline at end of file

@@ -23,40 +23,44 @@

 setClass('GapsParams', slots = c(

     nFactor = 'integer',

     nEquil = 'integer',

+    nEquilCool = 'integer',

     nSample = 'integer',

     nOutput = 'integer',

     nSnapshots = 'integer',

-    alphaA  = 'numeric',

-    alphaP  = 'numeric',

+    alphaA = 'numeric',

+    alphaP = 'numeric',

     maxGibbmassA = 'numeric',

     maxGibbmassP = 'numeric',

     seed = 'integer',

     messages  = 'logical',

-    singleCelLRNASeq = 'logical',

+    singleCellRNASeq = 'logical',

     fixedPatterns = 'matrix',

     whichMatrixFixed = 'character',

     checkpointInterval = 'integer',

     nCores = 'integer'

 ))

+#' @importFrom methods callNextMethod

 setMethod('initialize', 'GapsParams', 

     function(.Object, nFactor, nEquil, nSample, ...)

     {

-        .Object@nFactor <- nFactor

-        .Object@nEquil <- nEquil

-        .Object@nSample <- nSample

-        .Object@nOutput <- 1000

-        .Object@numSnapshots <- 0

+        .Object@nFactor <- as.integer(nFactor)

+        .Object@nEquil <- as.integer(nEquil)

+        .Object@nEquil <- as.integer(floor(nEquil/10))

+        .Object@nSample <- as.integer(nSample)

+        .Object@nOutput <- as.integer(1000)

+        .Object@nSnapshots <- as.integer(0)

         .Object@alphaA <- 0.01

         .Object@alphaP <- 0.01

         .Object@maxGibbmassA <- 100.0

         .Object@maxGibbmassP <- 100.0

-        .Object@seed <- -1

+        .Object@seed <- as.integer(-1)

         .Object@messages <- TRUE

-        .Object@singleCelLRNASeq <- FALSE

+        .Object@singleCellRNASeq <- FALSE

         .Object@fixedPatterns <- matrix(0)

         .Object@whichMatrixFixed <- 'N'

-        .Object@checkpointInterval <- 0

+        .Object@checkpointInterval <- as.integer(0)

+        .Object@nCores <- as.integer(1)

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

         .Object

@@ -73,14 +77,24 @@ setValidity('GapsParams',

     }

 )

-#' @rdname getParam

+##################### Generics ###################

+

+#' @export

+setGeneric('getParam', function(object, name)

+    {standardGeneric('getParam')})

+

+#' @export

+setGeneric('setParam', function(object, name, value)

+    {standardGeneric('setParam')})

+

+##################### Methods ####################

+

 #' @importFrom methods slot

 setMethod("getParam", "GapsParams", function(object, name)

 {

     slot(object, name)

 })

-#' @rdname setParam

 #' @importFrom methods slot<- validObject

 setMethod("setParam", "GapsParams", function(object, name, value)

 {

@@ -89,7 +103,6 @@ setMethod("setParam", "GapsParams", function(object, name, value)

     return(object)

 })

-#' @importFrom methods slotNames

 setMethod("show", "GapsParams", function(object)

 {

     cat("CoGAPS Parameters Object\n")

@@ -104,4 +117,4 @@ checkParamsWithData <- function(params, nRD, nCD, nRS, nCS)

         stop('invalid fixed pattern length')

     if (params@whichMatrixFixed == 'P' & ncol(params@fixedPatterns) != nCD)

         stop('invalid fixed pattern length')

-})

+}

new file mode 100644

@@ -0,0 +1,34 @@

+#' Create Gene Sets for GWCoGAPS

+#'

+#' @details factors whole genome data into randomly generated sets for indexing

+#'

+#' @param data data matrix with unique rownames

+#' @param nSets number of sets for parallelization

+#' @param outRDA name of output file

+#' @param keep logical indicating whether or not to save gene set list.

+#' @return list with randomly generated sets of genes from whole genome data