Nothing
## ----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)
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.