Nothing
## ---- 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)
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.