clean up unused code, a few new tests

R/make_subset_expr.R

@@ -267,21 +267,6 @@ create_colinfo <- function(lyt, df, rtpos = TreePos(),
       0L
     } else {
       vec <- try(eval(ex, envir = alt_counts_df), silent = TRUE)
-      ## likely unneeded now because it happens in splitvec_to_coltree
-      ## which is called during coltree construction above
-      ## TODO remove me
-      if (is(vec, "try-error")) {
-        stop(sprintf(
-          paste(
-            counts_df_name, "appears",
-            "incompatible with column-split",
-            "structure. Offending column subset",
-            "expression: %s\nOriginal error",
-            "message: %s"
-          ), deparse(ex[[1]]),
-          conditionMessage(attr(vec, "condition"))
-        ))
-      }
       if (is(vec, "numeric")) {
         length(vec)
       } else if (is(vec, "logical")) { ## sum(is.na(.)) ????

R/tree_accessors.R

@@ -2447,31 +2447,6 @@ setMethod(
   }
 )
 
-match_path_by_pos <- function(kidlst, path) {
-  ret <- -1
-  nmval_pairs <- lapply(
-    kidlst,
-    function(kd) {
-      pos <- tree_pos(kd)
-      c(
-        obj_name(tail(pos_splits(pos), 1)[[1]]),
-        value_names(tail(pos_splvals(pos), 1))[[1]]
-      )
-    }
-  )
-
-  matches <- vapply(
-    nmval_pairs,
-    function(pair) {
-      (pair[1] == path[1]) && (is.na(pair[2]) || (path[2] %in% c(pair[2], "*")))
-    },
-    TRUE
-  )
-  if (any(matches)) {
-    ret <- which(matches)
-  }
-  ret
-}
 
 ## this is a horrible hack but when we have non-nested siblings at the top level
 ## the beginning of the "path <-> position" relationship breaks down.
@@ -2482,24 +2457,6 @@ match_path_by_pos <- function(kidlst, path) {
 ##
 ## those first non-nested siblings currently have (incorrect)
 ## empty tree_pos elements so we just look at the obj_name
-root_match_finder <- function(kidlst, path) {
-  matches <- vapply(kidlst, function(kid) {
-    obj_name(kid) == path[1]
-  }, TRUE)
-  if (sum(matches) == 0) {
-    stop("unable to find first-step match in path: ", path[1])
-  } else if (sum(matches) > 1) {
-    stop("multiple matches for first-step in path: ", path[1])
-  } else {
-    which(matches)
-  }
-}
-
-
-is_all_split <- function(ct) {
-  splvals <- pos_splvals(ct)
-  length(splvals) > 0 && rawvalues(tail(pos_splvals(ct), 1))[[1]] == tail(value_names(pos_splvals(ct)), 1)
-}
 
 pos_singleton_path <- function(obj) {
   pos <- tree_pos(obj)
@@ -2522,10 +2479,6 @@ coltree_at_path <- function(obj, path, ...) {
     stop("@content token is not valid for column paths.")
   }
 
-
-  ## if(obj_name(obj) == path[1]) {
-  ##   path <- path[-1]
-  ## }
   cur <- obj
   curpath <- pos_to_path(tree_pos(obj)) # path
   num_consume_path <- 2
@@ -2559,6 +2512,12 @@ find_kid_path_match <- function(kids, path) {
   which(matches)
 }
 
+
+## almost a duplicate of recursive_replace, but I spent a bunch
+## of time ramming my head against the different way pathing happens
+## in column space (unfortunately) before giving up building
+## coltree_at_path around recursive_replace, so here we are.
+
 ct_recursive_replace <- function(ctree, path, value, pos = 1) {
   pos <- tree_pos(ctree)
   curpth <- pos_to_path(pos)

R/tt_compatibility.R

@@ -384,6 +384,7 @@ only_first_annot <- function(all_annots) {
 #' @aliases rbind
 #' @export
 rbindl_rtables <- function(x, gap = lifecycle::deprecated(), check_headers = lifecycle::deprecated()) {
+  ## nocov start
   if (lifecycle::is_present(gap)) {
     lifecycle::deprecate_warn(
       when = "0.3.2",
@@ -396,6 +397,7 @@ rbindl_rtables <- function(x, gap = lifecycle::deprecated(), check_headers = lif
       what = "rbindl_rtables(check_headers)"
     )
   }
+  ## nocov end
 
   firstcols <- col_info(x[[1]])
   i <- 1

tests/testthat/test-printing.R

@@ -340,6 +340,7 @@ test_that("Various Printing things work", {
 
   table_structure(tab, detail = "subtable") ## treestruct(tab)
   table_structure(tab, detail = "row") ## treestruct(tab)
+  coltree_structure(tab)
 
   ## this is not intended to be a valid layout, it just
   ## tries to hit every type of split for the print machinery
@@ -805,6 +806,10 @@ test_that("showing higher-level ncols works", {
     analyze("AGE")
 
   tbl <- build_table(lyt, mydat)
+  expect_equal(colcount_na_str(tbl), "")
+  colcount_na_str(tbl) <- "wut"
+  expect_equal(colcount_na_str(tbl), "wut")
+  colcount_na_str(tbl) <- ""
   cwds <- rep(8, ncol(tbl) + 1)
   expect_equal(nlines(col_info(tbl), colwidths = cwds, fontspec = NULL), 7)
   mpf <- matrix_form(tbl, TRUE)
@@ -822,6 +827,7 @@ test_that("showing higher-level ncols works", {
   expect_true(all(!grepl("(N=", strs[-c(2, 5), -1], fixed = TRUE)))
 
   broken_tbl <- tbl
+  expect_true(colcount_visible(broken_tbl, c("ARM", "A: Drug X", "SEX2", "males")))
   colcount_visible(broken_tbl, c("ARM", "A: Drug X", "SEX2", "males")) <- FALSE
   expect_error(print(broken_tbl), "different colcount visibility among sibling facets")
 
@@ -888,6 +894,13 @@ test_that("showing higher-level ncols works", {
     c("", "", "")
   )
 
+  ## turning counts for a facet's children off is different than setting
+  ## the visible counts to NA, note alignment here, no spaces under risk diff
+  ## arms
+  facet_colcounts_visible(tbl5, c("rr_header", "Risk Difference % CI", "ARM")) <- FALSE
+  mpf5b <- matrix_form(tbl5, TRUE)
+  expect_equal(mf_strings(mpf5b)[3, 7:8],
+               c("A: Drug X", "C: Combination"))
   lyt6 <- basic_table(show_colcounts = TRUE, colcount_format = "N=xx") %>%
     split_cols_by("active_trt", split_fun = trim_levels_in_group("ARM")) %>%
     split_cols_by("ARM", split_fun = add_combo_levels(combodf), show_colcounts = TRUE, colcount_format = "(N=xx)") %>%