max/ourMELONS
1
0
Fork 0
Code Issues 1 Pull requests Projects Releases Packages Wiki Activity Actions

Added support for 3D arrays

Browse source
This commit is contained in:
Waldir Leoncio 2020-02-25 14:28:54 +01:00
parent 37822b2ec8
commit a4143ba786
2 changed files with 12 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
R/repmat.R
View file

@ -3,7 +3,8 @@
#' @details This function was created to replicate the behavior of a homonymous #' @details This function was created to replicate the behavior of a homonymous
#' function on Matlab #' function on Matlab
#' @param mx matrix #' @param mx matrix
#' @param n either a scalar with the number of replications in both rows and columns or a 2-length vector with individual repetitions. #' @param n either a scalar with the number of replications in both rows and
#' columns or a <= 3-length vector with individual repetitions.
#' @return matrix replicated over `ncol(mx) * n` columns and `nrow(mx) * n` rows #' @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. #' @note The Matlab implementation of this function accepts `n` with length > 2.
#' #'
@ -11,7 +12,7 @@
#' @export #' @export
repmat <- function (mx, n) { repmat <- function (mx, n) {
# Validation # Validation
if (length(n) > 2) warning("Extra dimensions of n ignored") if (length(n) > 3) warning("Extra dimensions of n ignored")
if (length(n) == 1) n <- rep(n, 2) if (length(n) == 1) n <- rep(n, 2)
if (class(mx) != "matrix") mx <- as.matrix(mx) if (class(mx) != "matrix") mx <- as.matrix(mx)
@ -23,6 +24,9 @@ repmat <- function (mx, n) {
for (i in seq(n[1] - 1)) out <- rbind(out, mx_col) for (i in seq(n[1] - 1)) out <- rbind(out, mx_col)
} }
# Replicating 3rd dimension
if (!is.na(n[3]) & n[3] > 1) out <- array(out, c(dim(out), n[3]))
# Output # Output
return(unname(as.matrix(out))) return(unname(as.array(out)))
} }

4
tests/testthat/test-convertedBaseFunctions.R
View file

@ -28,6 +28,10 @@ test_that("repmat works properly", {
object = repmat(mx2, c(4, 1)), object = repmat(mx2, c(4, 1)),
expected = rbind(mx2, mx2, mx2, mx2) expected = rbind(mx2, mx2, mx2, mx2)
) )
expect_equal(
object = repmat(mx2, c(1, 1, 2)),
expected = array(mx2, c(2, 2, 2))
)
}) })
test_that("zeros and ones work as expected", { test_that("zeros and ones work as expected", {