inst/doc/atable_usage.R

In atable: Create Tables for Reporting Clinical Trials

## ----require, echo=FALSE, results='hide', message=FALSE, warning=FALSE--------

require(knitr)
require(Hmisc)
require(datasets)
require(utils)
require(atable)


## ----global_chunk_options, echo = FALSE, results='hide'-----------------------

opts_chunk$set(message = FALSE)
opts_chunk$set(echo = FALSE)
opts_chunk$set(warning = FALSE)
opts_chunk$set(results = "hide")


## ----ToothGrowth atable, echo=TRUE, results='asis'----------------------------

# apply atable
the_table <- atable::atable(ToothGrowth,
                            target_cols = "len",
                            group_col = "supp",
                            split_cols = "dose",
                            format_to = "Latex")

# send to LaTeX
Hmisc::latex(the_table,
             file = "",
             title = "",
             label = "tab:ToothGrowthatable",
             caption = "ToothGrowth analysed by atable.",
             caption.lot = "ToothGrowth analysed by atable",
             rowname = NULL)


## ----mtcars atable, echo=TRUE, results='asis'---------------------------------

# all columns of mtcars are numeric, although some are
# better represented as factors
mtcars <- within(datasets::mtcars, {gear <- factor(gear)})

# Add labels and units.
attr(mtcars$mpg, "alias") = "Consumption [Miles (US)/ gallon]"
Hmisc::label(mtcars$qsec) = "Quarter Mile Time"
units(mtcars$qsec) = "s"

# apply atable
the_table <- atable::atable(mpg + hp + gear + qsec ~ cyl | vs,
                            mtcars,
                            format_to = "Latex")
# atable also has a formula method.
# The left side contains the target columns, the right side contains grouping
# and splitting columns separated by the pipe |

# send to LaTeX
Hmisc::latex(the_table,
             file = "",
             title = "",
             label = "tab:mtcarsatable",
             caption = "mtcars analysed by atable.",
             caption.lot = "mtcars analysed by atable",
             rowname = NULL)

## ----Extract specific values from the table, echo=TRUE, results='markup'------

unformatted <- atable::atable(mpg + hp + gear + qsec ~ cyl | vs,
                              mtcars,
                              format_to = "Raw")
# format_to = "Raw" tells atable to skip formatting.

# Extract specific values
unformatted$statistics_result$mpg[[2]]$mean
unformatted$statistics_result$mpg[[2]]$sd

## ----Localisation, echo=TRUE, results='asis'----------------------------------

# Set german words for the table:
atable::atable_options(labels_TRUE_FALSE = c("Ja", "Nein"),
                       labels_Mean_SD = "Mittelwert (SD)" ,
                       labels_valid_missing = "Ok (fehlend)",
                       colname_for_observations = "N",
                       colname_for_value = "Wert",
                       colname_for_group = "",
                       replace_NA_by = "fehlend")

attr(mtcars$mpg, "alias German") = "Verbrauch [Miles (US)/ gallon]"
attr(mtcars$hp, "alias German") = "PS"

# Tell atable to look for attribute "alias German"
atable_options('get_alias.default' = function(x, ...)
  {attr(x, "alias German", exact = TRUE)})

# apply atable
the_table <- atable::atable(mtcars,
             target_cols = c("mpg", "hp"))

# reset all options to default
atable_options_reset()

# send to LaTeX
Hmisc::latex(the_table,
             file = "",
             title = "",
             label = "tab:Localisation",
             caption = "Localised atable. All identifiers produced by atable are
                        now translated to german; also the user can add aliasees
                        to all variables for localisation.",
             caption.lot = "Localised atable",
             rowname = NULL)



## ----Word, echo=TRUE----------------------------------------------------------

for_Word <- atable::atable(mpg + hp + gear + qsec ~ cyl | vs, mtcars,
                           format_to = "Word")

# print in Word with packages flextable and officer

# MyFTable <- flextable::regulartable(data = for_Word)
# left aligned first column:
# MyFTable <- flextable::align(MyFTable, align = "left", j = 1)

# save on disc. Not run here:
# doc <- officer::read_docx()
# doc <- flextable::body_add_flextable(doc, value = MyFTable)
# print(doc, target = "atable and Word.docx")


## ----HTML, echo=TRUE----------------------------------------------------------

for_HTML <- atable::atable(mpg + hp + gear + qsec ~ cyl | vs,
                           mtcars,
                           format_to = "HTML")

options(knitr.kable.NA = '')
# knitr::kable(for_HTML, caption="HTML table with atable") # not run.


