fix

NEWS.md

@@ -6,6 +6,7 @@
 ### Bug Fixes
  * Fixed `rlistings` decoration (e.g. titles and footers) expansion when there are new lines. Moved relevant handling from `rtables`' `matrix_form` function to `formatters`' dedicated `mform_handle_newlines` function.
  * Fixed issue with `rtables_root` not being removed when using `as_result_df`.
+ * Fixed edge case bug in `as_result_df` where rows of the table have only `"root"` as path index.
 
 ## rtables 0.6.6
 ### New Features

R/tt_export.R

@@ -428,11 +428,11 @@ do_data_row <- function(rdfrow, maxlen) {
 }
 
 .remove_root_elems_from_path <- function(path, which_root_name = c("root", "rbind_root"), all = TRUE) {
-  any_root_paths <- path[1] %in% c("root", "rbind_root")
+  any_root_paths <- path[1] %in% which_root_name
   if (any_root_paths) {
     if (isTRUE(all)) {
       # Selecting the header grouping of root and rbind_root (we do not want to remove other root labels-path later)
-      root_indices <- which(path %in% c("root", "rbind_root"))
+      root_indices <- which(path %in% which_root_name)
       if (any(diff(root_indices) > 1)) { # integer(0) for diff means FALSE
         end_point_root_headers <- which(diff(root_indices) > 1)[1]
       } else {
@@ -444,6 +444,12 @@ do_data_row <- function(rdfrow, maxlen) {
     }
     path <- path[-root_path_to_remove]
   }
+
+  # Fix for very edge case where we have only root elements
+  if (length(path) == 0) {
+    path <- which_root_name[1]
+  }
+
   path
 }
 

tests/testthat/test-result_data_frame.R

@@ -102,30 +102,30 @@ test_that("as_result_df works with visual output (as_viewer)", {
   )
   expect_equal(as_result_df(tbl, expand_colnames = TRUE)$`all obs`[2], "356")
   expect_equal(as_result_df(tbl, expand_colnames = TRUE, as_strings = TRUE)$`all obs`[2], "(N=356)")
-  
-  
+
+
   # Test for integer extraction and ranges
   lyt <- basic_table() %>%
     split_cols_by("ARM") %>%
     split_rows_by("STRATA1") %>%
     analyze("AGE", afun = function(x) list(a = mean(x), b = range(x)))
-  
+
   tbl <- build_table(lyt, ex_adsl)
   expect_equal(as_result_df(tbl, simplify = TRUE, as_viewer = TRUE)[2, 2][[1]], c(24, 46))
-  
+
   # Test for tables with less than 3 rows
   tbl <- rtable(
     header = rheader(rrow("", "c1", "c2")),
     rrow("row 1", 1, c(.8, 1.2))
   )
   expect_equal(
-    as_result_df(tbl)[, 1:6], 
+    as_result_df(tbl)[, 1:6],
     data.frame(
-      "avar_name" = "row 1", 
-      "row_name" = "row 1", 
-      "label_name" = "row 1", 
-      "row_num" = 1, 
-      "is_group_summary" = FALSE, 
+      "avar_name" = "row 1",
+      "row_name" = "row 1",
+      "label_name" = "row 1",
+      "row_num" = 1,
+      "is_group_summary" = FALSE,
       "node_class" = "DataRow"
     )
   )
@@ -137,14 +137,14 @@ test_that("as_result_df works fine also with multiple rbind_root", {
     split_cols_by("ARM") %>%
     split_rows_by("STRATA1") %>%
     analyze(c("AGE", "BMRKR2"))
-  
+
   tbl <- build_table(lyt, ex_adsl)
-  
+
   mega_rbind_tbl <- rbind(tbl, rbind(tbl, tbl, rbind(tbl, tbl)))
-  
+
   out <- expect_silent(as_result_df(mega_rbind_tbl))
-  
-  expect_true(all(out[,1] == "STRATA1"))
+
+  expect_true(all(out[, 1] == "STRATA1"))
 })
 
 test_that("as_result_df keeps label rows", {
@@ -154,37 +154,37 @@ test_that("as_result_df keeps label rows", {
     split_cols_by("STRATA2") %>%
     split_rows_by("STRATA1") %>%
     analyze(c("AGE", "BMRKR2"))
-  
+
   tbl <- build_table(lyt, ex_adsl)
-  
+
   rd1 <- as_result_df(tbl, keep_label_rows = TRUE)
   rd2 <- as_result_df(tbl, keep_label_rows = TRUE, expand_colnames = TRUE)
   rd3 <- as_result_df(tbl, keep_label_rows = TRUE, expand_colnames = TRUE, as_strings = TRUE)
   rd4 <- as_result_df(tbl, keep_label_rows = TRUE, expand_colnames = TRUE, as_viewer = TRUE)
-  
+
   expect_equal(nrow(rd1), nrow(rd2) - 2)
   expect_equal(nrow(rd1), nrow(rd3) - 2)
   expect_equal(nrow(rd1), nrow(rd4) - 2)
   expect_identical(ncol(rd1), ncol(rd2))
   expect_identical(ncol(rd1), ncol(rd3))
   expect_identical(ncol(rd1), ncol(rd4))
-  
+
   expect_identical(as.character(rd1[3, ]), as.character(rd2[5, ]))
   expect_identical(rd2[is.na(rd2[, ncol(rd2)]), ], rd4[is.na(rd4[, ncol(rd4)]), ])
-  
+
   # More challenging labels
   lyt <- make_big_lyt()
   tbl <- build_table(lyt, rawdat)
-  
+
   ard_out <- as_result_df(tbl, keep_label_rows = TRUE)
   mf_tbl <- matrix_form(tbl)
-  
+
   # Label works
   expect_identical(
     ard_out$label_name,
     mf_strings(mf_tbl)[-seq_len(mf_nrheader(mf_tbl)), 1]
   )
-  
+
   # Row names respects path
   pths <- make_row_df(tbl)$path
   expect_identical(
@@ -197,26 +197,44 @@ test_that("as_result_df as_is is producing a data.frame that is compatible with
   # More challenging labels
   lyt <- make_big_lyt()
   tbl <- build_table(lyt, rawdat)
-  
+
   ard_out <- as_result_df(tbl, as_is = TRUE)
   mf_tbl <- matrix_form(tbl)
-  
+
   # Label works
   expect_identical(
     ard_out$label_name,
     mf_strings(mf_tbl)[-seq_len(mf_nrheader(mf_tbl)), 1]
   )
-  
+
   expect_identical(
     ard_out$label_name,
     df_to_tt(ard_out) %>% row.names()
   )
-
-  init_tbl <- df_to_tt(mtcars) 
-  end_tbl <- init_tbl %>% as_result_df(as_is = TRUE) %>% df_to_tt()
-
+
+  init_tbl <- df_to_tt(mtcars)
+  end_tbl <- init_tbl %>%
+    as_result_df(as_is = TRUE) %>%
+    df_to_tt()
+
   expect_equal(
-    matrix_form(init_tbl)$strings, 
+    matrix_form(init_tbl)$strings,
     matrix_form(end_tbl)$strings
   )
 })
+
+test_that("as_result_df works fine with empty tables and no character(0) is allowed", {
+  tbl <- basic_table() %>%
+    build_table(mtcars)
+
+  expect_silent(as_result_df(tbl))
+
+  expect_equal(
+    .remove_root_elems_from_path(
+      c("a", "b", "c"),
+      which_root_name = c("a", "b", "c"),
+      all = TRUE
+    ),
+    "a"
+  )
+})