@@ -31,7 +31,8 @@ Imports:

     reshape2

 Suggests:

     testthat,

-    lintr

+    lintr,

+    knitr

 LinkingTo: Rcpp, BH

 VignetteBuilder: knitr

 License: GPL (==2)

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

 #' CoGAPS Matrix Factorization Algorithm

 #' 

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

-#'  matrix factorization returning the two matrices that reconstruct

-#'  the data matrix

+#' matrix factorization returning the two matrices that reconstruct

+#' the data matrix

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

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

 #' @param nEquil number of iterations for burn-in

 #' @param nSample number of iterations for sampling

 #' @param nOutputs how often to print status into R by iterations

@@ -16,16 +16,19 @@

 #' @param maxGibbmassA limit truncated normal to max size

 #' @param maxGibbmassP limit truncated normal to max size

 #' @param seed a positive seed is used as-is, while any negative seed tells

-#'  the algorithm to pick a seed based on the current time

+#' the algorithm to pick a seed based on the current time

 #' @param messages display progress messages

 #' @param singleCellRNASeq indicates if the data is single cell RNA-seq data

 #' @param whichMatrixFixed character to indicate whether A or P matric contains

-#'  the fixed patterns

+#' the fixed patterns

 #' @param fixedPatterns matrix of fixed values in either A or P matrix

 #' @param checkpointInterval time (in seconds) between creating a checkpoint

 #' @param ... keeps backwards compatibility with arguments from older versions

 #' @return list with A and P matrix estimates

 #' @importFrom methods new

+#' @examples

+#' data(SimpSim)

+#' result <- CoGAPS(SimpSim.D, SimpSim.S, nFactor=3, nOutputs=250)

 #' @export

 CoGAPS <- function(D, S, nFactor=7, nEquil=1000, nSample=1000, nOutputs=1000,

 nSnapshots=0, alphaA=0.01, alphaP=0.01, maxGibbmassA=100, maxGibbmassP=100,

@@ -59,9 +62,13 @@ fixedPatterns = matrix(0), checkpointInterval=0, ...)

     result <- cogaps_cpp(D, S, nFactor, nEquil, nEquil/10, nSample, nOutputs,

         nSnapshots, alphaA, alphaP, maxGibbmassA, maxGibbmassP, seed, messages,

         singleCellRNASeq, whichMatrixFixed, fixedPatterns, checkpointInterval)

-

-    # backwards compatible with v2

-    return(v2CoGAPS(result, ...))

+    

+    patternNames <- paste('Patt', 1:nFactor, sep='')

+    rownames(result$Amean) <- rownames(result$Asd) <- rownames(D)

+    colnames(result$Amean) <- colnames(result$Asd) <- patternNames

+    rownames(result$Pmean) <- rownames(result$Psd) <- patternNames

+    colnames(result$Pmean) <- colnames(result$Psd) <- colnames(D)

+    return(v2CoGAPS(result, ...)) # backwards compatible with v2

 }

 #' Restart CoGAPS from Checkpoint File

@@ -82,6 +89,9 @@ CoGapsFromCheckpoint <- function(D, S, path)

 #'

 #' @details displays information about how the package was compiled, i.e. which

 #'  compiler/version was used, which compile time options were enabled, etc...

+#' @return display builds information

+#' @examples

+#'  CoGAPS::displayBuildReport()

 #' @export

 displayBuildReport <- function()

 {

@@ -116,10 +126,10 @@ numSnapshots=100, alphaA=0.01, nMaxA=100000, max_gibbmass_paraA=100.0,

 alphaP=0.01, nMaxP=100000, max_gibbmass_paraP=100.0, seed=-1, messages=TRUE)

 {

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

-    CoGAPS(D, S, nFactor=nFactor, nEquil=nEquil, nSample=nSample, nOutputs=nOutR,

-        nSnapshots=ifelse(sampleSnapshots,numSnapshots,0), alphaA=alphaA,

-        alphaP=alphaP, maxGibbmassA=max_gibbmass_paraA, messages=messages,

-        maxGibbmassP=max_gibbmass_paraP, seed=seed)

+    CoGAPS(D, S, nFactor=nFactor, nEquil=nEquil, nSample=nSample,

+        nOutputs=nOutR, nSnapshots=ifelse(sampleSnapshots,numSnapshots,0),

+        alphaA=alphaA, alphaP=alphaP, maxGibbmassA=max_gibbmass_paraA,

+        messages=messages, maxGibbmassP=max_gibbmass_paraP, seed=seed)

 }

 #' Backwards Compatibility with v2

