From ad8cbd2febfe6091a9a60e30a82bafd119f4c020 Mon Sep 17 00:00:00 2001
From: Nicolau Manubens <nicolau.manubens@ic3.cat>
Date: Mon, 14 Jan 2019 21:25:47 +0100
Subject: [PATCH] Fixed bug of dimnames not propagating.

---
 R/Apply.R                       |  7 ++++++-
 tests/testthat/test-use-cases.R | 22 ++++++++++++++++++++++
 2 files changed, 28 insertions(+), 1 deletion(-)

diff --git a/R/Apply.R b/R/Apply.R
index e130e90..f1b324b 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 2b27f58..62d3399 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
-- 
GitLab