## ----Console, echo=TRUE-------------------------------------------------------
atable::atable(mpg + hp + gear + qsec ~ cyl | vs,
                           mtcars,
                           format_to = "Console")

## ----atable_options, echo=TRUE, eval=FALSE------------------------------------
#  atable_options(format_to = "Console")

## ----mockup table, echo=TRUE, results='asis'----------------------------------

# set the formating of numbers so that only 'x' is returned instead of digits.

atable_options("format_p_values" = atable:::mockup_format_numbers)
atable_options("format_numbers" = atable:::mockup_format_numbers)
atable_options("format_percent" = atable:::mockup_format_numbers)

# now apply atable to mtcars as above
the_table <- atable::atable(mpg + hp + gear + qsec ~ cyl | vs,
                            mtcars,
                            format_to = "Latex")

# send to LaTeX
Hmisc::latex(the_table,
             file = "",
             title = "",
             label = "tab:mtcarsatablemockup",
             caption = "mockup table of the mtcars analysis, filled with xxx instead of numbers.
                        Compare with table \\ref{tab:mtcarsatable}.",
             caption.lot = "mockup table of the mtcars analysis",
             rowname = NULL)

# back to normal:
atable_options_reset()


## ----blocks, echo=TRUE, results='asis'----------------------------------------

the_table <- atable::atable(datasets::mtcars,
                     target_cols = c("cyl", "disp", "hp", "am", "gear", "qsec") ,
                     blocks = list("Engine" = c("cyl", "disp", "hp"),
                                   "Gearbox" = c("am", "gear")),
                     format_to = "Latex")

# send to LaTeX
Hmisc::latex(
  the_table,
  file = "",
  title = "",
  label = "tab:mtcarsblocking",
  caption = "Blocking shown with datasets::mtcars: Variables cyl, disp and mpg are
in block Engine and variables am and gear in block gearbox. Variable qsec is not
blocked and thus not indented.",
caption.lot = "Blocking of the mtcars analysis",
rowname = NULL)


## ----Tabelle with stats and test, results='asis', echo=FALSE------------------



DD <- matrix(
  c(
    c('scale_of_measurement', 'nominal', 'ordinal', 'interval'),

    c('statistic', 'counts occurences of every level', 'as factor', 'Mean and standard deviation'),

    c('two_sample_test', 'chi^2 test', 'Wilcoxon Rank-Sum test', 'Kolmogorov-Smirnov Test'),

    c('effect_size', "two levels: odds ratio, else Cramér's phi", "Cliff's Delta", "Cohen's d"),

    c('multi_sample_test', 'chi^2 test', 'Kruskal-Wallis test', 'Kruskal-Wallis test')
  ),
  ncol = 4,
  byrow = TRUE,
  dimnames = list(NULL, c('R class', 'factor', 'ordered', 'numeric'))
)


DD <- as.data.frame(DD)

DD[] <- lapply(DD, gsub, pattern = "_", replacement = " ")

DD <- atable::translate_to_LaTeX(DD, greek = TRUE)

Hmisc::latex(DD,
      file = "",
      title = "",
      label = "tab:classesandatable",
      caption = "Classes and atable. Table shows the descriptive statistics and hypothesis tests, that are
      applied to the three R classes factor, ordered and numeric. Table also shows the appropriate scale
      of measurement. Class character and logical are treated as nominal scaled variables.",
      caption.lot = "Classes and atable",
      rowname = NULL,
      first.hline.double = FALSE,
      collabel.just = c("l|", "l", "l", "l"),
      col.just = c("p{3.5cm}|", "p{3.5cm}", "p{4cm}", "p{4cm}"),
      where="!htbp",
      multicol = FALSE,
      longtable = FALSE,
      booktabs = FALSE)




## ----Replace two_sample_htest.numeric, results='markup', echo=TRUE------------
# write a new function:
new_two_sample_htest <- function(value, group, ...){

  d <- data.frame(value = value, group = group)

  group_levels <- levels(group)
  x <- subset(d, group %in% group_levels[1], select = "value", drop = TRUE)
  y <- subset(d, group %in% group_levels[2], select = "value", drop = TRUE)

  ks_test_out <- stats::ks.test(x, y)
  t_test_out <- stats::t.test(x, y)
  cohen_d_out <- effsize::cohen.d(x, y, na.rm = TRUE)

  # return p-values of both tests
  out <- list(p_ks = ks_test_out$p.value,
              p_t = t_test_out$p.value,
              cohens_d = cohen_d_out$estimate)

  return(out)
}


## ----Modify statistics numeric, results='markup', echo=TRUE-------------------