@@ -141,18 +151,35 @@ max_gibbmass_paraA=100.0, alphaP=0.01, nMaxP=100000, max_gibbmass_paraP=100.0,

 seed=-1, messages=TRUE)

 {

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

-    CoGAPS(D, S, nFactor=nFactor, nEquil=nEquil, nSample=nSample, nOutputs=nOutR,

-        nSnapshots=ifelse(sampleSnapshots,numSnapshots,0), alphaA=alphaA,

-        alphaP=alphaP, maxGibbmassA=max_gibbmass_paraA, messages=messages,

-        maxGibbmassP=max_gibbmass_paraP, seed=seed, whichMatrixFixed='P',

-        fixedPatterns=as.matrix(FP))

+    CoGAPS(D, S, nFactor=nFactor, nEquil=nEquil, nSample=nSample,

+        nOutputs=nOutR, nSnapshots=ifelse(sampleSnapshots,numSnapshots,0),

+        alphaA=alphaA, alphaP=alphaP, maxGibbmassA=max_gibbmass_paraA,

+        messages=messages, maxGibbmassP=max_gibbmass_paraP, seed=seed,

+        whichMatrixFixed='P', fixedPatterns=as.matrix(FP))

 }

+# helper function for backwards compatibility

 v2CoGAPS <- function(result, ...)

 {

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

     {

-

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

+        {

+            plotGAPS(result$Amean, result$Pmean)

+        }

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

+        {

+            nPerm <- 500

+        }

+        else

+        {

+            nPerm <- list(...)$nPerm

+        }

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

+            nPerm)

+        result <- list(meanChi2=result$meanChi2, Amean=result$Amean,

+            Asd=result$Asd, Pmean=result$Pmean, Psd=result$Psd,

+            GSUpreg=GSP$GSUpreg, GSDownreg=GSP$GSDownreg, GSActEst=GSP$GSActEst)

     }

     return(result)

 }

\ No newline at end of file

@@ -1,13 +1,12 @@

 #' GWCoGAPS

 #'

-#'\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;

-#'

+#' @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 nFactor number of patterns (basis vectors, metagenes), which must be

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

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

@@ -16,12 +15,13 @@

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

+#' @return list of A and P estimates

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

 #' @examples

-#' # Load the simulated data

-#' data('SimpSim')

+#' # Load the sample data from CoGAPS

+#' data(SimpSim)

 #' # Run GWCoGAPS

-#' GWCoGAPS(SimpSim.D, SimpSim.S, nFactor=3, nSets=2, numSnapshots = 5)

+#' GWCoGAPS(SimpSim.D, SimpSim.S, nFactor=3, nSets=2)

 #' @export

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

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

@@ -1,17 +1,18 @@

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

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

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

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

 #' @examples

-#' # Load the outputs from gapsRun

-#' data('results')

+#' # Load the sample data from CoGAPS

+#' data(SimpSim)

 #' # Run binaryA with the correct arguments from 'results'

-#' binaryA(results$Amean,results$Asd,threshold=3)

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

 #' @export

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

 {

@@ -1,19 +1,19 @@

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

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

-#' # Load the simulated data

-#' data('SimpSim')

-#' # Load the outputs from gapsRun

-#' data('results')

+#' # Load the sample data from CoGAPS

+#' data(SimpSim)

 #' # Run calcCoGAPSStat with the correct arguments from 'results'

-#' calcCoGAPSStat(results$Amean,results$Asd,GStoGenes=GSets,numPerm=500)

+#' calcCoGAPSStat(SimpSim.result$Amean, SimpSim.result$Asd,

+#' GStoGenes=GSets, numPerm=500)

 #' @export

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

 {

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

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

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

+#' @param nullGenes logical indicating gene adjustment

+#' @return gene similiarity statistic

 #' @examples

-#' # Load the simulated data

+#' # Load the sample data from CoGAPS

 #' data('SimpSim')

-#' # Load the outputs from gapsRun

-#' data('results')

 #' # Run calcGeneGSStat with the correct arguments from 'results'

-#' calcGeneGSStat(results$Amean,results$Asd,GSGenes=GSets[[1]],numPerm=500)

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

@@ -56,10 +56,10 @@ nullGenes=FALSE)

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

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

@@ -67,7 +67,13 @@ nullGenes=FALSE)

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

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

