Several fixes to code to pass unit tests

R/cell.R

@@ -7,11 +7,27 @@
 #' @param ... Other dimensions
 #' @return An array of zeroes with the dimensions passed on call
 cell <- function(n, sz = c(n, n), expandable=FALSE, ...) {
-	if (expandable) {
+
+	# Uglyly figuring out if the third arg is an extra dim --- #
+
+	sz3 <- vector()
+	if (!is.logical(expandable)) {
+		sz3 <- expandable
+		expandable <- FALSE
+	}
+	args <- c(as.list(environment()), list(...))
+	exp <- args$expandable
+	extra_dims <- c(sz3, args[names(args) == ""])
+
+	# Creating output vector --------------------------------- #
+
+	if (exp) {
 		return(vector("list", length = n))
 	}
-	if (length(sz) == 1 & missing(...)) {
+	if (length(sz) == 1 & length(extra_dims) == 0) {
 		return(array(0, dim = c(n, sz)))
+	} else if (length(extra_dims) > 0) {
+		return(array(0, dim = c(n, sz, extra_dims)))
 	} else if (length(sz) == 2) {
 		return(array(0, dim = sz))
 	} else {

R/computeAllFreqs2.R

@@ -4,11 +4,11 @@
 #' @param noalle noalle
 #' @export
 computeAllFreqs2 <- function (noalle) {
-
+    COUNTS <- ifelse(isGlobalEmpty(COUNTS), vector(), COUNTS)
+    SUMCOUNTS <- ifelse(isGlobalEmpty(SUMCOUNTS), vector(), COUNTS)
     max_noalle <- size(COUNTS, 1)
-    nloci <- size(COUNTS,2)
-    npops <- size(COUNTS,3)
-
+    nloci <- size(COUNTS, 2)
+    npops <- size(COUNTS, 3)
     sumCounts <- SUMCOUNTS + ones(size(SUMCOUNTS))
     sumCounts <- reshape(t(sumCounts), c(1, nloci, npops))
     sumCounts <- repmat(sumCounts, c(max_noalle, 1, 1))
@@ -20,7 +20,11 @@ computeAllFreqs2 <- function (noalle) {
         }
     }
     prioriAlleelit <- repmat(prioriAlleelit, c(1, 1, npops))
-    counts <- COUNTS + prioriAlleelit
+    counts <- ifelse(
+        test = isGlobalEmpty(COUNTS),
+        yes  = prioriAlleelit,
+        no   = COUNTS + prioriAlleelit
+    )
     allFreqs <- counts / drop(sumCounts)
     return(allFreqs)
 }

R/computePersonalAllFreqs.R

@@ -10,7 +10,7 @@
 #' @export
 
 computePersonalAllFreqs <- function(ind, data, allFreqs, rowsFromInd) {
-    if (is.null(dim(COUNTS))) {
+    if (isGlobalEmpty(COUNTS)) {
         nloci <- npops <- 1
     } else {
         nloci <- ifelse(is.na(dim(COUNTS)[2]), 1, dim(COUNTS)[2])

R/isGlobalEmpty.R

@@ -0,0 +1,9 @@
+#' @title Check if global variable is empty
+#' @description Checks if a global variable has been filled with values other than their initial ones.
+#' @details For a list of global variables, check the \code{globals.R} file.
+#' @param g the global variable in quesiton.
+#' @return TRUE if the variable still contains its original values, FALSE otherwise.
+#' @author Waldir Leoncio
+isGlobalEmpty <- function(g) {
+	return(sum(g) == 0 & sd(g) == 0)
+}

R/laskeMuutokset12345.R

@@ -9,7 +9,7 @@
 #' @param logml log maximum likelihood
 #' @export
 laskeMuutokset4 <- function (osuus, osuusTaulu, omaFreqs, logml) {
-	if (is.null(dim(COUNTS))) {
+	if (isGlobalEmpty(COUNTS)) {
 		npops <- 1
 	} else {
 		npops <- ifelse(is.na(dim(COUNTS)[3]), 1, dim(COUNTS)[3])

R/simulateAllFreqs.R

@@ -5,9 +5,15 @@
 #' @export
 
 simulateAllFreqs <- function(noalle) {
-    max_noalle <- size(COUNTS, 1)
-    nloci <- size(COUNTS, 2)
-    npops <- size(COUNTS, 3)
+    if (isGlobalEmpty(COUNTS)) {
+        max_noalle <- 0
+        nloci <- 0
+        npops <- 1
+    } else {
+        max_noalle <- size(COUNTS, 1)
+        nloci <- size(COUNTS, 2)
+        npops <- size(COUNTS, 3)
+    }
 
     prioriAlleelit <- zeros(max_noalle, nloci)
     if (nloci > 0) {
@@ -16,7 +22,11 @@ simulateAllFreqs <- function(noalle) {
         }
     }
     prioriAlleelit <- repmat(prioriAlleelit, matrix(c(1, 1, npops), 1))
-    counts <- COUNTS + prioriAlleelit
+    counts <- ifelse(
+        test = isGlobalEmpty(COUNTS),
+        yes  = prioriAlleelit,
+        no   = COUNTS + prioriAlleelit
+    )
     allfreqs <- zeros(size(counts))
 
     for (i in 1:npops) {

R/suoritaMuutos.R

@@ -5,7 +5,7 @@
 #' @param indeksi index
 #' @export
 suoritaMuutos <- function (osuusTaulu, osuus, indeksi) {
-	if (is.null(dim(COUNTS))) {
+	if (isGlobalEmpty(COUNTS)) {
 		npops <- 1
 	} else {
 		npops <- ifelse(is.na(dim(COUNTS)[3]), 1, dim(COUNTS)[3])