diff --git a/R/cell.R b/R/cell.R index c98a0dc..a3cdedd 100644 --- a/R/cell.R +++ b/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 { diff --git a/R/computeAllFreqs2.R b/R/computeAllFreqs2.R index e90d358..f34f2dd 100644 --- a/R/computeAllFreqs2.R +++ b/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) } \ No newline at end of file diff --git a/R/computePersonalAllFreqs.R b/R/computePersonalAllFreqs.R index 4a301cd..6eac938 100644 --- a/R/computePersonalAllFreqs.R +++ b/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]) diff --git a/R/isGlobalEmpty.R b/R/isGlobalEmpty.R new file mode 100644 index 0000000..4731965 --- /dev/null +++ b/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) +} \ No newline at end of file diff --git a/R/laskeMuutokset12345.R b/R/laskeMuutokset12345.R index e67ed2c..795f6ab 100644 --- a/R/laskeMuutokset12345.R +++ b/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]) diff --git a/R/simulateAllFreqs.R b/R/simulateAllFreqs.R index 8097ba3..2c7e0b0 100644 --- a/R/simulateAllFreqs.R +++ b/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) { diff --git a/R/suoritaMuutos.R b/R/suoritaMuutos.R index 9f94434..dc495f1 100644 --- a/R/suoritaMuutos.R +++ b/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]) diff --git a/inst/ext/BAPS_format_clustering_diploid.txt b/inst/ext/BAPS_format_clustering_diploid.txt new file mode 100644 index 0000000..c4b064e --- /dev/null +++ b/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 diff --git a/man/isGlobalEmpty.Rd b/man/isGlobalEmpty.Rd new file mode 100644 index 0000000..6c45ecb --- /dev/null +++ b/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 +} diff --git a/tests/testthat/test-greedyMix.R b/tests/testthat/test-greedyMix.R index 96b7d1d..7ba13ba 100644 --- a/tests/testthat/test-greedyMix.R +++ b/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")