Comparing Col N between different rtables

[waddella]

which goes into the bigger cross-checking outputs discussion

library(rtables)
col_N_for_tbls <- function(...) {
  tbls <- list(...)
  if (is.null(names(tbl)))
    stop("need named arguments")
  stopifnot(all(vapply(tbls, is_rtable, logical(1))))
  
  # Get all unique paths
  upaths <- unique(unlist(lapply(tbls, col_paths), recursive = FALSE))
  
  N <- matrix(rep(NA_integer_, length(upaths) * length(tbls)), ncol = length(upaths))
  
  for (i_tbl in seq_along(tbls)) {
    tbl_i <- tbls[[i_tbl]]
    paths_i <- col_paths(tbl_i)
    
    ind <- vapply(paths_i, function(path) {
      sel <- vapply(upaths, identical, logical(1), path)
      if (sum(sel) < 1) {
        stop("path not found": paste(path, collapse = " > "))
      } else if (sum(sel) > 1) {
        stop("more than one path match", paste(path, collapse = " > "))
      } else {
        which(sel)
      }
    }, numeric(1))
    
    N[i_tbl, ind] <- col_counts(tbl_i)
  }
  
  row.names(N) <- names(tbls)
  colnames(N) <- paste("|", vapply(upaths, paste, character(1), collapse = " > "), "|")
  list(paths = upaths, N = N)
}


lyt <- basic_table() |>
  split_cols_by("Species", split_fun = add_overall_level()) |>
  analyze("Sepal.Length")

tbl <- build_table(lyt, iris)

lyt <- basic_table() |>
  split_cols_by("Species") |>
  analyze("Sepal.Length")

tbl2 <- build_table(lyt, iris)

tbl3 <- build_table(lyt, subset(iris, Sepal.Width > 3.1))

col_N_for_tbls(dmt01 = tbl, dmt02 = tbl2, dmt03 = tbl3)


compare_rtables(tbl, tbl2, structure = TRUE)