Commit ab8cf411 authored by Nicolau Manubens Gil's avatar Nicolau Manubens Gil
Browse files

Merge branch 'develop-bugfixes-2.0.1' into 'master'

Fixed bug of dimnames not propagating.

See merge request !11
parents bf4b09fc ad8cbd2f
Pipeline #904 canceled with stage
......@@ -31,7 +31,8 @@
#' @importFrom plyr splat llply
#' @importFrom utils capture.output
Apply <- function(data, target_dims = NULL, fun, ...,
output_dims = NULL, margins = NULL, guess_dim_names = TRUE,
output_dims = NULL, margins = NULL,
guess_dim_names = TRUE,
ncores = NULL, split_factor = 1) {
# Check data
if (!is.list(data)) {
......@@ -470,6 +471,10 @@ Apply <- function(data, target_dims = NULL, fun, ...,
iteration_input[[i]] <- do.call('[', c(list(x = data[[i]]),
iteration_indices_to_take[[i]],
list(drop = FALSE)))
num_targets <- length(target_dims_names[[i]])
if (num_targets > 0) {
names(dim(iteration_input[[i]])) <- names(dim(data[[i]]))
}
num_margins <- length(margins_names[[i]])
if (num_margins > 0) {
if (num_margins == length(dim(iteration_input[[i]]))) {
......
......@@ -1267,6 +1267,28 @@ test_that(".aperm2", {
)
})
# Test dim names passed on properly
test_that("Dimension names are propagated correctly.", {
a <- array(1:prod(1:6), dim = c(a = 1, b = 2, c = 3, d = 4, e = 5, f = 6))
b <- array(1:prod(c(1, 2, 3, 5, 6)), dim = c(a = 1, b = 2, c = 3, e = 5, f = 6))
x <- ""
y <- ""
f <- function(a, b) {
x <<- names(dim(a))
y <<- names(dim(b))
}
r <- multiApply::Apply(list(a, b),
list(c('b', 'c', 'd'),
c('b', 'c')),
f)
expect_equal(x, c('b', 'c', 'd'))
expect_equal(y, c('b', 'c'))
})
# TODOS:
# TESTS FOR MARGINS
# TESTS FOR DISORDERED TARGET_DIMS
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment