@@ -86,13 +86,14 @@ outputToFile=NULL, ...)

     )

     allParams <- parseExtraParams(allParams, list(...))

-    # display start up message for the user

-    startupMessage(data, allParams)

-

     # check file extension

     if (is(data, "character") & !supported(data))

         stop("unsupported file extension for data")

+    # enforce the use of explicit subsets with manual pattern matching

+    if (!is.null(allParams$matchedPatterns) & is.null(allParams$gaps@explicitSets))

+        stop("must provide explicit subsets when doing manual pattern matching")

+

     # check uncertainty matrix

     if (is(data, "character") & !is.null(uncertainty) & !is(uncertainty, "character"))

         stop("uncertainty must be same data type as data (file name)")

@@ -154,6 +155,7 @@ outputToFile=NULL, ...)

     allParams$sampleNames <- sampleNames

     # run cogaps

+    startupMessage(data, allParams)

     gapsReturnList <- dispatchFunc(data, allParams, uncertainty)

     # convert list to CogapsResult object

@@ -21,7 +21,7 @@ supported <- function(file)

 {

     if (!is(file, "character"))

         return(FALSE)

-    return(tools::file_ext(file) %in% c("tsv", "csv", "mtx"))

+    return(tools::file_ext(file) %in% c("tsv", "csv", "mtx", "gct"))

 }

 #' get number of rows from supported file name or matrix

@@ -38,7 +38,8 @@ nrowHelper <- function(data)

         return(switch(tools::file_ext(data),

             "csv" = nrow(data.table::fread(data, select=1)),

             "tsv" = nrow(data.table::fread(data, select=1)),

-            "mtx" = as.numeric(data.table::fread(data, nrows=1, fill=TRUE)[1,1])

+            "mtx" = as.numeric(data.table::fread(data, nrows=1, fill=TRUE)[1,1]),

+            "gct" = as.numeric(strsplit(as.matrix(data.table::fread(data, nrows=1, sep='\t')), "\\s+")[[1]][1])

         ))

     }

     return(nrow(data))

@@ -58,7 +59,8 @@ ncolHelper <- function(data)

         return(switch(tools::file_ext(data),

             "csv" = ncol(data.table::fread(data, nrows=1)) - 1,

             "tsv" = ncol(data.table::fread(data, nrows=1)) - 1,

-            "mtx" = as.numeric(data.table::fread(data, nrows=1, fill=TRUE)[1,2])

+            "mtx" = as.numeric(data.table::fread(data, nrows=1, fill=TRUE)[1,2]),

+            "gct" = as.numeric(strsplit(as.matrix(data.table::fread(data, nrows=1, sep='\t')), "\\s+")[[1]][2])

         ))

     }

     return(ncol(data))