+#' @examples

+#' # Load the sample data from CoGAPS

+#' data('SimpSim')

+#' # Run calcGeneGSStat with the correct arguments from 'results'

+#' calcGeneGSStat(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)

@@ -1,37 +1,23 @@

 #' Compute Z-Score Matrix

 #'

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

-#'  and standard deviation matrices

+#' and standard deviation matrices

 #' @param meanMat matrix of mean values

 #' @param sdMat matrix of standard deviation values

+#' @return matrix of z-scores

 #' @examples

-#' # Load the simulated data

-#' data('SimpSim')

+#' # Load the sample data from CoGAPS

+#' data(SimpSim)

 #' # Run calcZ

-#' calcZ(SimpSim.D,SimpSim.S)

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

 #' @export

 calcZ <- function(meanMat, sdMat)

 {

-    # find matrix dimensions

-    nrows <- dim(meanMat)[1]

-    ncols <- dim(meanMat)[2]

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

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

-    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

+    zMat <- meanMat / sdMat

     rownames(zMat) <- rownames(meanMat)

     colnames(zMat) <- colnames(meanMat)

-

     return(zMat)

 }

@@ -8,10 +8,10 @@

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

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

 #' @examples

-#' # Load the simulated data

-#' data('SimpSim')

+#' # Load the sample data from CoGAPS

+#' data(SimpSim)

 #' # Run createGWCoGAPSSets

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

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

 #' @export

 createGWCoGAPSSets<-function(data=D, nSets=nSets,

 outRDA="GenesInCoGAPSSets.Rda", keep=TRUE)

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

 #Calculates significant genes in each pattern according to certain threshold

 #Returns the significant gene names as well as well as the correlation matrices between these genes and the means of these matrices

