Merge branch 'computeAllFreqs2' into dev

NAMESPACE

@@ -3,6 +3,7 @@
 export(admix1)
 export(calculatePopLogml)
 export(colon)
+export(computeAllFreqs2)
 export(computeIndLogml)
 export(computePersonalAllFreqs)
 export(computeRows)

R/admix1.R

@@ -401,29 +401,3 @@ admix1 <- function(tietue) {
 # global SUMCOUNTS; SUMCOUNTS = [];
 # global PARTITION; PARTITION = [];
 # global POP_LOGML; POP_LOGML = [];
-
-# %--------------------------------------------------------
-
-
-# function allFreqs = computeAllFreqs2(noalle)
-# % Lisää a priori jokaista alleelia
-# % joka populaation joka lokukseen j 1/noalle(j) verran.
-
-# global COUNTS;
-# global SUMCOUNTS;
-
-# max_noalle = size(COUNTS,1);
-# nloci = size(COUNTS,2);
-# npops = size(COUNTS,3);
-
-# sumCounts = SUMCOUNTS+ones(size(SUMCOUNTS));
-# sumCounts = reshape(sumCounts', [1, nloci, npops]);
-# sumCounts = repmat(sumCounts, [max_noalle, 1 1]);
-
-# prioriAlleelit = zeros(max_noalle,nloci);
-# for j=1:nloci
-#     prioriAlleelit(1:noalle(j),j) = 1/noalle(j);
-# end
-# prioriAlleelit = repmat(prioriAlleelit, [1,1,npops]);
-# counts = COUNTS + prioriAlleelit;
-# allFreqs = counts./sumCounts;

R/computeAllFreqs2.R

@@ -0,0 +1,29 @@
+#' @title Compute all freqs - version 2
+#' @description Lisää a priori jokaista alleelia joka populaation joka lokukseen
+#' j 1/noalle(j) verran.
+#' @param noalle noalle
+#' @param COUNTS counts
+#' @param SUMCOUNTS sumcounts
+#' @export
+computeAllFreqs2 <- function (noalle, COUNTS = matrix(NA, 0, 0),
+    SUMCOUNTS = NA) {
+
+    max_noalle <- size(COUNTS, 1)
+    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))
+
+    prioriAlleelit <- zeros(max_noalle, nloci)
+    if (nloci > 0) {
+        for (j in 1:nloci) {
+            prioriAlleelit[1:noalle[j], j] <- 1 / noalle[j]
+        }
+    }
+    prioriAlleelit <- repmat(prioriAlleelit, c(1, 1, npops))
+    counts <- COUNTS + prioriAlleelit
+    allFreqs <- counts / sumCounts
+    return(allFreqs)
+}

R/repmat.R

@@ -3,7 +3,8 @@
 #' @details This function was created to replicate the behavior of a homonymous
 #' function on Matlab
 #' @param mx matrix
-#' @param n either a scalar with the number of replications in both rows and columns or a 2-length vector with individual repetitions.
+#' @param n either a scalar with the number of replications in both rows and
+#' columns or a <= 3-length vector with individual repetitions.
 #' @return matrix replicated over `ncol(mx) * n` columns and `nrow(mx) * n` rows
 #' @note The Matlab implementation of this function accepts `n` with length > 2.
 #'
@@ -11,7 +12,7 @@
 #' @export
 repmat <- function (mx, n) {
     # Validation
-    if (length(n) > 2) warning("Extra dimensions of n ignored")
+    if (length(n) > 3) warning("Extra dimensions of n ignored")
     if (length(n) == 1) n <- rep(n, 2)
     if (class(mx) != "matrix") mx <- as.matrix(mx)
 
@@ -23,6 +24,9 @@ repmat <- function (mx, n) {
         for (i in seq(n[1] - 1)) out <- rbind(out, mx_col)
     }
 
+    # Replicating 3rd dimension
+    if (!is.na(n[3]) & n[3] > 1) out <- array(out, c(dim(out), n[3]))
+
     # Output
-    return(unname(as.matrix(out)))
+    return(unname(as.array(out)))
 }

R/reshape.R

