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) {
+    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])

inst/ext/BAPS_format_clustering_diploid.txt

@@ -0,0 +1,10 @@
+-9 102 56 80 100 90 118 90 88 104 1
+-9 102 54 82 102 92 116 90 86 104 1
+88 104 56 84 102 -9 120 90 88 100 2
+86 102 56 80 102 -9 116 90 86 100 2
+88 102 54 80 102 90 116 92 -9 100 3
+88 102 56 80 100 90 118 90 -9 104 3
+80 102 54 82 102 92 116 90 86 104 4
+88 104 56 84 102 92 120 90 88 100 4
+86 102 56 80 -9 90 116 90 86 100 5
+88 102 54 80 -9 90 116 92 86 100 5

man/isGlobalEmpty.Rd

@@ -0,0 +1,23 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/isGlobalEmpty.R
+\name{isGlobalEmpty}
+\alias{isGlobalEmpty}
+\title{Check if global variable is empty}
+\usage{
+isGlobalEmpty(g)
+}
+\arguments{
+\item{g}{the global variable in quesiton.}
+}
+\value{
+TRUE if the variable still contains its original values, FALSE otherwise.
+}
+\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.
+}
+\author{
+Waldir Leoncio
+}

tests/testthat/test-greedyMix.R

@@ -1,13 +1,17 @@
 context("Auxiliary functions to greedyMix")
 
+# Defining the relative path to current inst ------------- #
+if (interactive()) {
+	path_inst <- "../../inst/ext/"
+} else {
+	path_inst <- "inst/ext/"
+}
 baps_diploid <- read.delim(
-	"inst/ext/ExamplesDataFormatting/Example data in BAPS format for clustering of diploid individuals.txt",
+	file = file.path(path_inst, "BAPS_format_clustering_diploid.txt"),
 	sep = " ",
 	header = FALSE
 )
 
-handleData(baps_diploid)$newData
-
 test_that("handleData works as expected", {
 	data_obs <- handleData(baps_diploid)$newData
 	data_exp <- matrix(
@@ -31,12 +35,13 @@ test_that("handleData works as expected", {
 
 context("Opening files on greedyMix")
 
-# TODO: needs #12 to be fixed before this can be done without user intervention
-greedyMix(
-	tietue = "inst/ext/ExamplesDataFormatting/Example data in BAPS format for clustering of diploid individuals.txt",
-	format = "BAPS",
-	savePreProcessed = FALSE
-) # Upper bounds 100 100
+# # TODO: needs #12 to be fixed before this can be done without user intervention
+# greedyMix(
+# 	tietue = "inst/ext/ExamplesDataFormatting/Example data in BAPS format for clustering of diploid individuals.txt",
+# 	format = "BAPS",
+# 	savePreProcessed = FALSE
+# ) # Upper bounds 100 100
+# TODO: replace with load_fasta()
 
 context("Linkage")