new_stats <- function(x, ...){

  statistics_out <- list(Median = median(x, na.rm = TRUE),
                         MAD = mad(x, na.rm = TRUE),
                         Mean = mean(x, na.rm = TRUE),
                         SD = sd(x, na.rm = TRUE))

  return(statistics_out)
}


## ----replace via atable_options, results='markup', echo=TRUE------------------
atable_options("statistics.numeric" = new_stats)

## ----replace via atable, , results='markup', echo=TRUE------------------------
the_table <-  atable::atable(atable::test_data,
                             target_cols = "Numeric",
                             group_col = "Group",
                             split_cols = "Split1",
                             format_to = "Latex",
                             two_sample_htest.numeric = new_two_sample_htest)



## ----Print modify numeric, echo=TRUE, results='asis'--------------------------

Hmisc::latex(the_table,
             file = "",
             title = "",
             label = "tab:modifynumeric",
             caption = "Modified atable also calculates the median, MAD,
             t-test and KS-test.",
             caption.lot = "Modified atable",
             rowname = NULL)


## ----Methods for statistics, results='markup', echo=TRUE----------------------

statistics.Date <- function(x, ...){

  out <- list(
    Min = min(x, na.rm = TRUE),
    Median = median(x, na.rm = TRUE),
    Max = max(x, na.rm = TRUE)
  )

  class(out) <- c("statistics_Date", class(out))
  # We will need this new class later to specify the format

  return(out)
}


## ----Methods for format, results='markup', echo=TRUE--------------------------
format_statistics.statistics_Date <- function(x, ...){

  min_max <- paste0(x$Min, "; ", x$Max)
  Median <- as.character(x$Median)


  out <- data.frame(
    tag = factor(c("Min Max", "Median"), levels = c("Min Max", "Median")),
    value = c(min_max, Median),
    stringsAsFactors = FALSE)
  # the factor needs levels for the non-alphabetic order
  return(out)
}


## ----Methods for Date print, echo=TRUE, results='asis'------------------------
the_table <-  atable::atable(atable::test_data,
                             target_cols = "Date",
                             format_to = "Latex")

Hmisc::latex(the_table,
             file = "",
             title = "",
             label = "tab:addedDate",
             caption = "atable with added methods for class Date. Now calculates
             minimum, maximum and median for this class",
             caption.lot = "atable with added methods for class Date",
             rowname = NULL)

## ----atable compact, echo=TRUE, results='asis'--------------------------------

atable_options_reset()


tab = atable_compact(atable::test_data,
                     target_cols = c("Numeric", "Numeric2", "Split2", "Factor",
                                     "Ordered"),
                     group_col = "Group2",
                     blocks = list("Primary Endpoint" = "Numeric",
                                   "Secondary  Endpoint" = c("Numeric2", "Split2")),
                     indent_character = "\\quad")

tab = atable::translate_to_LaTeX(tab)

Hmisc::latex(tab,
             file = "",
             title = "",
             label = "tab:atable compact",
             caption = Hmisc::latexTranslate("atable compact. The data.frame is
             grouped by group_col and the summary statistcs of the target_cols
             are calculated: mean, sd for numeric, counts and percentages for
             factors. The target_cols are blocked: the first block 'Primary Endpoint'
             contains the variable Numeric. The second block 'Secondary  Endpoint'
             contains the variables 'Numeric2' and 'Split2'. The blocks are
             intended. For variable Split2 only its first level 'b' is reported, as
             the variable has only two levels and the name 'Split2' does not appear
             in the table. The variables Factor and Ordered have more than two levels,
             so all of them are reported and appropriately intended."),
             caption.lot = "atable compact",
             rowname = NULL)


## ----atable longitudinal, echo=TRUE, results='asis'---------------------------

x = atable::test_data

# create timepoint of measurement
set.seed(42)
x = within(x, {time = sample(paste0("time_", 1:6), size=nrow(x), replace = TRUE)})

tab = atable_longitudinal(x,
       target_cols = "Split2",
       group_col = "Group2",
       split_cols = "time",
       add_margins = TRUE)

tab = atable::translate_to_LaTeX(tab)

Hmisc::latex(tab,
             file = "",
             title = "",
             label = "tab:atable longitudinal",
             caption = Hmisc::latexTranslate("atable longitudinal. Table shows
             statistics of variable Split2 measured at six time points in in three
             groups and the p-values for a comparison of the groups. The name of
             the variable 'Split2' does not show up in the table, so the user should
             add it to the caption of the table. Also only statistics of the first
             level of 'Split2' are shown, as 'Split2' has only two levels.
             Format of the statistics is percent % (n/total)."),
             caption.lot = "atable longitudinal",
             rowname = NULL)