RS-9849: Accept different ordering of value attributes (#23)

* Accept different ordering of value attributes [revdep skip]

* Bug fix [revdep skip]

* Add tests [revdep skip]

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: flipData
 Type: Package
 Title: Functions for extracting and describing data
-Version: 1.5.6
+Version: 1.5.7
 Author: Displayr <opensource@displayr.com>
 Maintainer: Displayr <opensource@displayr.com>
 Description: Functions for extracting data from formulas and

R/mergingandstackingutilities.R

@@ -232,6 +232,18 @@ allIdentical <- function(x)
     length(unique(x)) < 2
 }
 
+#' @param x A list of value attributes (named numeric vectors)
+#' @return A logical scalar indicating if all value attributes are identical,
+#'  even if the values are specified in a different order.
+#' @examples
+#' val.attr <- structure(1:3, .Names = c("A", "B", "C"))
+#' allValueAttributesIdentical(list(val.attr, rev(val.attr))) # TRUE
+#' @noRd
+allValueAttributesIdentical <- function(x)
+{
+    allIdentical(lapply(x, sort))
+}
+
 #' @param x A vector.
 #' @return A vector which is a subset of x with NA values removed.
 #' @example

R/stacking.R

@@ -495,7 +495,7 @@ stackWithCommonLabels <- function(common.labels.list, input.data.set.metadata)
     # Remove groups with mismatching variable types and value attributes
     unstackable.ind <- which(apply(stacking.groups, 1, function(ind) {
         ind <- removeNA(ind)
-        !allIdentical(v.types[ind]) || !allIdentical(v.val.attr[ind])
+        !allIdentical(v.types[ind]) || !allValueAttributesIdentical(v.val.attr[ind])
     }))
     unstackable.names <- lapply(unstackable.ind, function(ind) {
         v.names[removeNA(stacking.groups[ind, ])]
@@ -763,7 +763,7 @@ stackingSpecifiedByVariable <- function(manual.stacking,
 
         # Check for mismatching variable types and value attributes
         if (!allIdentical(v.types[removeNA(group.ind)]) ||
-            !allIdentical(v.val.attr[removeNA(group.ind)]))
+            !allValueAttributesIdentical(v.val.attr[removeNA(group.ind)]))
         {
             warning("The manual stacking input '", input.text,
                     "' has been ignored as it contains variables with mismatching types or value attributes.")
@@ -911,7 +911,7 @@ stackingSpecifiedByObservation <- function(manual.stacking,
     {
         group.ind <- removeNA(manual.stacking.groups[i, ])
         if (!allIdentical(v.types[group.ind]) ||
-            !allIdentical(v.val.attr[group.ind]))
+            !allValueAttributesIdentical(v.val.attr[group.ind]))
         {
             warning("No manual stacking was conducted as the following variables to be stacked ",
                     "have mismatching types or value attributes: ",

tests/testthat/test-mergingandstackingutilities.R

@@ -25,6 +25,12 @@ test_that("allIdentical", {
     expect_equal(allIdentical(x = c(1, 1, 1)), TRUE)
 })
 
+test_that("allValueAttributesIdentical", {
+    val.attr <- structure(1:3, .Names = c("A", "B", "C"))
+    expect_equal(allValueAttributesIdentical(list(val.attr, rev(val.attr))), TRUE)
+    expect_equal(allValueAttributesIdentical(list(val.attr, rev(val.attr)[1:2])), FALSE)
+})
+
 test_that("removeNA", {
     expect_equal(removeNA(x = c(NA, 1, 2, NA, 3)), c(1, 2 ,3))
 })

tests/testthat/test-stacking.R

@@ -483,6 +483,17 @@ test_that("stackingSpecifiedByVariable", {
                           "ignored as it contains variables with mismatching ",
                           "types or value attributes."))
     expect_equal(stacking.groups, structure(6:8, .Dim = c(1L, 3L)))
+
+    # Value attributes in different order
+    v.val.attr.3 <- v.val.attr
+    v.val.attr.3[[2]] <- rev(v.val.attr.3[[2]])
+    expect_warning(stacking.groups <- stackingSpecifiedByVariable(c("Q2_A-Q2_D", "Q3_*"),
+                                                                  list(variable.names = v.names,
+                                                                       variable.types = v.types,
+                                                                       variable.value.attributes = v.val.attr.3)), NA)
+    expect_equal(stacking.groups,
+                 structure(c(2L, 6L, 3L, 7L, 4L, 8L, 5L, NA),
+                           .Dim = c(2L, 4L)))
 })
 
 test_that("stackingSpecifiedByObservation", {