Fix Issues #75, #146, and #166

R/nested.R

@@ -8,14 +8,6 @@ process_nested_count_target <- function(x) {
     assert_that(quo_is_symbol(target_var[[2]]),
                 msg = "Inner layers must be data driven variables")
 
-    if(quo_is_symbol(target_var[[1]])){
-      first_var_length <- length(unique(target[[as_name(target_var[[1]])]]))
-      second_var_length <- length(unique(target[[as_name(target_var[[2]])]]))
-
-      assert_that(second_var_length >= first_var_length,
-                  msg = "The number of values of your second variable must be greater than the number of levels in your first variable")
-    }
-
     if(is.factor(target[[as_name(target_var[[1]])]])) {
       warning(paste0("Factors are not currently supported in nested count layers",
                      " that have two data driven variables. Factors will be coerced into character vectors"),

R/sort.R

@@ -207,7 +207,7 @@ add_order_columns.count_layer <- function(x) {
 
       # Add the ordering of the pieces in the layer
       formatted_data <- formatted_data %>%
-        group_by(.data[[paste0("ord_layer_", formatted_col_index - 1)]]) %>%
+        group_by(.data[[paste0("row_label", formatted_col_index - 1)]]) %>%
         do(add_data_order_nested(., formatted_col_index - 1, numeric_data,
                                  indentation_length = indentation_length,
                                  ordering_cols = ordering_cols,
@@ -724,10 +724,11 @@ add_data_order_nested <- function(group_data, final_col, numeric_data, ...) {
   }
 
   present_vars <- unlist(group_data[-1, row_label_vec[length(row_label_vec)]])
+
   ##### Inner nest values #####
   filtered_numeric_data <- numeric_data %>%
     # Only include the parts of the numeric data that is in the current label
-    filter(numeric_data$summary_var %in% present_vars, !is.na(!!by[[1]])) %>%
+    filter(numeric_data$summary_var %in% present_vars, !!by[[1]] == outer_value) %>%
     # Remove nesting prefix to prepare numeric data.
     mutate(summary_var := str_sub(summary_var, indentation_length))
 

tests/testthat/_snaps/count.md

@@ -209,11 +209,21 @@
       8  2 ( 50.0%)  0 (  0.0%)               1           3           1
       9  0 (  0.0%)  0 (  0.0%)               1           3           2
 
-# nested count layers will error out if second variable is bigger than the first
+# nested count can accept data if second variable is bigger than the first
 
-    i In index: 1.
-    Caused by error:
-    ! The number of values of your second variable must be greater than the number of levels in your first variable
+    Code
+      x
+    Output
+                           row_label1                    row_label2  var1_TRT1
+      1 Antiemetics and antinauseants Antiemetics and antinauseants 1 ( 50.0%)
+      2 Antiemetics and antinauseants    Promethazine hydrochloride 1 ( 50.0%)
+      3                 Psycholeptics                 Psycholeptics 1 ( 50.0%)
+      4                 Psycholeptics    Promethazine hydrochloride 1 ( 50.0%)
+         var1_TRT2 ord_layer_index ord_layer_1 ord_layer_2
+      1 0 (  0.0%)               1           1         Inf
+      2 0 (  0.0%)               1           1           1
+      3 1 (100.0%)               1           2         Inf
+      4 1 (100.0%)               1           2           1
 
 # set_numeric_threshold works as expected
 

tests/testthat/test-count.R

@@ -722,16 +722,23 @@ test_that("test specific rounding proplem #124", {
   options(tplyr.IBMRounding = FALSE)
 })
 
-test_that("nested count layers will error out if second variable is bigger than the first", {
-  mtcars <- mtcars2
-  mtcars$grp <- paste0("grp.", as.numeric(mtcars$cyl) + rep(c(0, 0.5), 16))
+test_that("nested count can accept data if second variable is bigger than the first", {
+  test_adcm <- data.frame(
+    SUBJID = c("1", "2", "3"),
+    ATC2 = c("Antiemetics and antinauseants", "Psycholeptics", "Psycholeptics"),
+    CMDECOD = c("Promethazine hydrochloride", "Promethazine hydrochloride", "Promethazine hydrochloride"),
+    TRT101A = c("TRT1", "TRT2", "TRT1")
+  )
 
-  t <- tplyr_table(mtcars, gear) %>%
+  x <- test_adcm %>%
+    tplyr_table(TRT101A) %>%
     add_layer(
-      group_count(vars(grp, cyl))
-    )
+      group_count(vars(ATC2, CMDECOD))
+    ) %>%
+    build() %>%
+    as.data.frame()
 
-  expect_snapshot_error(build(t))
+  expect_snapshot(x)
 })
 
 test_that("Posix columns don't cause the build to error out.", {
@@ -898,6 +905,9 @@ test_that("nested count layers error out when you try to add a total row", {
     )
 
     expect_snapshot_error(build(tab))
+
+  # The weird use of mtcars2 makes us have to overwrite this again
+  mtcars <- mtcars2
 })
 
 test_that("Tables with pop_data can accept a layer level where", {