inst/doc/sorting_pruning.R

In rtables: Reporting Tables

## ----echo=FALSE---------------------------------------------------------------
knitr::opts_chunk$set(comment = "#")

## ----message=FALSE------------------------------------------------------------
library(rtables)
library(dplyr)

raw_lyt <- basic_table() %>%
  split_cols_by("ARM") %>%
  split_cols_by("SEX") %>%
  split_rows_by("RACE") %>%
  summarize_row_groups() %>%
  split_rows_by("STRATA1") %>%
  summarize_row_groups() %>%
  analyze("AGE")

raw_tbl <- build_table(raw_lyt, DM)
raw_tbl

## -----------------------------------------------------------------------------
trim_rows(raw_tbl)

## -----------------------------------------------------------------------------
coltrimmed <- raw_tbl[, col_counts(raw_tbl) > 0]
h_coltrimmed <- head(coltrimmed, n = 14)
h_coltrimmed

## -----------------------------------------------------------------------------
table_structure(h_coltrimmed)

## -----------------------------------------------------------------------------
row_paths_summary(h_coltrimmed)

## -----------------------------------------------------------------------------
pruned <- prune_table(coltrimmed)
pruned

## -----------------------------------------------------------------------------
pruned2 <- prune_table(coltrimmed, low_obs_pruner(10, "mean"))
pruned2

## -----------------------------------------------------------------------------
pruned3 <- prune_table(coltrimmed, low_obs_pruner(10, "sum"), stop_depth = 1)
pruned3

## -----------------------------------------------------------------------------
pruned4 <- prune_table(coltrimmed, low_obs_pruner(16, "sum"))
pruned4

## -----------------------------------------------------------------------------
cont_n_allcols

## -----------------------------------------------------------------------------
sort_at_path(pruned, path = c("RACE", "ASIAN", "STRATA1"), scorefun = cont_n_allcols)
# B and C are swapped as the global count (sum of all column counts) of strata C is higher than the one of strata B

## -----------------------------------------------------------------------------
sort_at_path(pruned, path = c("RACE", "*", "STRATA1"), scorefun = cont_n_allcols)
# All subtables, i.e. ASIAN, BLACK..., and WHITE, are reordered separately

## -----------------------------------------------------------------------------
tmptbl <- sort_at_path(pruned, path = c("RACE", "ASIAN", "STRATA1"), scorefun = cont_n_allcols)
tmptbl <- sort_at_path(tmptbl, path = c("RACE", "BLACK OR AFRICAN AMERICAN", "STRATA1"), scorefun = cont_n_allcols)
tmptbl <- sort_at_path(tmptbl, path = c("RACE", "WHITE", "STRATA1"), scorefun = cont_n_allcols)
tmptbl

## -----------------------------------------------------------------------------
table_structure(pruned)

## -----------------------------------------------------------------------------
row_paths_summary(pruned)

## -----------------------------------------------------------------------------
ethsort <- sort_at_path(pruned, path = c("RACE"), scorefun = cont_n_allcols, decreasing = FALSE)
ethsort

## -----------------------------------------------------------------------------
sort_at_path(pruned, path = c("RACE", "*", "STRATA1"), cont_n_onecol(5))

## -----------------------------------------------------------------------------
more_analysis_fnc <- function(x) {
  in_rows(
    "median" = median(x),
    "mean" = mean(x),
    .formats = "xx.x"
  )
}

raw_lyt <- basic_table() %>%
  split_cols_by("ARM") %>%
  split_rows_by(
    "RACE",
    split_fun = drop_and_remove_levels("WHITE") # dropping WHITE levels
  ) %>%
  summarize_row_groups() %>%
  split_rows_by("STRATA1") %>%
  summarize_row_groups() %>%
  analyze("AGE", afun = more_analysis_fnc)

tbl <- build_table(raw_lyt, DM) %>%
  prune_table() %>%
  print()

## -----------------------------------------------------------------------------
table_structure(tbl) # Direct inspection into the tree-like structure of rtables

## -----------------------------------------------------------------------------
scorefun <- function(tt) {
  # Here we could use browser()
  sum(unlist(row_values(tt)))
}
sort_at_path(tbl, c("RACE", "*", "STRATA1", "*", "AGE"), scorefun)

## -----------------------------------------------------------------------------
cont_n_onecol

## -----------------------------------------------------------------------------
scorefun_onecol <- function(colpath) {
  function(tt) {
    # Here we could use browser()
    unlist(cell_values(tt, colpath = colpath), use.names = FALSE)[1] # Modified to lose the list names
  }
}
sort_at_path(tbl, c("RACE", "*", "STRATA1", "*", "AGE"), scorefun_onecol(colpath = c("ARM", "A: Drug X")))

## -----------------------------------------------------------------------------
# Simpler table
tbl <- basic_table() %>%
  split_cols_by("ARM") %>%
  split_cols_by("SEX",
    split_fun = drop_and_remove_levels(c("U", "UNDIFFERENTIATED"))
  ) %>%
  analyze("AGE", afun = more_analysis_fnc) %>%
  build_table(DM) %>%
  prune_table() %>%
  print()

sort_at_path(tbl, c("AGE"), scorefun_onecol(colpath = c("ARM", "B: Placebo", "SEX", "F")))

## -----------------------------------------------------------------------------
silly_name_scorer <- function(tt) {
  nm <- obj_name(tt)
  print(nm)
  nm
}

sort_at_path(ethsort, "RACE", silly_name_scorer) # Now, it is sorted alphabetically!

## -----------------------------------------------------------------------------
silly_gender_diffcount <- function(tt) {
  ## (1st) content row has same name as object (STRATA1 level)
  rpath <- c(obj_name(tt), "@content", obj_name(tt))
  ## the [1] below is cause these are count (pct%) cells
  ## and we only want the count part!
  mcount <- unlist(cell_values(
    tt,
    rowpath = rpath,
    colpath = c("ARM", "C: Combination", "SEX", "M")
  ))[1]
  fcount <- unlist(cell_values(
    tt,
    rowpath = rpath,
    colpath = c("ARM", "C: Combination", "SEX", "F")
  ))[1]
  (mcount - fcount) / fcount
}

sort_at_path(pruned, c("RACE", "*", "STRATA1"), silly_gender_diffcount)