@@ -0,0 +1,24 @@
+#' @title Reshape array
+#' @description Reshapes a matrix according to a certain number of dimensions
+#' @param A input matrix
+#' @param sz vector containing the dimensions of the output vector
+#' @details This function replicates the functionality of the `reshape()`
+#' function on Matlab. This function is basically a fancy wrapper for the
+#' `array()` function in R, but is useful because it saves the user translation
+#' time. Moreover, it introduces validation code that alter the behavior of
+#' `array()` and makes it more similar to `replicate()`.
+#' @note The Matlab function also accepts as input the dismemberment of sz as
+#' scalars.
+reshape <- function(A, sz) {
+    # Validation
+    if (prod(sz) != prod(dim(A))) {
+        stop("To RESHAPE the number of elements must not change.")
+    }
+    if (length(sz) == 1) {
+        stop("Size vector must have at least two elements.")
+    }
+
+    # Reshaping A
+    A <- array(A, sz)
+    return(A)
+}

man/computeAllFreqs2.Rd

@@ -0,0 +1,19 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/computeAllFreqs2.R
+\name{computeAllFreqs2}
+\alias{computeAllFreqs2}
+\title{Compute all freqs - version 2}
+\usage{
+computeAllFreqs2(noalle, COUNTS = matrix(NA, 0, 0), SUMCOUNTS = sum(COUNTS))
+}
+\arguments{
+\item{noalle}{noalle}
+
+\item{COUNTS}{counts}
+
+\item{SUMCOUNTS}{sumcounts}
+}
+\description{
+Lisää a priori jokaista alleelia joka populaation joka lokukseen
+j 1/noalle(j) verran.
+}

man/reshape.Rd

@@ -0,0 +1,27 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/reshape.R
+\name{reshape}
+\alias{reshape}
+\title{Reshape array}
+\usage{
+reshape(A, sz)
+}
+\arguments{
+\item{A}{input matrix}
+
+\item{sz}{vector containing the dimensions of the output vector}
+}
+\description{
+Reshapes a matrix according to a certain number of dimensions
+}
+\details{
+This function replicates the functionality of the `reshape()`
+function on Matlab. This function is basically a fancy wrapper for the
+`array()` function in R, but is useful because it saves the user translation
+time. Moreover, it introduces validation code that alter the behavior of
+`array()` and makes it more similar to `replicate()`.
+}
+\note{
+The Matlab function also accepts as input the dismemberment of sz as
+scalars.
+}

man/simulateAllFreqs.Rd

@@ -4,7 +4,7 @@
 \alias{simulateAllFreqs}
 \title{Simulate All Frequencies}
 \usage{
-simulateAllFreqs(noalle, COUNTS = matrix())
+simulateAllFreqs(noalle, COUNTS = matrix(NA, 0, 0))
 }
 \arguments{
 \item{noalle}{noalle}

tests/testthat/test-admix1.R

@@ -224,3 +224,7 @@ test_that("simulateAllFreqs works as expected", {
         expected = empty_mt
     )
 })
+
+test_that("computeAllFreqs2 works as expected", {
+    expect_equivalent(computeAllFreqs2(10), matrix(NA, 0, 0))
+})

tests/testthat/test-convertedBaseFunctions.R

@@ -28,6 +28,10 @@ test_that("repmat works properly", {
         object = repmat(mx2, c(4, 1)),
         expected = rbind(mx2, mx2, mx2, mx2)
     )
+    expect_equal(
+        object = repmat(mx2, c(1, 1, 2)),
+        expected = array(mx2, c(2, 2, 2))
+    )
 })
 
 test_that("zeros and ones work as expected", {
@@ -85,3 +89,14 @@ test_that("size works as on MATLAB", {
     expect_equal(size(ra, 2), 3)
     expect_equal(size(ra, 3), 4)
 })
+
+test_that("reshape reshapes properly", {
+    mx <- matrix(1:4, 2)
+    ra <- array(1:12, c(2, 3, 2))
+    expect_equal(reshape(mx, c(1, 4)), matrix(1:4, 1))
+    expect_equal(reshape(mx, c(2, 2)), mx)
+    expect_equal(reshape(mx, c(1, 1, 4)), array(mx, c(1, 1, 4)))
+    expect_error(reshape(mx, c(1, 2, 3)))
+    expect_error(reshape(ra, c(1, 2, 3)))
+    expect_equal(reshape(ra, c(3, 2, 2)), array(ra, c(3, 2, 2)))
+})