Added computeRows

This commit is contained in:
Waldir Leoncio 2019-12-17 10:53:59 +01:00
parent 680739bccc
commit 44c0769837
8 changed files with 152 additions and 24 deletions

View file

@ -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]);
# %--------------------------------------------------------------------------
# %-----
# svar=svar/sum(svar);

22
R/computeRows.R Normal file
View file

@ -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))
}

18
R/repmat.R Normal file
View file

@ -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)))
}