Added computeRows
This commit is contained in:
parent
680739bccc
commit
44c0769837
8 changed files with 152 additions and 24 deletions
19
R/admix1.R
19
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]);
|
||||
|
||||
# %--------------------------------------------------------------------------
|
||||
# %-----
|
||||
# svar=svar/sum(svar);
|
||||
22
R/computeRows.R
Normal file
22
R/computeRows.R
Normal 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
18
R/repmat.R
Normal 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)))
|
||||
}
|
||||
Loading…
Add table
Add a link
Reference in a new issue