-

 gapsIntraPattern <- function(Amean, Asd, DMatrix, sdThreshold = 3)

 {

     #number of rows and cols of Asd

@@ -2,11 +2,11 @@

 #'

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

+#' by a seed generated from the current time

 #' @return vector of randomly generated seeds

-#' @export

 #' @examples

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

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

+#' @export

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

 {

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

@@ -9,8 +9,8 @@

 #' @return By default a non-overlapping list of genes associated with each \code{lp}. If \code{full=TRUE} a data.frame of

 #' genes rankings with a column for each \code{lp} will also be returned.

 #' @examples

-#' # Load the outputs from gapsRun

-#' data('results')

+#' # Load the sample data from CoGAPS

+#' data(SimpSim)

 #' # Run patternMarkers with the correct arguments from 'results'

 #' patternMarkers(Amatrix=results$Amean,scaledPmatrix=FALSE,

 #' Pmatrix=results$Pmean,threshold="all",full=TRUE)

@@ -8,7 +8,6 @@

 #' @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{Ptot}

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

 #' @export

@@ -4,158 +4,149 @@

 #' @param out optional name for saving output

 #' @param order optional vector indicating order of samples for plotting. Default is NULL.

 #' @param sample.color optional vector of colors of same length as colnames. Default is NULL.

-#'

 #' @return either an index of selected sets' contributions or the editted \code{PBySet} object

 #' @export

-#'

-#' @examples \dontrun{

-#' patternMatcher(PBySet,out,order,sample.color)

-#' }

-#'

-#'

-patternMatcher<-function(PBySet=NULL,out=NULL,order=NULL, sample.color=NULL) {

-

-runApp(list(

-  ui = pageWithSidebar(

-    # Application title

-    headerPanel('NMF Pattern Matching'),

-    # Side pannel with controls

-    sidebarPanel(

-      # to upload file

-      fileInput('file1',

-                'Choose .Rda File',

-                accept=c('.RData','.Rda','R data object','.rda')

-      ),

-      #

-      uiOutput("pickplot"),

-      uiOutput("checkbs"),

-      downloadButton('downloadData', 'Download'),

-      actionButton("end", "Return")

-    ),

-    # Main panel with plots

-    mainPanel(

-      plotOutput('plot1')

-    )

-  ),

-

-  server = function(input, output, session) {

-    #load in the data

-    df<-reactive({

-      if(!is.null(PBySet)){

-        df<-PBySet

-        return(df)

-      }

-      inFile <- input$file1 # get the path to the input file on the server

-      if (is.null(inFile)){return(NULL)}

-      load(inFile$datapath) #load it

-      df <- get(load(inFile$datapath))# get the name of the object that was loaded

-      return(df)

-    })

-

-    # get data name

-    datName<-reactive({

-      if(!is.null(out)){

-        datName<-paste(out,'.SelectedPatterns.Rda',sep="")

-        return(datName)

-      }

-      inFile <- input$file1

-      if (is.null(inFile) & is.null(out)){

-        datName<-"SelectedPatterns.Rda"

-        return(datName)

-      }

-      if (is.null(inFile)){return(NULL)}

-      fn<-strsplit(inFile$name,"[.]")[[1]][1]

-      datName<-paste(fn,'.SelectedPatterns.Rda',sep="")

-      return(datName)

-    })

-

-

-    mdf=reactive({# use that to give options for subsetting, some formatting may need to be removed

-      dfx=df()

-      if (is.null(dfx)){return(NULL)}

-      mdf=melt(dfx,stringsAsFactors=FALSE) # melt the elements of the list

-      colnames(mdf)<-c("BySet","Samples","value","Patterns")

-      mdf$BySet<-as.character(mdf$BySet) # change them to characters

-      mdf$Samples<-as.character(mdf$Samples)

-      mdf$value=as.numeric(mdf$value) #make sure value is numeric for plotting

-      str(mdf)

-      return(mdf)

-    })

-

-

-    output$pickplot <- renderUI({# menu to select which matrix to look at/edit

-      if (is.null(df())){return(NULL)}

-      mdf2=mdf()

-      selectInput("whichplot", "Select the Pattern to Plot",choices=unique(mdf2$Patterns))

-    })

-

-

-    output$checkbs <- renderUI({# make the checkboxes for each row of each matrix

-      if (is.null(df())){return(NULL)}

-      mdf2=mdf()

-      lapply(unique(mdf2$Patterns), function(i) {

-        subss <- unique(mdf2$BySet[mdf2$Patterns==i]) # find the rows (after it has been melted)

-        tmp=sprintf("input.whichplot ==  %g", i) # create the javascript code to make this a conditional panel

-        conditionalPanel(

-          condition = tmp,

-          checkboxGroupInput(paste("subs",i,sep=""), i, choices=subss, selected=subss) # the actual checkboxes for each, subs1, subs2, subsn

-        )

-      })

-    })

-

-

-    output$plot1 <- renderPlot({#plot the data, subset to the desired columns

-      # if there has not been an uploaded matrix yet, don't even try to make a plot

-      if (is.null(df())){return(NULL)}

-      if (is.null(input$whichplot)){return(NULL)}

-      par(mar = c(5.1, 4.1, 0, 1))

-      mdf2=mdf() # grab the melted data frame to use the ggplot2 plot

-      x=input$whichplot # which matrix to show

-      x=as.numeric(x)

-      tmp=input[[paste("subs",x,sep="")]] # get the rows that have been selected

-      mdf2x=mdf2[which(mdf2$BySet%in%tmp),]

-      if (!is.null(order) & !is.null(sample.color)){

-       ggplot(mdf2x, aes(x=Samples, y=value, col=BySet,group=BySet))+

-        geom_line() + scale_x_discrete(limits=order) +

-        theme(axis.text.x = element_text(angle=45,family="Helvetica-Narrow", hjust = 1,colour = sample.color))

-      } else if(!is.null(sample.color) & is.null(order)) {

-      ggplot(mdf2x, aes(x=Samples, y=value, col=BySet,group=BySet))+

-          geom_line() +

-          theme(axis.text.x = element_text(angle=45,family="Helvetica-Narrow", hjust = 1,colour = sample.color))

-      } else if(!is.null(order) & is.null(sample.color) ) {

-        ggplot(mdf2x, aes(x=Samples, y=value, col=BySet,group=BySet))+

-          geom_line() + scale_x_discrete(limits=order) +

-          theme(axis.text.x = element_text(angle=45,family="Helvetica-Narrow", hjust = 1))

-      } else {

-        ggplot(mdf2x, aes(x=Samples, y=value, col=BySet,group=BySet))+

-          geom_line() +

-          theme(axis.text.x = element_text(angle=45,family="Helvetica-Narrow", hjust = 1))

-      }

-      #pplot

-      #browser()

-    })

-

-    # create and download the final result file

-    output$downloadData <- downloadHandler(

-      filename = datName(), # set the file name

-      content = function(file) {

-        PatternsSelect <- lapply(1:length(mdf()), function(i) {input[[paste("subs",i,sep="")]]})

-        save(PatternsSelect, file=file) # generate the object to save

-      }

-    )

-    #stop app and return to R

-    observeEvent(input$end, {

-      mdf2=mdf()

-      PatternsSelect <- sapply(1:length(df()), function(i) {input[[paste("subs",i,sep="")]]})

-      selectPBySet <- mdf2[which(mdf2$BySet%in%PatternsSelect),]

-      stopApp(returnValue = selectPBySet)

-    })

-

-

-

-  }

-

-)

-)

-

+patternMatcher<-function(PBySet=NULL,out=NULL,order=NULL, sample.color=NULL)

+{

+    runApp(list(

+        ui = pageWithSidebar(

+            # Application title

+            headerPanel('NMF Pattern Matching'),

+            # Side pannel with controls

+            sidebarPanel(

+                # to upload file

+                fileInput('file1', 'Choose .Rda File',

+                    accept=c('.RData','.Rda','R data object','.rda')),

+                uiOutput("pickplot"),

+                uiOutput("checkbs"),

+                downloadButton('downloadData', 'Download'),

+                actionButton("end", "Return")

+            ),

+            # Main panel with plots

+            mainPanel(plotOutput('plot1'))

+        ),

+

+        server = function(input, output, session)

+        {

+            #load in the data

+            df<-reactive({

+                if(!is.null(PBySet))

+                {

+                    df<-PBySet

+                    return(df)

+                }

+                inFile <- input$file1 # get the path to the input file on the server

+                if (is.null(inFile)){return(NULL)}

+                load(inFile$datapath) #load it

+                df <- get(load(inFile$datapath))# get the name of the object that was loaded

+                return(df)

+            })

+

+            # get data name

+            datName<-reactive({

+                if(!is.null(out))

+                {

+                    datName<-paste(out,'.SelectedPatterns.Rda',sep="")

+                    return(datName)

+                }

+                inFile <- input$file1

+                if (is.null(inFile) & is.null(out))

+                {

+                    datName<-"SelectedPatterns.Rda"

+                    return(datName)

+                }

+                if (is.null(inFile)){return(NULL)}

+                fn<-strsplit(inFile$name,"[.]")[[1]][1]

+                datName<-paste(fn,'.SelectedPatterns.Rda',sep="")

+                return(datName)

+            })

+

+

+            mdf=reactive({# use that to give options for subsetting, some formatting may need to be removed

+                dfx=df()

+                if (is.null(dfx)){return(NULL)}

+                mdf=melt(dfx,stringsAsFactors=FALSE) # melt the elements of the list

+                colnames(mdf)<-c("BySet","Samples","value","Patterns")

+                mdf$BySet<-as.character(mdf$BySet) # change them to characters

+                mdf$Samples<-as.character(mdf$Samples)

+                mdf$value=as.numeric(mdf$value) #make sure value is numeric for plotting

+                str(mdf)

+                return(mdf)

+            })

+

+

+            output$pickplot <- renderUI({# menu to select which matrix to look at/edit

+                if (is.null(df())){return(NULL)}

+                mdf2=mdf()

+                selectInput("whichplot", "Select the Pattern to Plot",choices=unique(mdf2$Patterns))

+            })

+

+            output$checkbs <- renderUI({# make the checkboxes for each row of each matrix

+                if (is.null(df())){return(NULL)}

+                mdf2=mdf()

+                lapply(unique(mdf2$Patterns), function(i) {

+                    subss <- unique(mdf2$BySet[mdf2$Patterns==i]) # find the rows (after it has been melted)

+                    tmp=sprintf("input.whichplot ==  %g", i) # create the javascript code to make this a conditional panel

+                    conditionalPanel(

+                        condition = tmp,

+                        checkboxGroupInput(paste("subs",i,sep=""), i, choices=subss, selected=subss) # the actual checkboxes for each, subs1, subs2, subsn

+                    )

+                })

+            })

+

+

+            output$plot1 <- renderPlot({#plot the data, subset to the desired columns

+                # if there has not been an uploaded matrix yet, don't even try to make a plot

+                if (is.null(df())){return(NULL)}

+                if (is.null(input$whichplot)){return(NULL)}

+                par(mar = c(5.1, 4.1, 0, 1))

+                mdf2=mdf() # grab the melted data frame to use the ggplot2 plot

+                x=input$whichplot # which matrix to show

+                x=as.numeric(x)

+                tmp=input[[paste("subs",x,sep="")]] # get the rows that have been selected

+                mdf2x=mdf2[which(mdf2$BySet%in%tmp),]

+                if (!is.null(order) & !is.null(sample.color))

+                {

+                    ggplot(mdf2x, aes(x=Samples, y=value, col=BySet,group=BySet))+

+                    geom_line() + scale_x_discrete(limits=order) +

+                    theme(axis.text.x = element_text(angle=45,family="Helvetica-Narrow", hjust = 1,colour = sample.color))

+                }

+                else if(!is.null(sample.color) & is.null(order))

+                {

+                    ggplot(mdf2x, aes(x=Samples, y=value, col=BySet,group=BySet))+

+                    geom_line() +

+                    theme(axis.text.x = element_text(angle=45,family="Helvetica-Narrow", hjust = 1,colour = sample.color))

+                }

+                else if(!is.null(order) & is.null(sample.color) )

+                {

+                    ggplot(mdf2x, aes(x=Samples, y=value, col=BySet,group=BySet))+

+                    geom_line() + scale_x_discrete(limits=order) +

+                    theme(axis.text.x = element_text(angle=45,family="Helvetica-Narrow", hjust = 1))

+                }

+                else

+                {

+                    ggplot(mdf2x, aes(x=Samples, y=value, col=BySet,group=BySet))+

+                    geom_line() +

+                    theme(axis.text.x = element_text(angle=45,family="Helvetica-Narrow", hjust = 1))

+                }

+            })

+

+            # create and download the final result file

+            output$downloadData <- downloadHandler(

+                filename = datName(), # set the file name

+                content = function(file) {

+                    PatternsSelect <- lapply(1:length(mdf()), function(i) {input[[paste("subs",i,sep="")]]})

+                    save(PatternsSelect, file=file) # generate the object to save

+                }

+            )

+

+            #stop app and return to R

+            observeEvent(input$end, {

+                mdf2=mdf()

+                PatternsSelect <- sapply(1:length(df()), function(i) {input[[paste("subs",i,sep="")]]})

+                selectPBySet <- mdf2[which(mdf2$BySet%in%PatternsSelect),]

+                stopApp(returnValue = selectPBySet)

+            })

+        }

+    ))

 }

\ No newline at end of file

@@ -1,14 +1,15 @@

 #' Plot Number of Atoms

 #'

 #' @details a simple plot of the number of atoms

-#'  from one of the vectors returned with atom numbers

+#' from one of the vectors returned with atom numbers

 #' @param gapsRes the list resulting from applying GAPS

 #' @param type the atoms to plot, values are "sampA", "sampP" ,

-#'  "equilA", or "equilP" to plot sampling or equilibration teop

-#'  atom numbers

+#' "equilA", or "equilP" to plot sampling or equilibration teop

+#' atom numbers

+#' @return plot

 #' @examples

-#' # Load the outputs from gapsRun

-#' data('results')

+#' # Load the sample data from CoGAPS

+#' data(SimpSim)

 #' # Run plotAtoms

 #' plotAtoms(results,type="sampA")

 #'@export

@@ -2,11 +2,12 @@

 #'

 #' @details plots a series of diagnostic plots

 #' @param gapsRes list returned by CoGAPS

+#' @return plot

 #' @examples

-#' # Load the outputs from gapsRun

-#' data('results')

+#' # Load the sample data from CoGAPS

+#' data(SimpSim)

 #' # Run plotDiag

-#' plotDiag(results)

+#' plotDiag(SimpSim.result)

 #' @export

 plotDiag <-function(gapsRes)

 {

@@ -5,12 +5,13 @@

 #' @param A the mean A matrix

 #' @param P the mean P matrix

 #' @param outputPDF optional root name for PDF output, if

-#'  not specified, output goes to screen

+#' not specified, output goes to screen

+#' @return plot

 #' @examples

-#' # Load the outputs from gapsRun

-#' data('results')

-#' # Run plotGAPS with the correct arguments from 'results'

-#' plotGAPS(results$Amean,results$Pmean)

+#' # Load the sample data from CoGAPS

+#' data(SimpSim)

+#' # Run plotGAPS with arguments from CoGAPS results list

+#' plotGAPS(SimpSim.result$Amean, SimpSim.result$Pmean)

 #' @export

 plotGAPS <- function(A, P, outputPDF="")

 {

@@ -3,16 +3,17 @@

 #' @details plots the P matrix in a line plot with error bars

 #' @param Pmean matrix of mean values of P

 #' @param Psd matrix of standard deviation values of P

+#' @return plot

 #' @examples

-#' # Load the outputs from gapsRun

-#' data('results')

-#' # Run plotP with the correct arguments from 'results'

-#' plotP(results$Pmean,results$Psd)

+#' # Load the sample data from CoGAPS

+#' data(SimpSim)

+#' # Run plotP with arguments from CoGAPS results list

+#' plotP(SimpSim.result$Pmean, SimpSim.result$Psd)

 #' @export

 plotP <- function(Pmean, Psd)

 {

-    Nfactor=dim(Pmean)[1]

-    Nobs=dim(Pmean)[2]

+    Nfactor <- nrow(Pmean)

+    Nobs <- ncol(Pmean)

     RowP <- 1:Nobs

     colors <- rainbow(Nfactor)

     ylimits <- c(0,(max(Pmean + Psd)*1.05))

@@ -13,10 +13,8 @@

 #' @return heatmap of the \code{data} values for the \code{patternMarkers}

 #' @seealso  \code{\link{heatmap.2}}

 #' @examples

-#' # Load the simulated data

-#' data('SimpSim')

-#' # Load the outputs from gapsRun

-#' data('results')

+#' # Load the sample data from CoGAPS

+#' data(SimpSim)

 #' # Run patternMarkers and save the outputs

 #' PM <- patternMarkers(Amatrix=results$Amean,scaledPmatrix=FALSE,

 #' Pmatrix=results$Pmean,threshold="all",full=TRUE)

@@ -1,6 +1,7 @@

-#'\code{plotSmoothPatterns} plots the output A and P matrices as a

-#' heatmap and line plot respectively

+#' Plot Smooth Patterns

 #'

+#' @details plots the output A and P matrices as a heatmap and a

+#' line plot respectively

 #' @param P the mean A matrix

 #' @param x optional variables

 #' @param breaks breaks in plots

@@ -10,11 +11,12 @@

 #' @param pointCol color of points

 #' @param lineCol color of line

 #' @param add logical specifying if bars should be added to an already existing

-#'  plot; defaults to `FALSE'.

+#' plot; defaults to `FALSE'.

 #' @param ... arguments to be passed to/from other methods.  For the default

-#'  method these can include further arguments (such as `axes', `asp' and

-#'  `main') and graphical parameters (see `par') which are passed to

-#"  `plot.window()', `title()' and `axis'.

+#' method these can include further arguments (such as `axes', `asp' and

+#' `main') and graphical parameters (see `par') which are passed to

+#' `plot.window()', `title()' and `axis'.

+#' @return plot

 #' @export

 plotSmoothPatterns <- function(P, x=NULL, breaks=NULL, breakStyle=TRUE,

 orderP=!all(is.null(x)), plotPTS=FALSE, pointCol='black', lineCol='grey',

@@ -54,7 +56,7 @@ add=FALSE, ...)

             }

             else

             {

-                stop('CoGAPS: plotSmoothPatterns: number of plot boundaries must match number of breaks in the plot')

+                stop('number of plot boundaries must match number of breaks')

             }

         }

     }

@@ -62,14 +64,15 @@ add=FALSE, ...)

     # check that dimensions agree

     if (ncol(P) != length(x))

     {

-        stop('CoGAPS: plotSmoothPatterns: length of x coordinates must match number of samples in the columns of the P matrix')

+        stop('length of x coordinates must match number of samples')

     }

-    # If desired, reorder samples according to the group in which they obtain their maximum

+    # reorder samples according to the group in which they obtain their maximum

     if (orderP)

     {

         PMax <- apply(P,1,max)

-        xMax <- seq(from=ncol(P)+1,length.out=nrow(P))[order(PMax,decreasing=TRUE)]

+        xMax <- seq(from=ncol(P)+1, length.out=nrow(P))

+        xMax <- xMax[order(PMax,decreasing=TRUE)]

         xTmp <- x

         PTmp <- P

         for (iP in order(PMax,decreasing=TRUE))

@@ -1,10 +1,10 @@

-#' postFixed4Parallel

+#' Post Processing of Parallel Output

 #'

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

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

 #' @export

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

 {

@@ -1,16 +1,13 @@