1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
|
#' Display the output of a summary function according to the output format
#'
#' This function is intended for use in a R markdown code chunk with the chunk
#' option `results = "asis"`.
#'
#' @param object The object for which the summary is to be listed
#' @param caption An optional caption
#' @param label An optional label, ignored in html output
#' @param clearpage Should a new page be started after the listing? Ignored in html output
#' @export
summary_listing <- function(object, caption = NULL, label = NULL,
clearpage = TRUE) {
if (knitr::is_latex_output()) {
tex_listing(object = object, caption = caption, label = label,
clearpage = clearpage)
}
if (knitr::is_html_output()) {
html_listing(object = object, caption = caption)
}
}
#' @rdname summary_listing
#' @export
tex_listing <- function(object, caption = NULL, label = NULL,
clearpage = TRUE) {
cat("\n")
cat("\\begin{listing}", "\n")
if (!is.null(caption)) {
cat("\\caption{", caption, "}", "\n", sep = "")
}
if (!is.null(label)) {
cat("\\caption{", label, "}", "\n", sep = "")
}
cat("\\begin{snugshade}", "\n")
cat("\\scriptsize", "\n")
cat("\\begin{verbatim}", "\n")
cat(capture.output(suppressWarnings(summary(object))), sep = "\n")
cat("\n")
cat("\\end{verbatim}", "\n")
cat("\\end{snugshade}", "\n")
cat("\\end{listing}", "\n")
if (clearpage) {
cat("\\clearpage", "\n")
}
}
#' @rdname summary_listing
#' @export
html_listing <- function(object, caption = NULL) {
cat("\n")
if (!is.null(caption)) {
cat("<caption>", caption, "</caption>", "\n", sep = "")
}
cat("<pre><code>\n")
cat(capture.output(suppressWarnings(summary(object))), sep = "\n")
cat("\n")
cat("</pre></code>\n")
}
|
