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

 #' @import tools

 #' 

 #' @export

-createVectors <- function(x, y = NULL, groups, cor.method = c("spearman")) {

-    print(x)

-    if(checkInputs(x,y,groups)) {

-        stop("Please fix inputs.")

+createVectors <- function(x, y = NULL, groups, 

+                          cor.method = c("pearson", "spearman", "bwmc", 

+                                         "sparcc")) {

+    

+    cor.method <- match.arg(cor.method)

+    if (unique(unique(groups) != c(1,2))) {

+        stop("groups vector must consist of 1s and 2s corresponding to first

+             and second group")

     }

+    print(x)

+    

     index1 <- which(groups == 1)

     index2 <- which(groups == 2)

-    

-    check <- match(cor.method, c("spearman", "pearson", "bwmc", "sparcc"))

-    if(is.na(check)) {

-        stop("Please enter spearman, pearson, bwmc or sparcc for correlation 

-            metric.")

-    }

-    

     x <- exprs(x)

     if(is.null(y) == FALSE) {

@@ -39,10 +38,10 @@ createVectors <- function(x, y = NULL, groups, cor.method = c("spearman")) {

         }

         if(cor.method == c("sparcc")) {

             if(min(data) < 0) {

-                stop("SparCC can only be applied to sequencing data.")

+                stop("Negative values found. SparCC can only be applied to sequencing data.")

             }

-            statMatrix1 <- SparCC.count(t(data1))

-            statMatrix2 <- SparCC.count(t(data2))

+            statMatrix1 <- SparCC.count(t(data1))$cor.w

+            statMatrix2 <- SparCC.count(t(data2))$cor.w

         }

         statMatrix1 <- statMatrix1[1:featureSize,

                                    (featureSize + 1):dim(data1)[1]]

@@ -16,25 +16,14 @@ discordantRun <- function(v1, v2, x, y = NULL, transform = TRUE,

                           subsampling = FALSE, subSize = dim(x)[1], iter = 100, 

                           components = 3) {

-  if(checkInputs(x,y)) {

-    stop("Please fix inputs.")

-  }

+  .checkDiscordantInputs(v1, v2, x, y, transform, subsampling, subSize, iter, 

+                         components)

-  if(transform == TRUE) {

-    if(range(v1)[1] < -1 || range(v1)[2] > 1 || range(v2)[1] < -1 || 

-       range(v2)[2] > 1) {

-      stop("correlation vectors have values less than -1 and/or greater 

-                than 1.")

-    }

+  if (transform) {

     v1 <- fishersTrans(v1)

     v2 <- fishersTrans(v2)

   }

-  check <- match(components, c(3,5))

-  if(is.na(check)) {

-    stop("components must be 3 or 5")

-  }

-  

   x <- exprs(x)

   if(is.null(y) == FALSE) { y <- exprs(y) }

   featureSize = dim(x)[1]

@@ -125,7 +114,8 @@ discordantRun <- function(v1, v2, x, y = NULL, transform = TRUE,

     tau <- total_tau / iter

     pi <- total_pi / iter

-    finalResult <- subSampleData(pdata, class, mu, sigma, nu, tau, pi, components)

+    finalResult <- subSampleData(pdata, class, mu, sigma, nu, tau, pi, 

+                                 components)

     zTable <- finalResult$z

     classVector <- finalResult$class

   } else {

@@ -177,30 +167,14 @@ discordantRun <- function(v1, v2, x, y = NULL, transform = TRUE,

               probMatrix = zTable, loglik = pd$loglik))

 }

-#modified from package mclust

-unmap <- function(classification, components){

-    n <- length(classification)

-    # u <- sort(unique(classification)) # OG Code

-    u <- 0:(components - 1) # Max's potential fix

-    labs <- as.character(u)

-    k <- length(u)

-    z <- matrix(0, n, k)

-    for (j in 1:k) z[classification == u[j], j] <- 1

-    dimnames(z) <- list(NULL, labs)

-    return(z)

-}

-

 em.normal.partial.concordant <- function(data, class, tol=0.001, 

-    restriction=0, constrain=0, iteration=1000, components){

+    restriction=0, constrain=0, iteration=1000, components) {

     n <- as.integer(dim(data)[1])

     g <- as.integer(nlevels(as.factor(class)))

     yl.outer <- function(k, zx, zy){

         return( c(zx[k,] %o% zy[k,]) )

     }

-    yl.diag <- function(k, z){

-        return( c(diag(z[k,])) )

-    }

     zx <- unmap(class[,1], components = components)

     zy <- unmap(class[,2], components = components)

@@ -224,9 +198,31 @@ em.normal.partial.concordant <- function(data, class, tol=0.001,

                                                 as.integer(iteration), 

                                                 convergence)

-    return(list(model="PCD", convergence=results[[16]], 

-        pi=t(array(results[[5]], dim=c(g,g))), mu_sigma=rbind(results[[6]], 

-        results[[7]]), nu_tau=rbind(results[[8]], results[[9]]), 

-        loglik=results[[11]], class=apply(array(results[[3]], dim=c(n,g*g)),1,

-        order,decreasing=TRUE)[1,], z=array(results[[3]], dim=c(n,g*g))))

+    return(list(model = "PCD", 

+                convergence = results[[16]],

+                pi = t(array(results[[5]], dim=c(g,g))), 

+                mu_sigma = rbind(results[[6]], results[[7]]), 

+                nu_tau = rbind(results[[8]], results[[9]]),

+                loglik = results[[11]], 

+                class = apply(array(results[[3]], dim = c(n,g*g)), 

+                              1, order, decreasing = TRUE)[1,], 

+                z = array(results[[3]], dim = c(n, g*g))))

+}

+

+.checkDiscordantInputs <- function(v1, v2, x, y, transform, 

+                                   subsampling, subSize, iter, 

+                                   components) {

+  

+  if (!is(x, "ExpressionSet") || (!is.null(y) && !is(y, "ExpressionSet"))) {

+    stop("x and y (if present) must be type ExpressionSet")

+  }

+  

+  if (!(components %in% c(3, 5))) {

+    stop ("components must be equal to 3 or 5")

+  }

+  

+  if (transform && (range(v1)[1] < -1 || range(v1)[2] > 1 || 

+                    range(v2)[1] < -1 || range(v2)[2] > 1)) {

+    stop ("correlation vectors have values less than -1 and/or greater than 1.")

+  }

 }

\ No newline at end of file

@@ -12,9 +12,6 @@ subSampleData <- function(pdata, class, mu, sigma, nu, tau, pi, components) {

     yl.outer <- function(k, zx, zy){

         return( c(zx[k,] %o% zy[k,]) )

     }

-    yl.diag <- function(k, z){

-        return( c(diag(z[k,])) )

-    }

     zx <- unmap(class[,1], components = components)

     zy <- unmap(class[,2], components = components)

@@ -33,6 +30,19 @@ subSampleData <- function(pdata, class, mu, sigma, nu, tau, pi, components) {

                 z = array(results[[3]], dim=c(n,g*g))))

 } 

+# modified from package mclust

+unmap <- function(classification, components){

+    n <- length(classification)

+    # u <- sort(unique(classification)) # OG Code

+    u <- 0:(components - 1) # Max's potential fix

+    labs <- as.character(u)

+    k <- length(u)

+    z <- matrix(0, n, k)

+    for (j in 1:k) z[classification == u[j], j] <- 1

+    dimnames(z) <- list(NULL, labs)

+    return(z)

+}

+

 getNames <- function(x, y = NULL) {

     if(is.null(y) == FALSE) {

         namesMatrix <- NULL

@@ -61,18 +71,4 @@ getNames <- function(x, y = NULL) {

     vector_names <- apply(namesMatrix, 1, function(k) paste(k[1],"_",k[2],

                                                             sep = ""))

     return(vector_names)

-}

-

-checkInputs <- function(x, y, groups = NULL) {

-    issue = FALSE

-    if(is.null(groups) == FALSE  && unique(unique(groups) != c(1,2))) {

-        print("groups vector must consist of 1s and 2s corresponding to first

-             and second group.")

-        issue = TRUE

-    }

-    if(mode(x) != "S4" || (is.null(y) == FALSE && mode(y) != "S4")) {

-        print("data matrices x and/or y must be type ExpressionSet")

-        issue = TRUE

-    }

-    return(issue)

 }

\ No newline at end of file