Bugfixes to indMix() and subfunctions (#24)

R/indMix.R

@@ -21,11 +21,9 @@ indMix <- function(c, npops, counts = NULL, sumcounts = NULL, max_iter = 100L, d
     Z <- NULL
   }
 
-
+  if (missing(npops)) {
-  rm(c)
+    # Recreate npopsTaulu from objects other than npops
-  nargin <- length(as.list(match.call())) - 1
+    dispText <- TRUE
-  if (nargin < 2) {
-    dispText <- 1
     npopstext <- matrix()
     ready <- FALSE
     teksti <- "Input upper bound to the number of populations (possibly multiple values)"
@@ -75,7 +73,7 @@ indMix <- function(c, npops, counts = NULL, sumcounts = NULL, max_iter = 100L, d
   partitionSummary[, 1] <- zeros(30, 1)
   worstLogml <- -1e50
   worstIndex <- 1
-  for (run in seq_along(nruns)) {
+  for (run in seq_len(nruns)) {
     npops <- npopsTaulu[[run]]
     if (dispText) {
       dispLine()
@@ -110,7 +108,7 @@ indMix <- function(c, npops, counts = NULL, sumcounts = NULL, max_iter = 100L, d
     # PARHAAN MIXTURE-PARTITION ETSIMINEN
     nRoundTypes <- 7
     kokeiltu <- zeros(nRoundTypes, 1)
-    roundTypes <- c(1, 1) # Ykk<6B>svaiheen sykli kahteen kertaan.
+    roundTypes <- t(c(1, 1)) # Ykk<6B>svaiheen sykli kahteen kertaan.
     ready <- 0
     vaihe <- 1
 
@@ -143,9 +141,9 @@ indMix <- function(c, npops, counts = NULL, sumcounts = NULL, max_iter = 100L, d
         if (kokeiltu[round] == 1) { # Askelta kokeiltu viime muutoksen j<>lkeen
         } else if (round == 0 | round == 1) { # Yksil<69>n siirt<72>minen toiseen populaatioon.
           inds <- seq_len(ninds)
-          aputaulu <- cbind(t(inds), rand(ninds, 1))
+          aputaulu <- cbind(inds, rand(ninds, 1))
           aputaulu <- matrix(sortrows(aputaulu, 2), nrow = nrow(aputaulu))
-          inds <- t(aputaulu[, 1])
+          inds <- aputaulu[, 1]
           muutosNyt <- 0
 
           for (ind in inds) {
@@ -324,7 +322,7 @@ indMix <- function(c, npops, counts = NULL, sumcounts = NULL, max_iter = 100L, d
             if (round == 5) {
               aputaulu <- c(inds, rand(length(inds), 1))
               aputaulu <- sortrows(aputaulu, 2)
-              inds <- t(aputaulu[, 1])
+              inds <- aputaulu[, 1]
             } else if (round == 6) {
               inds <- returnInOrder(
                 inds, pop, rows, data, adjprior, priorTerm
@@ -525,15 +523,15 @@ indMix <- function(c, npops, counts = NULL, sumcounts = NULL, max_iter = 100L, d
 
       if (ready == 0) {
         if (vaihe == 1) {
-          roundTypes <- 1
+          roundTypes <- t(1)
         } else if (vaihe == 2) {
-          roundTypes <- c(2, 1)
+          roundTypes <- t(c(2, 1))
         } else if (vaihe == 3) {
-          roundTypes <- c(5, 5, 7)
+          roundTypes <- t(c(5, 5, 7))
         } else if (vaihe == 4) {
-          roundTypes <- c(4, 3, 1)
+          roundTypes <- t(c(4, 3, 1))
         } else if (vaihe == 5) {
-          roundTypes <- c(6, 7, 2, 3, 4, 1)
+          roundTypes <- t(c(6, 7, 2, 3, 4, 1))
         }
       }
     }

R/initialCounts.R

@@ -7,8 +7,8 @@ initialCounts <- function(partition, data, npops, rows, noalle, adjprior) {
 
   counts <- zeros(base::max(noalle), nloci, npops)
   sumcounts <- zeros(npops, nloci)
-  for (i in 1:npops) {
+  for (i in seq_len(npops)) {
-    for (j in 1:nloci) {
+    for (j in seq_len(nloci)) {
       havainnotLokuksessa <- matlab2r::find(partition == i & data[, j] >= 0)
       sumcounts[i, j] <- length(havainnotLokuksessa)
       for (k in 1:noalle[j]) {

R/linkage.R

@@ -26,11 +26,11 @@ linkage <- function(Y, method = "co") {
   monotonic <- 1
   Z <- zeros(m - 1, 3) # allocate the output matrix.
   N <- zeros(1, 2 * m - 1)
-  N[1:m] <- 1
+  N[seq_len(m)] <- 1
   n <- m # since m is changing, we need to save m in n.
-  R <- 1:n
+  R <- seq_len(n)
   for (s in 1:(n - 1)) {
-    X <- as.matrix(as.vector(Y), ncol = 1)
+    X <- as.matrix(as.vector(Y), nrow = 1)
     v <- matlab2r::min(X)$mins
     k <- matlab2r::min(X)$idx
 
@@ -83,11 +83,14 @@ linkage <- function(Y, method = "co") {
     )
     J <- c(J, i * (m - (i + 1) / 2) - m + j)
     Y <- Y[-J] # no need for the cluster information about j
+
     # update m, N, R
     m <- m - 1
     N[n + s] <- N[R[i]] + N[R[j]]
     R[i] <- n + s
-    R[j:(n - 1)] <- R[(j + 1):n]
+    if (j < n) {
+      R[j:(n - 1)] <- R[(j + 1):n]
+    }
   }
   return(Z)
 }