Fix potential tt at path issue (#794)

* fix issue related to path finding * use equal instead of identical * only remove first entry when table is not root * test + news + general fix * Update test, apply styler --------- Co-authored-by: Davide Garolini <[email protected]> Co-authored-by: Emily de la Rua <[email protected]>
insightsengineering · Nov 29, 2023 · d861d76 · d861d76
1 parent 2fb0fd6
commit d861d76
Show file tree

Hide file tree

Showing 4 changed files with 29 additions and 3 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -16,6 +16,8 @@
 ### Bug Fixes
  * Fixed a bug that was failing when wrapping and section dividers were used at the same time.
  * Fixed a bug in `as_result_df` causing misalignment of column names.
+ * Fixed a bug that was not allowing path indexing as `row_paths()` was giving a different path due to it being made of 
+   named values.
 
 ### Miscellaneous
  * Applied `styler` and resolved package lint. Changed default indentation from 4 spaces to 2.

diff --git a/R/tt_paginate.R b/R/tt_paginate.R
@@ -342,7 +342,7 @@ setMethod(
       colwidths = colwidths,
       sibpos = sibpos,
       nsibs = nsibs,
-      pth = c(path, obj_name(tt)),
+      pth = c(path, unname(obj_name(tt))),
       repext = repr_ext,
       repind = repr_inds,
       indent = indent,

diff --git a/R/tt_pos_and_access.R b/R/tt_pos_and_access.R
@@ -289,11 +289,12 @@ setMethod(
       length(path) > 0,
       !anyNA(path)
     )
-    if (identical(path[1], "root")) {
+
+    if (path[1] == "root" && obj_name(tt) != "root") {
       path <- path[-1]
     }
     ## handle pathing that hits the root split by name
-    if (identical(obj_name(tt), path[1])) {
+    if (obj_name(tt) == path[1]) {
       path <- path[-1]
     }
     cur <- tt

diff --git a/tests/testthat/test-subset-access.R b/tests/testthat/test-subset-access.R
@@ -540,3 +540,26 @@ test_that("bracket methods all work", {
     tbl[, c(TRUE, FALSE, FALSE, TRUE, FALSE, TRUE)]
   )
 })
+
+test_that("tt_at_path and cell_values work with values even if they differ in naming", {
+  # see issue #794
+  tbl <- basic_table() %>%
+    split_cols_by(var = "ARM", split_label = "asdar") %>%
+    # split_rows_by(var = "SEX") %>%
+    add_colcounts() %>%
+    analyze("AGE",
+      afun = function(x) {
+        out_list <- list(a = mean(x), b = 3)
+        labs <- c("argh", "argh2")
+        attr(out_list[[1]], "label") <- "aa"
+        attr(out_list[[2]], "label") <- "aa2"
+        in_rows(.list = out_list, .labels = labs, .names = labs)
+      },
+      show_labels = "visible", table_names = "nope"
+    ) %>%
+    build_table(df = DM)
+
+  rdf <- make_row_df(tbl)
+  names(rdf$path[[2]]) <- c("a", "b")
+  expect_silent(tt_at_path(tbl, rdf$path[[2]]))
+})