diff --git a/.Rbuildignore b/.Rbuildignore index 2a70bce..7df1e28 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -14,6 +14,7 @@ Rplots.pdf ^_pkgdown\.yml$ ^docs$ ^pkgdown$ +^vignettes/articles$ ^vignettes-old/$ ^vignettes-new/$ README.* diff --git a/NAMESPACE b/NAMESPACE index b21fa4f..6f81183 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -68,6 +68,7 @@ export(get_model) export(get_models) export(glmlist) export(joint) +export(knit_include) export(labeling_points) export(loglin2formula) export(loglin2string) @@ -113,6 +114,8 @@ importFrom(grid,seekViewport) importFrom(grid,unit) importFrom(grid,upViewport) importFrom(grid,viewport) +importFrom(knitr,include_graphics) +importFrom(knitr,is_html_output) importFrom(methods,is) importFrom(rgl,translate3d) importFrom(stats,as.formula) diff --git a/R/color_table.R b/R/color_table.R index d248104..0c127d7 100644 --- a/R/color_table.R +++ b/R/color_table.R @@ -13,7 +13,7 @@ # Future enhancement: could extend `margins` to accept a list for custom styling. # # ✔️DONE: Add filename arg, which if not NULL saves the `gt` result as an image via gt::gtsave(). -# Supports .png, .svg, .pdf, .html, .rtf, .docx formats. Additional args passed via `...`. +# Supports .png, .pdf, .html, .rtf, .docx formats. Additional args passed via `...`. # # ✔️DONE: Refactored as S3 generic with methods for table, xtabs, ftable, structable, data.frame, matrix. # The .color_table_impl() internal function handles the core gt table building. @@ -90,24 +90,42 @@ #' **Use in documents** #' #' In R Markdown (\code{.Rmd}) or Quarto (\code{.qmd}) documents, \pkg{gt} tables -#' may not render correctly in all output formats. The \code{filename} argument -#' provides a workaround: save the table as an image, then include it using -#' \code{\link[knitr]{include_graphics}}. For example: +#' render natively in \strong{HTML output} — simply return the \code{gt} object from +#' a chunk and knitr renders it automatically via \pkg{gt}'s built-in +#' \code{knit_print} method. No \code{filename} argument is needed. +#' +#' For \strong{PDF or Word output}, \pkg{gt} does not render natively. Use the +#' \code{filename} argument to save the table as a \code{.png} image, then include +#' it with \code{\link[knitr]{include_graphics}}: #' #' \preformatted{ #' color_table(my_table, filename = "my_table.png") #' knitr::include_graphics("my_table.png") #' } #' -#' For higher quality output, \code{.svg} format is recommended. You can control -#' the image dimensions using the \code{vwidth} and \code{vheight} arguments -#' (passed via \code{...}). +#' The \code{vwidth} and \code{vheight} arguments (passed via \code{...}) control +#' the image viewport size in pixels. Supported save formats are +#' \code{.png}, \code{.pdf}, \code{.html}, \code{.rtf}, and \code{.docx}. +#' +#' For documents that target \strong{multiple output formats}, a small helper that +#' branches on \code{\link[knitr]{is_html_output}} avoids duplicating code: +#' +#' \preformatted{ +#' gt_obj <- color_table(my_table) +#' if (knitr::is_html_output()) { +#' gt_obj +#' } else { +#' gt::gtsave(gt_obj, "my_table.png") +#' knitr::include_graphics("my_table.png") +#' } +#' } #' -#' If you need a caption for cross-referencing (especially in Quarto or R Markdown), -#' you can use `gt::tab_caption()` +#' If you need a caption or cross-reference label, use \code{gt::tab_caption()} +#' on the returned object: #' \preformatted{ -#' gt_object |> tab_caption(caption = "Table 1: Pattern of Association in MyTable") -#' } +#' color_table(my_table) |> +#' gt::tab_caption("Table 1: Pattern of association in MyTable") +#' } #' #' @return A gt table object that can be further customized #' @@ -169,7 +187,7 @@ color_table <- function(x, ...) { #' @param title Optional table title #' @param filename Optional filename to save the table as an image. If provided, #' the table is saved using \code{\link[gt]{gtsave}}. Supported formats include -#' \code{.png}, \code{.svg}, \code{.pdf}, \code{.html}, \code{.rtf}, and \code{.docx}. +#' \code{.png}, \code{.pdf}, \code{.html}, \code{.rtf}, and \code{.docx}. #' The file format is determined by the file extension. Other arguments can be passed #' to \code{\link[gt]{gtsave}} via `...`. #' @export diff --git a/R/knit_include.R b/R/knit_include.R new file mode 100644 index 0000000..7a27796 --- /dev/null +++ b/R/knit_include.R @@ -0,0 +1,88 @@ +#' Include an HTML-renderable object in any knitr output format +#' +#' A pipe-friendly helper for objects that render natively in HTML output +#' (RStudio Viewer, HTML documents) but need an image fallback for PDF, Word, +#' and other non-HTML formats. +#' +#' Supported classes: +#' - `gt_tbl` (gt package) -- saved via \code{\link[gt]{gtsave}} +#' - `htmlwidget` (htmlwidgets family: plotly, DT, leaflet, dygraphs, ...) +#' -- saved via +#' \code{\link[htmlwidgets]{saveWidget}} +#' + \code{\link[webshot2]{webshot}} +#' +#' Packages that handle cross-format output natively (flextable, kableExtra, +#' huxtable) do NOT need this helper. +#' +#' For any other class, \code{x} is returned as-is in all output formats and +#' knitr's normal printing applies. This means the function is safe to use in +#' a pipe on any object: it only intervenes when it knows how to help. +#' +#' @param x Any R object. Specialised handling for \code{gt_tbl} and +#' \code{htmlwidget}; all other classes are passed through +#' unchanged. +#' @param file Base filename (no extension) for temporary files written when +#' output is not HTML. Defaults to a session-unique temp file in +#' the current directory so multiple calls don't collide. +#' @param width Viewport / screenshot width in pixels (non-HTML only). +#' @param height Viewport / screenshot height in pixels (non-HTML only). +#' @param ... Additional arguments forwarded to \code{\link[gt]{gtsave}} or +#' \code{\link[webshot2]{webshot}}. +#' +#' @return For \code{gt_tbl} / \code{htmlwidget} in non-HTML output: the result +#' of \code{\link[knitr]{include_graphics}}. Otherwise: \code{x} +#' unchanged. +#' +#' @examples +#' \dontrun{ +#' data(HairEyeColor) +#' HEC <- margin.table(HairEyeColor, 1:2) +#' +#' ## gt_tbl from color_table() +#' color_table(HEC, title = "Hair x Eye Color") |> knit_include() +#' +#' ## DT htmlwidget +#' DT::datatable(mtcars) |> knit_include(width = 900, height = 500) +#' +#' ## plotly htmlwidget +#' plotly::plot_ly(mtcars, x = ~wt, y = ~mpg) |> knit_include() +#' +#' ## Any other object passes through unchanged +#' lm(mpg ~ wt, data = mtcars) |> knit_include() +#' } +#' +#' @importFrom knitr is_html_output include_graphics +#' @export +knit_include <- function(x, + file = tempfile("ki_", tmpdir = "."), + width = 700, + height = 400, + ...) { + + if (knitr::is_html_output()) { + return(x) + } + + if (inherits(x, "gt_tbl")) { + img <- paste0(file, ".png") + gt::gtsave(x, filename = img, vwidth = width, vheight = height, ...) + return(knitr::include_graphics(img)) + } + + if (inherits(x, "htmlwidget")) { + if (!requireNamespace("htmlwidgets", quietly = TRUE)) + stop("Package 'htmlwidgets' is required for htmlwidget objects.") + if (!requireNamespace("webshot2", quietly = TRUE)) + stop("Package 'webshot2' is required for htmlwidget objects in non-HTML output.") + + html <- paste0(file, ".html") + img <- paste0(file, ".png") + htmlwidgets::saveWidget(x, html, selfcontained = TRUE) + webshot2::webshot(html, img, vwidth = width, vheight = height, ...) + return(knitr::include_graphics(img)) + } + + # Unknown class: return x and let knitr's normal printing handle it, + # just as it would outside a pipe. + x +} diff --git a/_pkgdown.yml b/_pkgdown.yml index e795bcc..a7fe921 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -7,6 +7,12 @@ template: params: bootswatch: cosmo +articles: + - title: "color_table" + desc: "Heatmap-style display of frequency tables" + contents: + - color_table + reference: - title: Mosaics @@ -48,6 +54,7 @@ reference: - assoc_graph - plot.assoc_graph - color_table + - knit_include - mcaplot diff --git a/extra/check_pkgs.R b/extra/check_pkgs.R new file mode 100644 index 0000000..1fcffef --- /dev/null +++ b/extra/check_pkgs.R @@ -0,0 +1,2 @@ +for (p in c("DT", "plotly", "htmlwidgets", "webshot2")) + cat(p, ":", system.file(package = p) != "", "\n") diff --git a/extra/color_table_demo-qmd.qmd b/extra/color_table_demo-qmd.qmd new file mode 100644 index 0000000..865ee8e --- /dev/null +++ b/extra/color_table_demo-qmd.qmd @@ -0,0 +1,165 @@ +--- +title: "Using color_table() in Quarto" +author: "Michael Friendly" +date: today +format: + html: + toc: true + toc-float: true + embed-resources: true + pdf: + toc: true +--- + +```{r} +#| label: setup +#| include: false +library(vcdExtra) +``` + +## Overview + +`color_table()` produces a `gt` table object with cell backgrounds shaded by +observed frequencies or Pearson residuals from an independence model. + +**Rendering in Quarto documents:** + +| Format | Strategy | +|--------|----------| +| HTML | Return the `gt` object — renders natively via gt's `knit_print` | +| PDF | `gt` can render to LaTeX/PDF via `gt::as_latex()`, but the easiest cross-format path is `filename = "…png"` + `knitr::include_graphics()`. Supported formats: `.png`, `.pdf`, `.html`, `.rtf`, `.docx` (not `.svg`) | +| Word | Same save-as-image approach | + +--- + +## HTML output — return the gt object directly + +For HTML output no `filename` argument is needed. + +```{r} +#| label: html-basic +data(HairEyeColor) +HEC <- margin.table(HairEyeColor, 1:2) # collapse over Sex + +color_table(HEC, title = "Hair × Eye Color (residual shading)") +``` + +```{r} +#| label: html-freq +color_table(HEC, shade = "freq", title = "Hair × Eye Color (frequency shading)") +``` + +```{r} +#| label: html-3way +color_table(HairEyeColor, + formula = Eye ~ Hair + Sex, + legend = TRUE, + title = "Hair × Eye × Sex (complete independence residuals)") +``` + +--- + +## PDF / Word output — save image, then include it + +Save the table as a PNG (or SVG) and include with `knitr::include_graphics()`. + +```{r} +#| label: pdf-basic +#| out-width: 70% +#| fig-cap: "Hair × Eye Color shaded by residuals" +color_table(HEC, + title = "Hair × Eye Color", + filename = "color_table_hec.png") + +knitr::include_graphics("color_table_hec.png") +``` + +--- + +## Easier universal approach — branch on output format + +The helper below selects the right strategy automatically. + +```{r} +#| label: helper +#' Render a color_table result in any knitr/Quarto output format +#' +#' @param x Object accepted by color_table() +#' @param file Base filename (no extension) for the saved image. +#' Used only for non-HTML output. +#' @param width Image viewport width in pixels (non-HTML only) +#' @param height Image viewport height in pixels (non-HTML only) +#' @param ... Additional arguments forwarded to color_table() +include_color_table <- function(x, ..., file = "color_table_tmp", + width = 600, height = 400) { + gt_obj <- color_table(x, ...) + + if (knitr::is_html_output()) { + gt_obj + } else { + img <- paste0(file, ".png") + gt::gtsave(gt_obj, filename = img, vwidth = width, vheight = height) + knitr::include_graphics(img) + } +} +``` + +```{r} +#| label: universal-demo +#| out-width: 65% +#| fig-cap: "Hair × Eye Color — same source renders in HTML and PDF" +include_color_table(HEC, + title = "Hair × Eye Color", + file = "color_table_universal", + width = 520, + height = 300) +``` + +--- + +## Cross-referencing tables in Quarto + +Quarto can cross-reference `gt` tables in HTML output using a labelled chunk +combined with `gt::tab_caption()`. + +```{r} +#| label: tbl-hairey +#| tbl-cap: "Hair and Eye Color frequencies" +HEC |> + color_table(title = "Hair × Eye Color") |> + gt::tab_caption(caption = "Hair and Eye Color frequencies") +``` + +See @tbl-hairey for the colored frequency table. + +*(Note: `@tbl-` cross-references work for HTML and PDF Quarto output. +In PDF, the `gt` object must be returned as a `gt` — Quarto calls +`gt::as_latex()` internally — or use the save-as-image fallback above.)* + +--- + +## More examples + +```{r} +#| label: residuals-display +#| out-width: 65% +#| fig-cap: "Pearson residual values shown in cells" +include_color_table(HEC, + values = "residuals", + title = "Hair × Eye — Pearson residuals", + file = "color_table_resid", + width = 520, + height = 280) +``` + +```{r} +#| label: presex +data(PreSex, package = "vcd") +include_color_table(PreSex, + formula = MaritalStatus ~ PremaritalSex + ExtramaritalSex, + legend = TRUE, + title = "Pre/Extra-marital Sex by Marital Status", + file = "color_table_presex", + width = 520, + height = 300) +``` diff --git a/extra/color_table_demo-rmd.Rmd b/extra/color_table_demo-rmd.Rmd new file mode 100644 index 0000000..eda1472 --- /dev/null +++ b/extra/color_table_demo-rmd.Rmd @@ -0,0 +1,143 @@ +--- +title: "Using color_table() in Rmarkdown" +author: "Michael Friendly" +date: "`r Sys.Date()`" +output: + html_document: + toc: true + toc_float: true + pdf_document: + toc: true +--- + +```{r setup, include=FALSE} +knitr::opts_chunk$set( + echo = TRUE, + message = FALSE, + warning = FALSE +) +library(vcdExtra) +``` + +## Overview + +`color_table()` produces a `gt` table object with cell backgrounds shaded by +observed frequencies or Pearson residuals from an independence model. + +**Rendering in documents:** +`gt` tables render natively in **HTML** output (just return the object). +For **PDF** or **Word** output, save the table as an image first, then include +it with `knitr::include_graphics()`. + +A convenience wrapper at the bottom of this document handles both cases +automatically. + +--- + +## HTML output — return the gt object directly + +For HTML output, no `filename` argument is needed. Simply return the `gt` +object and knitr renders it via gt's built-in `knit_print` method. + +```{r html-basic} +# Works as-is for HTML output +data(HairEyeColor) +HEC <- margin.table(HairEyeColor, 1:2) # collapse over Sex + +color_table(HEC, title = "Hair × Eye Color (residual shading)") +``` + +```{r html-freq} +# Shade by frequency instead of residuals +color_table(HEC, shade = "freq", title = "Hair × Eye Color (frequency shading)") +``` + +```{r html-3way} +# 3-way table with a formula to specify the layout +color_table(HairEyeColor, + formula = Eye ~ Hair + Sex, + legend = TRUE, + title = "Hair × Eye × Sex (complete independence residuals)") +``` + +--- + +## PDF / Word output — save image, then include it + +For non-HTML formats, save the table as a PNG (or SVG for sharper output) and +include it with `knitr::include_graphics()`. The chunk option +`out.width` controls the display size. +Note: `gt::gtsave()` supports `.png`, `.pdf`, `.html`, `.rtf`, and `.docx` — not `.svg`. + +```{r pdf-basic, out.width = "70%", fig.cap = "Hair × Eye Color shaded by residuals"} +color_table(HEC, + title = "Hair × Eye Color", + filename = "color_table_hec.png") + +knitr::include_graphics("color_table_hec.png") +``` + + +--- + +## Easier universal approach — branch on output format + +The helper below picks the right strategy automatically, so the same source +works for both HTML and PDF/Word knits. + +```{r helper} +#' Render a color_table result in any knitr output format +#' +#' @param x Object accepted by color_table() +#' @param file Base filename (without extension) for the saved image. +#' Used only when the output is not HTML. +#' @param width Image viewport width in pixels (non-HTML only) +#' @param height Image viewport height in pixels (non-HTML only) +#' @param ... Additional arguments forwarded to color_table() +include_color_table <- function(x, ..., file = "color_table_tmp", + width = 600, height = 400) { + gt_obj <- color_table(x, ...) + + if (knitr::is_html_output()) { + # HTML: gt renders natively + gt_obj + } else { + # PDF / Word / etc.: save as PNG and include + img <- paste0(file, ".png") + gt::gtsave(gt_obj, filename = img, vwidth = width, vheight = height) + knitr::include_graphics(img) + } +} +``` + +```{r universal-demo, out.width = "65%", fig.cap = "Hair × Eye Color — works in HTML and PDF"} +include_color_table(HEC, + title = "Hair × Eye Color", + file = "color_table_universal", + width = 520, + height = 300) +``` + +--- + +## More examples + +```{r residuals-display, out.width = "65%", fig.cap = "Residual values shown in cells"} +include_color_table(HEC, + values = "residuals", + title = "Hair × Eye — Pearson residuals", + file = "color_table_resid", + width = 520, + height = 280) +``` + +```{r presex} +data(PreSex, package = "vcd") +include_color_table(PreSex, + formula = MaritalStatus ~ PremaritalSex + ExtramaritalSex, + legend = TRUE, + title = "Pre/Extra-marital Sex by Marital Status", + file = "color_table_presex", + width = 520, + height = 300) +``` diff --git a/extra/color_table_demo-rmd.html b/extra/color_table_demo-rmd.html new file mode 100644 index 0000000..1e8d967 --- /dev/null +++ b/extra/color_table_demo-rmd.html @@ -0,0 +1,4848 @@ + + + + +
+ + + + + + + + + + +color_table() produces a gt table object
+with cell backgrounds shaded by observed frequencies or Pearson
+residuals from an independence model.
Rendering in documents: gt tables
+render natively in HTML output (just return the
+object). For PDF or Word output, save
+the table as an image first, then include it with
+knitr::include_graphics().
A convenience wrapper at the bottom of this document handles both +cases automatically.
+For HTML output, no filename argument is needed. Simply
+return the gt object and knitr renders it via gt’s built-in
+knit_print method.
# Works as-is for HTML output
+data(HairEyeColor)
+HEC <- margin.table(HairEyeColor, 1:2) # collapse over Sex
+
+color_table(HEC, title = "Hair × Eye Color (residual shading)")
+## Shading based on residuals from model of independence,
+## X^2 = 138.29, df = 9, p = 2.325e-25
+| Hair × Eye Color (residual shading) | +|||||
| + |
+ Eye
+ |
+ Total | +|||
|---|---|---|---|---|---|
| Brown | +Blue | +Hazel | +Green | +||
| Black | +68 | +20 | +15 | +5 | +108 |
| Brown | +119 | +84 | +54 | +29 | +286 |
| Red | +26 | +17 | +14 | +14 | +71 |
| Blond | +7 | +94 | +10 | +16 | +127 |
| Total | +220 | +215 | +93 | +64 | +592 |
# Shade by frequency instead of residuals
+color_table(HEC, shade = "freq", title = "Hair × Eye Color (frequency shading)")
+| Hair × Eye Color (frequency shading) | +|||||
| + |
+ Eye
+ |
+ Total | +|||
|---|---|---|---|---|---|
| Brown | +Blue | +Hazel | +Green | +||
| Black | +68 | +20 | +15 | +5 | +108 |
| Brown | +119 | +84 | +54 | +29 | +286 |
| Red | +26 | +17 | +14 | +14 | +71 |
| Blond | +7 | +94 | +10 | +16 | +127 |
| Total | +220 | +215 | +93 | +64 | +592 |
# 3-way table with a formula to specify the layout
+color_table(HairEyeColor,
+ formula = Eye ~ Hair + Sex,
+ legend = TRUE,
+ title = "Hair × Eye × Sex (complete independence residuals)")
+## Re-fitting to get frequencies and fitted values
+## Shading based on residuals from model of complete independence, X^2 = 164.92, df = 24, p = 0
+| Hair × Eye × Sex (complete independence residuals) | +|||||
| + |
+ Eye
+ |
+ Total | +|||
|---|---|---|---|---|---|
| Brown | +Blue | +Hazel | +Green | +||
| Black_Male | +32 | +11 | +10 | +3 | +56 |
| Black_Female | +36 | +9 | +5 | +2 | +52 |
| Brown_Male | +53 | +50 | +25 | +15 | +143 |
| Brown_Female | +66 | +34 | +29 | +14 | +143 |
| Red_Male | +10 | +10 | +7 | +7 | +34 |
| Red_Female | +16 | +7 | +7 | +7 | +37 |
| Blond_Male | +3 | +30 | +5 | +8 | +46 |
| Blond_Female | +4 | +64 | +5 | +8 | +81 |
| Total | +220 | +215 | +93 | +64 | +592 |
| Shading based on residuals from model of complete independence, X^2 = 164.92, df = 24, p = 0 | +|||||
For non-HTML formats, save the table as a PNG (or SVG for sharper
+output) and include it with knitr::include_graphics(). The
+chunk option out.width controls the display size. Note:
+gt::gtsave() supports .png, .pdf,
+.html, .rtf, and .docx — not
+.svg.
color_table(HEC,
+ title = "Hair × Eye Color",
+ filename = "color_table_hec.png")
+## Shading based on residuals from model of independence,
+## X^2 = 138.29, df = 9, p = 2.325e-25
+| Hair × Eye Color | +|||||
| + |
+ Eye
+ |
+ Total | +|||
|---|---|---|---|---|---|
| Brown | +Blue | +Hazel | +Green | +||
| Black | +68 | +20 | +15 | +5 | +108 |
| Brown | +119 | +84 | +54 | +29 | +286 |
| Red | +26 | +17 | +14 | +14 | +71 |
| Blond | +7 | +94 | +10 | +16 | +127 |
| Total | +220 | +215 | +93 | +64 | +592 |
knitr::include_graphics("color_table_hec.png")
++Hair × Eye Color shaded by residuals +
+The helper below picks the right strategy automatically, so the same +source works for both HTML and PDF/Word knits.
+#' Render a color_table result in any knitr output format
+#'
+#' @param x Object accepted by color_table()
+#' @param file Base filename (without extension) for the saved image.
+#' Used only when the output is not HTML.
+#' @param width Image viewport width in pixels (non-HTML only)
+#' @param height Image viewport height in pixels (non-HTML only)
+#' @param ... Additional arguments forwarded to color_table()
+include_color_table <- function(x, ..., file = "color_table_tmp",
+ width = 600, height = 400) {
+ gt_obj <- color_table(x, ...)
+
+ if (knitr::is_html_output()) {
+ # HTML: gt renders natively
+ gt_obj
+ } else {
+ # PDF / Word / etc.: save as PNG and include
+ img <- paste0(file, ".png")
+ gt::gtsave(gt_obj, filename = img, vwidth = width, vheight = height)
+ knitr::include_graphics(img)
+ }
+}
+include_color_table(HEC,
+ title = "Hair × Eye Color",
+ file = "color_table_universal",
+ width = 520,
+ height = 300)
+## Shading based on residuals from model of independence,
+## X^2 = 138.29, df = 9, p = 2.325e-25
+| Hair × Eye Color | +|||||
| + |
+ Eye
+ |
+ Total | +|||
|---|---|---|---|---|---|
| Brown | +Blue | +Hazel | +Green | +||
| Black | +68 | +20 | +15 | +5 | +108 |
| Brown | +119 | +84 | +54 | +29 | +286 |
| Red | +26 | +17 | +14 | +14 | +71 |
| Blond | +7 | +94 | +10 | +16 | +127 |
| Total | +220 | +215 | +93 | +64 | +592 |
include_color_table(HEC,
+ values = "residuals",
+ title = "Hair × Eye — Pearson residuals",
+ file = "color_table_resid",
+ width = 520,
+ height = 280)
+## Shading based on residuals from model of independence,
+## X^2 = 138.29, df = 9, p = 2.325e-25
+| Hair × Eye — Pearson residuals | +||||
| + |
+ Eye
+ |
+ |||
|---|---|---|---|---|
| Brown | +Blue | +Hazel | +Green | +|
| Black | +4.40 | +-3.07 | +-0.48 | +-1.95 |
| Brown | +1.23 | +-1.95 | +1.35 | +-0.35 |
| Red | +-0.07 | +-1.73 | +0.85 | +2.28 |
| Blond | +-5.85 | +7.05 | +-2.23 | +0.61 |
data(PreSex, package = "vcd")
+include_color_table(PreSex,
+ formula = MaritalStatus ~ PremaritalSex + ExtramaritalSex,
+ legend = TRUE,
+ title = "Pre/Extra-marital Sex by Marital Status",
+ file = "color_table_presex",
+ width = 520,
+ height = 300)
+## Re-fitting to get frequencies and fitted values
+## Shading based on residuals from model of complete independence, X^2 = 270.14, df = 11, p = 0
+| Pre/Extra-marital Sex by Marital Status | +|||
| + |
+ MaritalStatus
+ |
+ Total | +|
|---|---|---|---|
| Divorced | +Married | +||
| Yes_Yes | +45 | +15 | +60 |
| Yes_No | +114 | +67 | +181 |
| No_Yes | +53 | +8 | +61 |
| No_No | +282 | +452 | +734 |
| Total | +494 | +542 | +1036 |
| Shading based on residuals from model of complete independence, X^2 = 270.14, df = 11, p = 0 | +|||
include_gt <- function(gt_obj,
+ file = tempfile("gt_", tmpdir = "."),
+ width = 600,
+ height = 400,
+ ...) {
+ if (knitr::is_html_output()) {
+ gt_obj
+ } else {
+ img <- paste0(file, ".png")
+ gt::gtsave(gt_obj, filename = img, vwidth = width, vheight = height, ...)
+ knitr::include_graphics(img)
+ }
+}
+data(HairEyeColor)
+HEC <- margin.table(HairEyeColor, 1:2)
+
+color_table(HEC, title = "Hair \u00d7 Eye Color") |>
+ include_gt()
+## Shading based on residuals from model of independence,
+## X^2 = 138.29, df = 9, p = 2.325e-25
+| Hair × Eye Color | +|||||
| + |
+ Eye
+ |
+ Total | +|||
|---|---|---|---|---|---|
| Brown | +Blue | +Hazel | +Green | +||
| Black | +68 | +20 | +15 | +5 | +108 |
| Brown | +119 | +84 | +54 | +29 | +286 |
| Red | +26 | +17 | +14 | +14 | +71 |
| Blond | +7 | +94 | +10 | +16 | +127 |
| Total | +220 | +215 | +93 | +64 | +592 |
color_table(HEC, shade = "freq", title = "Frequency shading") |>
+ include_gt()
+| Frequency shading | +|||||
| + |
+ Eye
+ |
+ Total | +|||
|---|---|---|---|---|---|
| Brown | +Blue | +Hazel | +Green | +||
| Black | +68 | +20 | +15 | +5 | +108 |
| Brown | +119 | +84 | +54 | +29 | +286 |
| Red | +26 | +17 | +14 | +14 | +71 |
| Blond | +7 | +94 | +10 | +16 | +127 |
| Total | +220 | +215 | +93 | +64 | +592 |
# Works on any gt object
+as.data.frame(HEC) |>
+ gt::gt() |>
+ gt::tab_header(title = "Hair \u00d7 Eye (plain gt)") |>
+ include_gt()
+| Hair × Eye (plain gt) | +||
| Hair | +Eye | +Freq | +
|---|---|---|
| Black | +Brown | +68 |
| Brown | +Brown | +119 |
| Red | +Brown | +26 |
| Blond | +Brown | +7 |
| Black | +Blue | +20 |
| Brown | +Blue | +84 |
| Red | +Blue | +17 |
| Blond | +Blue | +94 |
| Black | +Hazel | +15 |
| Brown | +Hazel | +54 |
| Red | +Hazel | +14 |
| Blond | +Hazel | +10 |
| Black | +Green | +5 |
| Brown | +Green | +29 |
| Red | +Green | +14 |
| Blond | +Green | +16 |
color_table(HairEyeColor,
+ formula = Eye ~ Hair + Sex,
+ legend = TRUE,
+ title = "3-way: Eye ~ Hair + Sex") |>
+ include_gt()
+## Re-fitting to get frequencies and fitted values
+## Shading based on residuals from model of complete independence, X^2 = 164.92, df = 24, p = 0
+| 3-way: Eye ~ Hair + Sex | +|||||
| + |
+ Eye
+ |
+ Total | +|||
|---|---|---|---|---|---|
| Brown | +Blue | +Hazel | +Green | +||
| Black_Male | +32 | +11 | +10 | +3 | +56 |
| Black_Female | +36 | +9 | +5 | +2 | +52 |
| Brown_Male | +53 | +50 | +25 | +15 | +143 |
| Brown_Female | +66 | +34 | +29 | +14 | +143 |
| Red_Male | +10 | +10 | +7 | +7 | +34 |
| Red_Female | +16 | +7 | +7 | +7 | +37 |
| Blond_Male | +3 | +30 | +5 | +8 | +46 |
| Blond_Female | +4 | +64 | +5 | +8 | +81 |
| Total | +220 | +215 | +93 | +64 | +592 |
| Shading based on residuals from model of complete independence, X^2 = 164.92, df = 24, p = 0 | +|||||
color_table(HEC, title = "Hair \u00d7 Eye Color") |>
+ knit_include()
+## Shading based on residuals from model of independence,
+## X^2 = 138.29, df = 9, p = 2.325e-25
+| Hair × Eye Color | +|||||
| + |
+ Eye
+ |
+ Total | +|||
|---|---|---|---|---|---|
| Brown | +Blue | +Hazel | +Green | +||
| Black | +68 | +20 | +15 | +5 | +108 |
| Brown | +119 | +84 | +54 | +29 | +286 |
| Red | +26 | +17 | +14 | +14 | +71 |
| Blond | +7 | +94 | +10 | +16 | +127 |
| Total | +220 | +215 | +93 | +64 | +592 |
color_table(HEC, shade = "freq", title = "Hair \u00d7 Eye (frequency shading)") |>
+ knit_include()
+| Hair × Eye (frequency shading) | +|||||
| + |
+ Eye
+ |
+ Total | +|||
|---|---|---|---|---|---|
| Brown | +Blue | +Hazel | +Green | +||
| Black | +68 | +20 | +15 | +5 | +108 |
| Brown | +119 | +84 | +54 | +29 | +286 |
| Red | +26 | +17 | +14 | +14 | +71 |
| Blond | +7 | +94 | +10 | +16 | +127 |
| Total | +220 | +215 | +93 | +64 | +592 |
DT::datatable(as.data.frame(HEC),
+ caption = "Hair \u00d7 Eye Color frequencies",
+ rownames = FALSE,
+ options = list(pageLength = 8, dom = "t")) |>
+ knit_include(width = 500, height = 350)
+
+
+library(plotly)
+
+hec_df <- as.data.frame(HEC)
+
+plot_ly(hec_df,
+ x = ~Hair,
+ y = ~Freq,
+ color = ~Eye,
+ type = "bar") |>
+ layout(barmode = "group",
+ title = "Hair \u00d7 Eye Color counts") |>
+ knit_include(width = 700, height = 450)
+
+
+knit_include() only intervenes for gt_tbl
+and htmlwidget. Any other object is returned as-is so
+knitr’s normal printing applies, just as if the pipe were not there.
# lm summary prints normally in HTML and PDF alike
+lm(mpg ~ wt, data = mtcars) |> knit_include()
+##
+## Call:
+## lm(formula = mpg ~ wt, data = mtcars)
+##
+## Coefficients:
+## (Intercept) wt
+## 37.285 -5.344
+color_table() produces a gt table object
+with cell backgrounds shaded by observed frequencies or Pearson
+residuals from an independence model.
gt tables render natively in HTML
+output — just return the object from a chunk and knitr handles
+the rest via gt’s built-in knit_print method.
+For PDF or Word output, save the table as a
+.png image and include it with
+knitr::include_graphics() (see [PDF / Word output]
+below).
No filename argument is needed for HTML output.
data(HairEyeColor)
+HEC <- margin.table(HairEyeColor, 1:2) # collapse over Sex
+
+color_table(HEC, title = "Hair \u00d7 Eye Color (residual shading)")## Shading based on residuals from model of independence,
+## X^2 = 138.29, df = 9, p = 2.325e-25
+| Hair × Eye Color (residual shading) | +|||||
| + |
+ Eye
+ |
+ Total | +|||
|---|---|---|---|---|---|
| Brown | +Blue | +Hazel | +Green | +||
| Black | +68 | +20 | +15 | +5 | +108 |
| Brown | +119 | +84 | +54 | +29 | +286 |
| Red | +26 | +17 | +14 | +14 | +71 |
| Blond | +7 | +94 | +10 | +16 | +127 |
| Total | +220 | +215 | +93 | +64 | +592 |
| Hair × Eye Color (frequency shading) | +|||||
| + |
+ Eye
+ |
+ Total | +|||
|---|---|---|---|---|---|
| Brown | +Blue | +Hazel | +Green | +||
| Black | +68 | +20 | +15 | +5 | +108 |
| Brown | +119 | +84 | +54 | +29 | +286 |
| Red | +26 | +17 | +14 | +14 | +71 |
| Blond | +7 | +94 | +10 | +16 | +127 |
| Total | +220 | +215 | +93 | +64 | +592 |
color_table(HairEyeColor,
+ formula = Eye ~ Hair + Sex,
+ legend = TRUE,
+ title = "Hair \u00d7 Eye \u00d7 Sex (complete independence residuals)")## Re-fitting to get frequencies and fitted values
+## Shading based on residuals from model of complete independence, X^2 = 164.92, df = 24, p = 0
+| Hair × Eye × Sex (complete independence residuals) | +|||||
| + |
+ Eye
+ |
+ Total | +|||
|---|---|---|---|---|---|
| Brown | +Blue | +Hazel | +Green | +||
| Black_Male | +32 | +11 | +10 | +3 | +56 |
| Black_Female | +36 | +9 | +5 | +2 | +52 |
| Brown_Male | +53 | +50 | +25 | +15 | +143 |
| Brown_Female | +66 | +34 | +29 | +14 | +143 |
| Red_Male | +10 | +10 | +7 | +7 | +34 |
| Red_Female | +16 | +7 | +7 | +7 | +37 |
| Blond_Male | +3 | +30 | +5 | +8 | +46 |
| Blond_Female | +4 | +64 | +5 | +8 | +81 |
| Total | +220 | +215 | +93 | +64 | +592 |
| Shading based on residuals from model of complete independence, X^2 = 164.92, df = 24, p = 0 | +|||||
For non-HTML output, save the table as a PNG and include with
+knitr::include_graphics(). Supported formats:
+.png, .pdf, .html,
+.rtf, .docx. The vwidth and
+vheight arguments control the image viewport in pixels.
The chunk below is shown for illustration (eval=FALSE);
+the HTML approach above is all that is needed when knitting to HTML.
color_table(HEC,
+ title = "Hair \u00d7 Eye Color",
+ filename = "color_table_hec.png",
+ vwidth = 520,
+ vheight = 300)
+
+knitr::include_graphics("color_table_hec.png")This small wrapper branches on knitr::is_html_output()
+so the same source knits correctly to HTML, PDF, or Word without
+changes.
include_color_table <- function(x, ..., file = "color_table_tmp",
+ width = 600, height = 400) {
+ gt_obj <- color_table(x, ...)
+ if (knitr::is_html_output()) {
+ gt_obj
+ } else {
+ img <- paste0(file, ".png")
+ gt::gtsave(gt_obj, filename = img, vwidth = width, vheight = height)
+ knitr::include_graphics(img)
+ }
+}include_color_table(HEC,
+ title = "Hair \u00d7 Eye Color",
+ file = "color_table_universal",
+ width = 520,
+ height = 300)## Shading based on residuals from model of independence,
+## X^2 = 138.29, df = 9, p = 2.325e-25
+| Hair × Eye Color | +|||||
| + |
+ Eye
+ |
+ Total | +|||
|---|---|---|---|---|---|
| Brown | +Blue | +Hazel | +Green | +||
| Black | +68 | +20 | +15 | +5 | +108 |
| Brown | +119 | +84 | +54 | +29 | +286 |
| Red | +26 | +17 | +14 | +14 | +71 |
| Blond | +7 | +94 | +10 | +16 | +127 |
| Total | +220 | +215 | +93 | +64 | +592 |
include_color_table(HEC,
+ values = "residuals",
+ title = "Hair \u00d7 Eye \u2014 Pearson residuals",
+ file = "color_table_resid",
+ width = 520,
+ height = 280)## Shading based on residuals from model of independence,
+## X^2 = 138.29, df = 9, p = 2.325e-25
+| Hair × Eye — Pearson residuals | +||||
| + |
+ Eye
+ |
+ |||
|---|---|---|---|---|
| Brown | +Blue | +Hazel | +Green | +|
| Black | +4.40 | +-3.07 | +-0.48 | +-1.95 |
| Brown | +1.23 | +-1.95 | +1.35 | +-0.35 |
| Red | +-0.07 | +-1.73 | +0.85 | +2.28 |
| Blond | +-5.85 | +7.05 | +-2.23 | +0.61 |
data(PreSex, package = "vcd")
+include_color_table(PreSex,
+ formula = MaritalStatus ~ PremaritalSex + ExtramaritalSex,
+ legend = TRUE,
+ title = "Pre/Extra-marital Sex by Marital Status",
+ file = "color_table_presex",
+ width = 520,
+ height = 300)## Re-fitting to get frequencies and fitted values
+## Shading based on residuals from model of complete independence, X^2 = 270.14, df = 11, p = 0
+| Pre/Extra-marital Sex by Marital Status | +|||
| + |
+ MaritalStatus
+ |
+ Total | +|
|---|---|---|---|
| Divorced | +Married | +||
| Yes_Yes | +45 | +15 | +60 |
| Yes_No | +114 | +67 | +181 |
| No_Yes | +53 | +8 | +61 |
| No_No | +282 | +452 | +734 |
| Total | +494 | +542 | +1036 |
| Shading based on residuals from model of complete independence, X^2 = 270.14, df = 11, p = 0 | +|||