@@ -30,11 +30,16 @@ sampleWithExplictSets <- function(allParams, total)

 #' @return list of subsets

 sampleWithAnnotationWeights <- function(allParams, setSize)

 {

+    # sort annotation group and weights so they match up

+    weight <- allParams$gaps@samplingWeight

+    weight <- weight[order(names(weight))]

     groups <- unique(allParams$gaps@samplingAnnotation)

+    groups <- sort(groups)

+

+    # sample accordingly

     return(lapply(1:allParams$gaps@nSets, function(i)

     {

-        groupCount <- sample(groups, size=setSize, replace=TRUE,

-            prob=allParams$gaps@samplingWeight)

+        groupCount <- sample(groups, size=setSize, replace=TRUE, prob=weight)

         sort(unlist(sapply(groups, function(g)

         {

             groupNdx <- which(allParams$gaps@samplingAnnotation == g)

@@ -110,6 +110,11 @@ setValidity("CogapsParams",

         if (!is.null(object@explicitSets) & length(object@explicitSets) != object@nSets)

             "wrong number of sets given"

+        if (length(object@samplingWeight) & is.null(names(object@samplingWeight)))

+            "samplingWeight must be a named vector"

+

+        if (!is.null(object@explicitSets) & !is.null(object@samplingWeight))

+            "explicitSets and samplingAnnotation/samplingWeight are both set"

     }

 )

Binary files a/tests/testthat/gaps_checkpoint.out and b/tests/testthat/gaps_checkpoint.out differ

new file mode 100644

@@ -0,0 +1,31 @@

+context("CoGAPS")

+

+test_that("Subsetting Data",

+{

+    data(GIST)

+    data(SimpSim)

+    testMatrix <- GIST.matrix

+

+    # sampling with weights

+    anno <- sample(letters[1:5], size=nrow(testMatrix), replace=TRUE)

+    weights <- c(0,1,4,1,0)

+    names(weights) <- letters[1:5]

+    params <- new("CogapsParams")

+    params <- setAnnotationWeights(params, annotation=anno, weights=weights)

+    result <- GWCoGAPS(testMatrix, params, messages=FALSE)

+

+    getIndex <- function(s) as.numeric(strsplit(s, "_")[[1]][2])

+    getIndices <- function(set) unname(sapply(set, getIndex))

+    countType <- function(set, type) sum(getIndices(set) %in% which(anno == type))

+    getHistogram <- function(set) sapply(letters[1:5], function(letter) countType(set, letter))

+    hist <- sapply(getSubsets(result), getHistogram)

+    freq <- unname(rowSums(hist) / sum(hist))

+    

+    expect_true(all.equal(freq, unname(weights / sum(weights)), tol=0.05))

+

+    # running cogaps with given subsets

+    sets <- list(1:225, 226:450, 451:675, 676:900)

+    result <- GWCoGAPS(SimpSim.data, explicitSets=sets, messages=FALSE)

+    subsets <- lapply(getSubsets(result), getIndices)

+    expect_true(all(sapply(1:4, function(i) all.equal(sets[[i]], subsets[[i]]))))

+})

\ No newline at end of file

@@ -19,6 +19,7 @@ test_that("Valid Top-Level CoGAPS Calls",

     gistCsvPath <- system.file("extdata/GIST.csv", package="CoGAPS")

     gistTsvPath <- system.file("extdata/GIST.tsv", package="CoGAPS")

     gistMtxPath <- system.file("extdata/GIST.mtx", package="CoGAPS")

+    gistGctPath <- system.file("extdata/GIST.gct", package="CoGAPS")

     # data types

     res <- list()

@@ -27,15 +28,16 @@ test_that("Valid Top-Level CoGAPS Calls",

     res[[3]] <- CoGAPS(gistCsvPath, nIterations=100, outputFrequency=50, seed=1, messages=FALSE)

     res[[4]] <- CoGAPS(gistTsvPath, nIterations=100, outputFrequency=50, seed=1, messages=FALSE)

     res[[5]] <- CoGAPS(gistMtxPath, nIterations=100, outputFrequency=50, seed=1, messages=FALSE)

+    res[[6]] <- CoGAPS(gistGctPath, nIterations=100, outputFrequency=50, seed=1, messages=FALSE)

     expect_true(all(sapply(res, no_na_in_result)))

     expect_equal(nrow(res[[1]]@featureLoadings), 1363)

     expect_equal(ncol(res[[1]]@featureLoadings), 7)

     expect_equal(nrow(res[[1]]@sampleFactors), 9)

     expect_equal(ncol(res[[1]]@sampleFactors), 7)

-    expect_true(all(sapply(1:4, function(i)

+    expect_true(all(sapply(1:5, function(i)

         res[[i]]@featureLoadings == res[[i+1]]@featureLoadings)))

-    expect_true(all(sapply(1:4, function(i)

+    expect_true(all(sapply(1:5, function(i)

         res[[i]]@sampleFactors == res[[i+1]]@sampleFactors)))

     # transposing data

@@ -50,15 +52,17 @@ test_that("Valid Top-Level CoGAPS Calls",

         outputFrequency=50, seed=1, messages=FALSE)

     res[[5]] <- CoGAPS(gistMtxPath, transposeData=TRUE, nIterations=100,

         outputFrequency=50, seed=1, messages=FALSE)

+    res[[6]] <- CoGAPS(gistGctPath, transposeData=TRUE, nIterations=100,

+        outputFrequency=50, seed=1, messages=FALSE)

     expect_true(all(sapply(res, no_na_in_result)))

     expect_equal(nrow(res[[1]]@featureLoadings), 9)

     expect_equal(ncol(res[[1]]@featureLoadings), 7)

     expect_equal(nrow(res[[1]]@sampleFactors), 1363)

     expect_equal(ncol(res[[1]]@sampleFactors), 7)

-    expect_true(all(sapply(1:4, function(i)

+    expect_true(all(sapply(1:5, function(i)

         res[[i]]@featureLoadings == res[[i+1]]@featureLoadings)))

-    expect_true(all(sapply(1:4, function(i)

+    expect_true(all(sapply(1:5, function(i)

         res[[i]]@sampleFactors == res[[i+1]]@sampleFactors)))

     # passing uncertainty

@@ -380,8 +380,10 @@ sampling all rows (cols) according to the weight of each category.

 ```{r}

 # sampling with weights

 anno <- sample(letters[1:5], size=nrow(SimpSim.data), replace=TRUE)

+w <- c(1,1,2,2,1)

+names(w) <- letters[1:5]

 params <- new("CogapsParams")

-params <- setAnnotationWeights(params, annotation=anno, weights=c(1,1,2,2,1))

+params <- setAnnotationWeights(params, annotation=anno, weights=w)

 result <- GWCoGAPS(SimpSim.data, params, messages=FALSE)

 ```