From 5402cde3d0d7e651df7710b43a92461c7d2886dd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Liming=20Li=20=EF=BC=88=E6=9D=8E=E9=BB=8E=E6=98=8E?= =?UTF-8?q?=EF=BC=89?= Date: Wed, 29 Nov 2023 01:36:36 +0000 Subject: [PATCH 1/5] fix issue related to path finding --- R/tt_pos_and_access.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/tt_pos_and_access.R b/R/tt_pos_and_access.R index 5462efb02..baf38b3b2 100644 --- a/R/tt_pos_and_access.R +++ b/R/tt_pos_and_access.R @@ -293,7 +293,7 @@ setMethod( path <- path[-1] } ## handle pathing that hits the root split by name - if (identical(obj_name(tt), path[1])) { + if (identical(unname(obj_name(tt)), unname(path[1]))) { path <- path[-1] } cur <- tt From 0f2b7a4b5cf31f864c89fe5a07f6451c6618d448 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Liming=20Li=20=EF=BC=88=E6=9D=8E=E9=BB=8E=E6=98=8E?= =?UTF-8?q?=EF=BC=89?= Date: Wed, 29 Nov 2023 01:43:30 +0000 Subject: [PATCH 2/5] use equal instead of identical --- R/tt_pos_and_access.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/tt_pos_and_access.R b/R/tt_pos_and_access.R index baf38b3b2..c3f00a6dc 100644 --- a/R/tt_pos_and_access.R +++ b/R/tt_pos_and_access.R @@ -293,7 +293,7 @@ setMethod( path <- path[-1] } ## handle pathing that hits the root split by name - if (identical(unname(obj_name(tt)), unname(path[1]))) { + if (obj_name(tt) == path[1]) { path <- path[-1] } cur <- tt From a04aadd44b88bf5964deaf6707042f9820a768fa Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Liming=20Li=20=EF=BC=88=E6=9D=8E=E9=BB=8E=E6=98=8E?= =?UTF-8?q?=EF=BC=89?= Date: Wed, 29 Nov 2023 02:23:50 +0000 Subject: [PATCH 3/5] only remove first entry when table is not root --- R/tt_pos_and_access.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/tt_pos_and_access.R b/R/tt_pos_and_access.R index c3f00a6dc..7bd237ffd 100644 --- a/R/tt_pos_and_access.R +++ b/R/tt_pos_and_access.R @@ -289,7 +289,7 @@ 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 From 3cdd6695625bde955b56ee561c31522847bc6acb Mon Sep 17 00:00:00 2001 From: Melkiades Date: Wed, 29 Nov 2023 14:53:35 +0100 Subject: [PATCH 4/5] test + news + general fix --- NEWS.md | 2 ++ R/tt_paginate.R | 2 +- R/tt_pos_and_access.R | 3 ++- tests/testthat/test-subset-access.R | 18 ++++++++++++++++++ 4 files changed, 23 insertions(+), 2 deletions(-) diff --git a/NEWS.md b/NEWS.md index 78cb853e4..e6372f3cd 100644 --- 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 index 059c1bf07..ccb6e832d 100644 --- 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 index 7bd237ffd..a03bdf988 100644 --- a/R/tt_pos_and_access.R +++ b/R/tt_pos_and_access.R @@ -289,7 +289,8 @@ setMethod( length(path) > 0, !anyNA(path) ) - if (path[1] == "root" & obj_name(tt) != "root") { + + if (path[1] == "root" && obj_name(tt) != "root") { path <- path[-1] } ## handle pathing that hits the root split by name diff --git a/tests/testthat/test-subset-access.R b/tests/testthat/test-subset-access.R index 223219845..0df85ff91 100644 --- a/tests/testthat/test-subset-access.R +++ b/tests/testthat/test-subset-access.R @@ -540,3 +540,21 @@ 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) + expect_silent(tt_at_path(tbl, row_paths(tbl)[[2]])) +}) \ No newline at end of file From 8b468b3f8c3e20be34109020a8a73c54bcdbf812 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Wed, 29 Nov 2023 14:05:35 -0500 Subject: [PATCH 5/5] Update test, apply styler --- tests/testthat/test-subset-access.R | 25 +++++++++++++++---------- 1 file changed, 15 insertions(+), 10 deletions(-) diff --git a/tests/testthat/test-subset-access.R b/tests/testthat/test-subset-access.R index 0df85ff91..c56f297eb 100644 --- a/tests/testthat/test-subset-access.R +++ b/tests/testthat/test-subset-access.R @@ -547,14 +547,19 @@ test_that("tt_at_path and cell_values work with values even if they differ in na 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") %>% + 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) - expect_silent(tt_at_path(tbl, row_paths(tbl)[[2]])) -}) \ No newline at end of file + + rdf <- make_row_df(tbl) + names(rdf$path[[2]]) <- c("a", "b") + expect_silent(tt_at_path(tbl, rdf$path[[2]])) +})