diff --git a/R/Apply.R b/R/Apply.R index e130e9099858a6f61931f004e4c0de5d5966f037..f1b324be447fb876370d0f40a5b0188ded925d61 100644 --- a/R/Apply.R +++ b/R/Apply.R @@ -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]]))) { diff --git a/tests/testthat/test-use-cases.R b/tests/testthat/test-use-cases.R index 2b27f5819ac279a0afccb28760af0a59293b62b4..62d3399d0b95601815edd2ac4a3e5160a07d2fa3 100644 --- a/tests/testthat/test-use-cases.R +++ b/tests/testthat/test-use-cases.R @@ -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