Added computeRows

NAMESPACE

@@ -2,5 +2,7 @@
 
 export(admix1)
 export(calculatePopLogml)
+export(computeRows)
 export(learn_simple_partition)
 export(ownNum2Str)
+export(repmat)

R/admix1.R

@@ -752,21 +752,4 @@ admix1 <- function(tietue) {
 # for i=1:nc
 #    svar(i,1)=randga(counts(i,1),1);
 # end
-# svar=svar/sum(svar);
+# svar=svar/sum(svar);
-
-# %-------------------------------------------------------------------------------------
-
-
-# function rows = computeRows(rowsFromInd, inds, ninds)
-# % Individuals inds have been given. The function returns a vector,
-# % containing the indices of the rows, which contain data from the
-# % individuals.
-
-# rows = inds(:, ones(1,rowsFromInd));
-# rows = rows*rowsFromInd;
-# miinus = repmat(rowsFromInd-1 : -1 : 0, [ninds 1]);
-# rows = rows - miinus;
-# rows = reshape(rows', [1,rowsFromInd*ninds]);
-
-# %--------------------------------------------------------------------------
-# %-----

R/computeRows.R

@@ -0,0 +1,22 @@
+#' @title Compute rows
+#' @description Individuals inds have been given. The function returns a vector,
+#' containing the indices of the rows, which contain data from the individuals.
+#' @param rowsFromInd rowsFromInd
+#' @param inds matrix
+#' @param ninds ninds
+#' @export
+computeRows <- function(rowsFromInd, inds, ninds) {
+    if (identical(dim(inds), c(nrow(inds), 1L))) {
+        # Special treatment for vectors because R has col vectors by default,
+        # whereas Matlab has row vectors by default.
+        inds <- t(inds)
+        if (ninds == 0) return(matrix(, 1, 0))
+    }
+    rows <- inds[, rep(1, rowsFromInd)]
+    rows <- rows * rowsFromInd
+    miinus <- repmat((rowsFromInd - 1):0, c(1, ninds))
+    rows <- rows - miinus
+    rows <- matrix(t(rows), c(1, rowsFromInd * ninds))
+    return(t(rows))
+}
+

R/repmat.R

@@ -0,0 +1,18 @@
+#' @title Repeat matrix
+#' @description Repeats a matrix over n columns and rows
+#' @details This function was created to replicate the behavior of a homonymous
+#' function on Matlab
+#' @param mx matrix
+#' @param n either a scalat with the number of replications in both rows and columns or a 2-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.
+#' @export
+repmat <- function (mx, n) {
+    if (length(n) > 2) warning("Extra dimensions of n ignored")
+    if (length(n) == 1) n <- rep(n, 2)
+    out <- mx_cols <- rep(mx, n[1])
+    if (n[2] > 1) {
+        for (i in seq(n[2] - 1)) out <- rbind(out, mx_cols)
+    }
+    return(unname(as.matrix(out)))
+}

TODO.md

@@ -23,9 +23,8 @@ The list below contains non-essential but nice-to-have tasks for the next stable
 
 The following behavioral differences have been detected between the Matlab functions and their R counterparts. In order to save time, these differences will not be addressed, since they could require extensive reworking of a function. However, such differences may very well cause unexpected problems in some situations, which is why compiling this list is so important. The list below might provide a good starting point for identifying and fixing bugs:
 
-## `ownNum2Str`
+Function | Argument | Value | Matlab output | R output
-
+---------|----------|-------|---------------|---------
-Argument | Value | Matlab output | R output
+`ownNum2Str` | `number` | `NaN` | `'NAN'` | error
----------|-------|---------------|---------
+`ownNum2Str` | `number` | `<vector>` | `'<vector elements>'` | `'<vector elements>'` + warning
-`number` | `'NaN` | `'NAN'` | error
+`repmat` | `length(n)` | `> 2` | > 2D matrix | 2D matrix
-`number` | `<vector>` | `'<vector elements>'` | `'<vector elements>'` + warning

man/computeRows.Rd

@@ -0,0 +1,19 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/computeRows.R
+\name{computeRows}
+\alias{computeRows}
+\title{Compute rows}
+\usage{
+computeRows(rowsFromInd, inds, ninds)
+}
+\arguments{
+\item{rowsFromInd}{rowsFromInd}
+
+\item{inds}{matrix}
+
+\item{ninds}{ninds}
+}
+\description{
+Individuals inds have been given. The function returns a vector,
+containing the indices of the rows, which contain data from the individuals.
+}

man/repmat.Rd

@@ -0,0 +1,26 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/repmat.R
+\name{repmat}
+\alias{repmat}
+\title{Repeat matrix}
+\usage{
+repmat(mx, n)
+}
+\arguments{
+\item{mx}{matrix}
+
+\item{n}{either a scalat with the number of replications in both rows and columns or a 2-length vector with individual repetitions.}
+}
+\value{
+matrix replicated over `ncol(mx) * n` columns and `nrow(mx) * n` rows
+}
+\description{
+Repeats a matrix over n columns and rows
+}
+\details{
+This function was created to replicate the behavior of a homonymous
+function on Matlab
+}
+\note{
+The Matlab implementation of this function accepts `n` with length > 2.
+}

tests/testthat/test-admix1.R

@@ -42,4 +42,63 @@ test_that("ownNum2Str behaves like on Matlab", {
     expect_equal(ownNum2Str(-123456789), "-123456789")
     expect_equal(ownNum2Str(0), "0")
     expect_error(ownNum2Str("a"))
+})
+
+test_that("computeRows behaves like on Matlab", {
+    # Matrices
+    X <- matrix(1:9, 3, byrow = TRUE)
+    Y <- matrix(9:1, 3, byrow = TRUE)
+    Z <- matrix(c(-8, 2, -4, 0), byrow = TRUE)
+    expect_equal(
+        object   = computeRows(1, X, 3),
+        expected = matrix(c(1, 4, 7))
+    )
+    expect_equal(
+        object   = computeRows(2, X, 3),
+        expected = matrix(c(1, 2, 7, 8, 13, 14))
+    )
+    expect_equal(
+        object   = computeRows(10, X, 3),
+        expected = matrix(c(1:10, 31:40, 61:70))
+    )
+    expect_equal(
+        object   = computeRows(100, X, 3),
+        expected = matrix(c(1:100, 301:400, 601:700))
+    )
+    expect_equal(
+        object   = computeRows(1, Y, 3),
+        expected = matrix(c(9, 6, 3))
+    )
+    expect_equal(
+        object   = computeRows(2, Y, 3),
+        expected = matrix(c(17, 18, 11, 12, 5, 6))
+    )
+    expect_equal(
+        object   = computeRows(10, Y, 3),
+        expected = matrix(c(81:90, 51:60, 21:30))
+    )
+    expect_equal(
+        object   = computeRows(1, Z, 0),
+        expected = matrix(, 1, 0)
+    )
+    expect_equal(
+        object   = computeRows(1, Z, 5),
+        expected = matrix(rep(-8, 5))
+    )
+    expect_equal(
+        object   = computeRows(2, Z, 1),
+        expected = matrix(rep(c(-17, -16), 1))
+    )
+    expect_equal(
+        object   = computeRows(2, Z, 3),
+        expected = matrix(rep(c(-17, -16), 3))
+    )
+    expect_equal(
+        object   = computeRows(3, Z, 1),
+        expected = matrix(rep(-26:-24, 1))
+    )
+    expect_equal(
+        object   = computeRows(3, Z, 10),
+        expected = matrix(rep(-26:-24, 10))
+    )
 })