Merge branch 'simulateAllFreqs' into dev

NAMESPACE

@@ -14,8 +14,10 @@ export(proportion2str)
 export(rand)
 export(randdir)
 export(repmat)
+export(simulateAllFreqs)
 export(simulateIndividuals)
 export(simuloiAlleeli)
+export(size)
 export(suoritaMuutos)
 export(times)
 importFrom(stats,runif)

R/admix1.R

@@ -426,31 +426,4 @@ admix1 <- function(tietue) {
 # end
 # prioriAlleelit = repmat(prioriAlleelit, [1,1,npops]);
 # counts = COUNTS + prioriAlleelit;
-# allFreqs = counts./sumCounts;
-
-
-# function allfreqs = simulateAllFreqs(noalle)
-# % Lisää jokaista alleelia joka populaation joka lokukseen j 1/noalle(j)
-# % verran. Näin saatuja counts:eja vastaavista Dirichlet-jakaumista
-# % simuloidaan arvot populaatioiden alleelifrekvensseille.
-
-# global COUNTS;
-
-# max_noalle = size(COUNTS,1);
-# nloci = size(COUNTS,2);
-# npops = size(COUNTS,3);
-
-# 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 = zeros(size(counts));
-
-# for i=1:npops
-#     for j=1:nloci
-#         simuloidut = randdir(counts(1:noalle(j),j,i) , noalle(j));
-#         allfreqs(1:noalle(j),j,i) = simuloidut;
-#     end
-# end
+# allFreqs = counts./sumCounts;

R/simulateAllFreqs.R

@@ -0,0 +1,32 @@
+#' @title Simulate All Frequencies
+#' @description Lisää jokaista alleelia joka populaation joka lokukseen j1/noalle(j) verran. Näin saatuja counts:eja vastaavista Dirichlet-jakaumista simuloidaan arvot populaatioiden alleelifrekvensseille.
+#' Add each allele to each locus in each population by j 1 / noalle(j). The Dirichlet distributions corresponding to the counts thus obtained simulate values for the allele frequencies of the populations.
+#' @param noalle noalle
+#' @param COUNTS COUNTS
+#' @export
+
+simulateAllFreqs <- function(noalle, COUNTS = matrix(NA, 0, 0)) {
+    max_noalle <- size(COUNTS, 1)
+    nloci <- size(COUNTS, 2)
+    npops <- size(COUNTS, 3)
+
+    prioriAlleelit <- zeros(max_noalle, nloci)
+    if (nloci > 0) {
+        for (j in 1:nloci) {
+            prioriAlleelit[1:noalle[j], j] <- 1 / noalle[j]
+        }
+    }
+    prioriAlleelit <- repmat(prioriAlleelit, matrix(c(1, 1, npops), 1))
+    counts <- COUNTS + prioriAlleelit
+    allfreqs <- zeros(size(counts))
+
+    for (i in 1:npops) {
+        if (nloci > 0) {
+            for (j in 1:nloci) {
+                simuloidut <- randdir(counts[1:noalle[j], j, i] , noalle[j])
+                allfreqs[1:noalle[j], j, i] <- simuloidut
+            }
+        }
+    }
+    return(allfreqs)
+}

R/size.R

@@ -7,8 +7,16 @@
 #' default behavior is more reasonable in those cases (i.e., returning NA),
 #' but since the point of this function is to replicate MATLAB behaviors
 #' (bugs and questionable behaviors included), this function also does this.
+#' @export
 size <- function(x, d) {
     # Determining the number of dimensions
+    if (all(is.na(x))) {
+        if (missing(d)) {
+            return(c(0, 0))
+        } else {
+            return(ifelse(d <= 2, 0, 1))
+        }
+    }
     if (length(x) == 1) {
         # x is surely a scalar
         return(1)

man/simulateAllFreqs.Rd

@@ -0,0 +1,17 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/simulateAllFreqs.R
+\name{simulateAllFreqs}
+\alias{simulateAllFreqs}
+\title{Simulate All Frequencies}
+\usage{
+simulateAllFreqs(noalle, COUNTS = matrix())
+}
+\arguments{
+\item{noalle}{noalle}
+
+\item{COUNTS}{COUNTS}
+}
+\description{
+Lisää jokaista alleelia joka populaation joka lokukseen j1/noalle(j) verran. Näin saatuja counts:eja vastaavista Dirichlet-jakaumista simuloidaan arvot populaatioiden alleelifrekvensseille.
+Add each allele to each locus in each population by j 1 / noalle(j). The Dirichlet distributions corresponding to the counts thus obtained simulate values for the allele frequencies of the populations.
+}

tests/testthat/test-admix1.R

@@ -182,21 +182,23 @@ test_that("computePersonalAllFreqs works like on Matlab", {
 })
 
 test_that("simuloiAlleeli works like on Matlab", {
-    # TODO: test on vector
-    sk1 <- 2
-    ra1 <- array(1:12, c(2, 2, 3))
+    sk <- 2
+    vk <- 1:3
+    ra <- array(1:12, c(2, 2, 3))
     mx1 <- matrix(c(3, 5, 0, 9), 2)
     mx2 <- matrix(c(3, 5, 0, 9, 5, 8), 2)
-    expect_equal(simuloiAlleeli(sk1, 1, 1), 1)
-    expect_equal(simuloiAlleeli(ra1, 2, 1), 1)
+    expect_equal(simuloiAlleeli(sk, 1, 1), 1)
+    expect_equal(simuloiAlleeli(vk, 1, 2), 1)
+    expect_equal(simuloiAlleeli(ra, 2, 1), 1)
     expect_equal(simuloiAlleeli(mx1, 1, 2), 2)
     expect_equal(simuloiAlleeli(mx2, 1, 3), 1)
 })
 
 test_that("simulateIndividuals works like on Matlab", {
+    set.seed(2)
     expect_equal(
-        object = simulateIndividuals(1, 3, 2, 0, .1),
-        expected = matrix(rep(-999, 3), 3)
+        object = simulateIndividuals(1, 3, 2, 0, .2),
+        expected = matrix(c(1, -999, 1), ncol = 1)
     )
     expect_equal(
         object = simulateIndividuals(5, 3, 1:3, 4, 0),
@@ -211,4 +213,14 @@ test_that("simulateIndividuals works like on Matlab", {
         object = sum(simulateIndividuals(3, 3, 2, 1, .5) == 1),
         expected = 6
     )
+})
+
+test_that("simulateAllFreqs works as expected", {
+    empty_mt <- matrix(NA, 0, 0)
+    expect_equivalent(suppressWarnings(simulateAllFreqs(3)), empty_mt)
+    expect_equivalent(suppressWarnings(simulateAllFreqs(3:5)), empty_mt)
+    expect_equivalent(
+        object = suppressWarnings(simulateAllFreqs(matrix(1:4, 2))),
+        expected = empty_mt
+    )
 })