From 44c07698370125e701872d2e5d83965e134c5872 Mon Sep 17 00:00:00 2001 From: Waldir Leoncio Date: Tue, 17 Dec 2019 10:53:59 +0100 Subject: [PATCH] Added computeRows --- NAMESPACE | 2 ++ R/admix1.R | 19 +----------- R/computeRows.R | 22 ++++++++++++++ R/repmat.R | 18 +++++++++++ TODO.md | 11 +++---- man/computeRows.Rd | 19 ++++++++++++ man/repmat.Rd | 26 ++++++++++++++++ tests/testthat/test-admix1.R | 59 ++++++++++++++++++++++++++++++++++++ 8 files changed, 152 insertions(+), 24 deletions(-) create mode 100644 R/computeRows.R create mode 100644 R/repmat.R create mode 100644 man/computeRows.Rd create mode 100644 man/repmat.Rd diff --git a/NAMESPACE b/NAMESPACE index cb4db89..4b0f262 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,5 +2,7 @@ export(admix1) export(calculatePopLogml) +export(computeRows) export(learn_simple_partition) export(ownNum2Str) +export(repmat) diff --git a/R/admix1.R b/R/admix1.R index 5ffc284..4453b16 100644 --- a/R/admix1.R +++ b/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); - -# %------------------------------------------------------------------------------------- - - -# 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]); - -# %-------------------------------------------------------------------------- -# %----- \ No newline at end of file +# svar=svar/sum(svar); \ No newline at end of file diff --git a/R/computeRows.R b/R/computeRows.R new file mode 100644 index 0000000..447e5ef --- /dev/null +++ b/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)) +} + diff --git a/R/repmat.R b/R/repmat.R new file mode 100644 index 0000000..45c23cd --- /dev/null +++ b/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))) +} \ No newline at end of file diff --git a/TODO.md b/TODO.md index 6f71a14..f8522f6 100644 --- a/TODO.md +++ b/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` - -Argument | Value | Matlab output | R output ----------|-------|---------------|--------- -`number` | `'NaN` | `'NAN'` | error -`number` | `` | `''` | `''` + warning \ No newline at end of file +Function | Argument | Value | Matlab output | R output +---------|----------|-------|---------------|--------- +`ownNum2Str` | `number` | `NaN` | `'NAN'` | error +`ownNum2Str` | `number` | `` | `''` | `''` + warning +`repmat` | `length(n)` | `> 2` | > 2D matrix | 2D matrix \ No newline at end of file diff --git a/man/computeRows.Rd b/man/computeRows.Rd new file mode 100644 index 0000000..9ce5a6c --- /dev/null +++ b/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. +} diff --git a/man/repmat.Rd b/man/repmat.Rd new file mode 100644 index 0000000..b17bddc --- /dev/null +++ b/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. +} diff --git a/tests/testthat/test-admix1.R b/tests/testthat/test-admix1.R index a9820bf..af3ab1d 100644 --- a/tests/testthat/test-admix1.R +++ b/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)) + ) }) \ No newline at end of file