Added function with minimal testing

NAMESPACE

@@ -4,6 +4,7 @@ export(admix1)
 export(calculatePopLogml)
 export(colon)
 export(computeIndLogml)
+export(computePersonalAllFreqs)
 export(computeRows)
 export(etsiParas)
 export(laskeMuutokset4)

R/admix1.R

@@ -486,38 +486,4 @@ admix1 <- function(tietue) {
 # cumsumma = cumsum(freqs);
 # arvo = rand;
 # isommat = find(cumsumma>arvo);
-# all = min(isommat);
+# all = min(isommat);
-
-
-# %--------------------------------------------------------------------------
-
-
-# function omaFreqs = computePersonalAllFreqs(ind, data, allFreqs, rowsFromInd)
-# % Laskee npops*(rowsFromInd*nloci) taulukon, jonka kutakin saraketta
-# % vastaa yksilön ind alleeli. Eri rivit ovat alleelin alkuperäfrekvenssit
-# % eri populaatioissa. Jos yksilölt?puuttuu jokin alleeli, niin vastaavaan
-# % kohtaa tulee sarake ykkösi?
-
-# global COUNTS;
-# nloci = size(COUNTS,2);
-# npops = size(COUNTS,3);
-
-# rows = data(computeRows(rowsFromInd, ind, 1),:);
-
-# omaFreqs = zeros(npops, (rowsFromInd*nloci));
-# pointer = 1;
-# for loc=1:size(rows,2)
-#     for all=1:size(rows,1)
-#         if rows(all,loc)>=0
-#             try,
-#             omaFreqs(:,pointer) = ...
-#                 reshape(allFreqs(rows(all,loc),loc,:), [npops,1]);
-#             catch
-#                 a=0;
-#             end
-#         else
-#             omaFreqs(:,pointer) = ones(npops,1);
-#         end
-#         pointer = pointer+1;
-#     end
-# end

R/computePersonalAllFreqs.R

@@ -0,0 +1,42 @@
+#' @title Compute Personal Freqs
+#' @description Laskee npops*(rowsFromInd*nloci) taulukon, jonka kutakin
+#' saraketta vastaa yksilön ind alleeli. Eri rivit ovat alleelin
+#' alkuperäfrekvenssit eri populaatioissa. Jos yksilölt?puuttuu jokin alleeli, 
+#' niin vastaavaan kohtaa tulee sarake ykkösi?
+#' @param ind ind
+#' @param data data
+#' @param allFreqs allFreqs
+#' @param rowsFromInd rowsFromInd
+#' @param COUNTS COUNTS
+#' @export
+
+computePersonalAllFreqs <- function(ind, data, allFreqs, rowsFromInd,
+COUNTS = matrix(0)) {
+    nloci <- ifelse(is.na(dim(COUNTS)[2]), 1, dim(COUNTS)[2])
+    npops <- ifelse(is.na(dim(COUNTS)[3]), 1, dim(COUNTS)[3])
+
+    rows <- as.matrix(t(data))[computeRows(rowsFromInd, ind, 1), , drop = FALSE]
+
+    omaFreqs <- zeros(npops, rowsFromInd * nloci)
+    pointer <- 1
+    for (loc in 1:dim(rows)[2]) {
+        for (all in 1:dim(rows)[1]) {
+            if (rows[all, loc] >= 0) {
+                if (pointer > ncol(omaFreqs)) omaFreqs <- cbind(omaFreqs, 0)
+                omaFreqs[, pointer] <- tryCatch(
+                    matrix(
+                        data = as.matrix(t(allFreqs))[rows[all, loc], loc],
+                        nrow = npops
+                    ),
+                    error = function(e) return(NA)
+                )
+            } else {
+                omaFreqs[, pointer] <- ones(npops, 1)
+            }
+            # omaFreqs <- unname(cbind(omaFreqs, new_omaFreqs))
+            pointer <- pointer + 1
+        }
+    }
+    omaFreqs <- omaFreqs[, !is.na(omaFreqs)]
+    return(omaFreqs)
+}

man/computePersonalAllFreqs.Rd

@@ -0,0 +1,25 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/computePersonalAllFreqs.R
+\name{computePersonalAllFreqs}
+\alias{computePersonalAllFreqs}
+\title{Compute Personal Freqs}
+\usage{
+computePersonalAllFreqs(ind, data, allFreqs, rowsFromInd, COUNTS = matrix(0))
+}
+\arguments{
+\item{ind}{ind}
+
+\item{data}{data}
+
+\item{allFreqs}{allFreqs}
+
+\item{rowsFromInd}{rowsFromInd}
+
+\item{COUNTS}{COUNTS}
+}
+\description{
+Laskee npops*(rowsFromInd*nloci) taulukon, jonka kutakin
+saraketta vastaa yksilön ind alleeli. Eri rivit ovat alleelin
+alkuperäfrekvenssit eri populaatioissa. Jos yksilölt?puuttuu jokin alleeli, 
+niin vastaavaan kohtaa tulee sarake ykkösi?
+}

tests/testthat/test-admix1.R

@@ -171,4 +171,9 @@ test_that("etsiParas works like on Matlab", {
         expected = c(7.4, 0, complex(real = 1.8563, imaginary = 3.1416)),
         tol = .0001
     )
+})
+
+test_that("computePersonalAllFreqs works like on Matlab", {
+    expect_equal(computePersonalAllFreqs(1, 1:4, c(15, 5, 10, 40), 1), 15)
+    # TODO: test with 2x2 matrix
 })