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() Demo + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+ + + +
+
+
+
+
+ +
+ + + + + + + +
+

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.

+
# 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
BrownBlueHazelGreen
Black 682015 5108
Brown119845429286
Red 26171414 71
Blond 7941016127
Total2202159364592
+
+
# Shade by frequency instead of residuals
+color_table(HEC, shade = "freq", title = "Hair × Eye Color (frequency shading)")
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Hair × Eye Color (frequency shading)
+
Eye
+
Total
BrownBlueHazelGreen
Black 682015 5108
Brown119845429286
Red 26171414 71
Blond 7941016127
Total2202159364592
+
+
# 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
BrownBlueHazelGreen
Black_Male321110 3 56
Black_Female36 9 5 2 52
Brown_Male53502515143
Brown_Female66342914143
Red_Male1010 7 7 34
Red_Female16 7 7 7 37
Blond_Male 330 5 8 46
Blond_Female 464 5 8 81
Total2202159364592
Shading based on residuals from model of complete independence, X^2 = 164.92, df = 24, p = 0
+
+
+
+
+

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.

+
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
BrownBlueHazelGreen
Black 682015 5108
Brown119845429286
Red 26171414 71
Blond 7941016127
Total2202159364592
+
+
knitr::include_graphics("color_table_hec.png")
+
+Hair × Eye Color shaded by residuals +

+Hair × Eye Color shaded by residuals +

+
+
+
+
+

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.

+
#' 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
BrownBlueHazelGreen
Black 682015 5108
Brown119845429286
Red 26171414 71
Blond 7941016127
Total2202159364592
+
+
+
+
+

More examples

+
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
+
BrownBlueHazelGreen
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
DivorcedMarried
Yes_Yes 45 15 60
Yes_No114 67181
No_Yes 53 8 61
No_No282452734
Total4945421036
Shading based on residuals from model of complete independence, X^2 = 270.14, df = 11, p = 0
+
+
+ + + +
+
+ +
+ + + + + + + + + + + + + + + + diff --git a/extra/color_table_demo.R b/extra/color_table_demo.R new file mode 100644 index 0000000..3303568 --- /dev/null +++ b/extra/color_table_demo.R @@ -0,0 +1,88 @@ +#' --- +#' title: "color_table() Demo" +#' author: "" +#' date: "`r Sys.Date()`" +#' output: +#' html_document: +#' toc: true +#' toc_float: true +#' self_contained: true +#' --- + +#+ 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. +#' +#' For HTML output, `gt` tables render natively — just return the object. +#' Compile this script with: +#' +#' ```r +#' rmarkdown::render("color_table_demo.R") +#' ``` + +#' ## Basic usage — shade by residuals + +#+ hec-setup +data(HairEyeColor) +HEC <- margin.table(HairEyeColor, 1:2) # collapse over Sex + +#+ hec-residuals, message=FALSE +color_table(HEC, title = "Hair × Eye Color (residual shading)") + +#' ## Shade by frequency + +#+ hec-freq +color_table(HEC, shade = "freq", title = "Hair × Eye Color (frequency shading)") + +#' ## 3-way table with formula layout + +#+ three-way, message=FALSE +color_table(HairEyeColor, + formula = Eye ~ Hair + Sex, + legend = TRUE, + title = "Hair × Eye × Sex (complete independence residuals)") + +#' ## Display residual values in cells + +#+ resid-values, message=FALSE +color_table(HEC, + values = "residuals", + title = "Hair × Eye — Pearson residuals in cells") + +#' ## Multi-way table — PreSex data + +#+ presex, message=FALSE +data(PreSex, package = "vcd") +color_table(PreSex, + formula = MaritalStatus ~ PremaritalSex + ExtramaritalSex, + legend = TRUE, + title = "Pre/Extra-marital Sex by Marital Status") + +#' ## Helper for non-HTML output +#' +#' If you ever need to knit this script to PDF or Word, the helper below +#' falls back to saving an image and using `knitr::include_graphics()`. + +#+ helper +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) + } +} + +#+ universal-demo, message=FALSE, out.width="70%" +include_color_table(HEC, + title = "Hair × Eye Color (any output format)", + file = "color_table_universal", + width = 520, + height = 300) diff --git a/extra/color_table_hec.png b/extra/color_table_hec.png new file mode 100644 index 0000000..a1aa0ce Binary files /dev/null and b/extra/color_table_hec.png differ diff --git a/extra/include_gt.R b/extra/include_gt.R new file mode 100644 index 0000000..0c50c93 --- /dev/null +++ b/extra/include_gt.R @@ -0,0 +1,61 @@ +#' Render a gt table object in any knitr output format +#' +#' In HTML output the gt object is returned as-is (gt's knit_print handles it). +#' In PDF, Word, or other non-HTML output the table is saved as a PNG via +#' gt::gtsave() and included with knitr::include_graphics(). +#' +#' Designed to be used at the end of a pipe: +#' +#' color_table(HEC, title = "Hair x Eye") |> include_gt() +#' gt::gt(my_df) |> gt::fmt_number() |> include_gt(file = "my_table") +#' +#' @param gt_obj A gt table object. +#' @param file Base filename (no extension) for the saved PNG. +#' Only used in non-HTML output. Defaults to a temp file. +#' @param width Viewport width in pixels passed to gt::gtsave(). +#' @param height Viewport height in pixels passed to gt::gtsave(). +#' @param ... Additional arguments passed to gt::gtsave(). +#' @return In HTML output, the gt object (rendered by knit_print). +#' In other formats, the result of knitr::include_graphics(). + +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) + } +} + +# --- Quick tests (run interactively or via rmarkdown::render) ---------------- + +library(vcdExtra) + +data(HairEyeColor) +HEC <- margin.table(HairEyeColor, 1:2) + +# Basic pipe usage +color_table(HEC, title = "Hair \u00d7 Eye Color") |> + include_gt() + +# Controlling image size for non-HTML output +color_table(HEC, shade = "freq", title = "Frequency shading") |> + include_gt(file = "hec_freq", width = 520, height = 300) + +# Works on any gt object, not just color_table() +as.data.frame(HEC) |> + gt::gt() |> + gt::tab_header(title = "Hair \u00d7 Eye (plain gt)") |> + include_gt(file = "hec_plain", width = 400, height = 300) + +# 3-way table +color_table(HairEyeColor, + formula = Eye ~ Hair + Sex, + legend = TRUE, + title = "3-way: Eye ~ Hair + Sex") |> + include_gt(file = "hec_3way", width = 620, height = 340) diff --git a/extra/include_gt_test.Rmd b/extra/include_gt_test.Rmd new file mode 100644 index 0000000..9215b97 --- /dev/null +++ b/extra/include_gt_test.Rmd @@ -0,0 +1,56 @@ +--- +title: "include_gt() test" +output: + html_document: + self_contained: true +--- + +```{r setup, include=FALSE} +knitr::opts_chunk$set(echo = TRUE, message = FALSE, warning = FALSE) +devtools::load_all(quiet = TRUE) +``` + +```{r define} +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) + } +} +``` + +```{r basic} +data(HairEyeColor) +HEC <- margin.table(HairEyeColor, 1:2) + +color_table(HEC, title = "Hair \u00d7 Eye Color") |> + include_gt() +``` + +```{r freq-shading} +color_table(HEC, shade = "freq", title = "Frequency shading") |> + include_gt() +``` + +```{r plain-gt} +# Works on any gt object +as.data.frame(HEC) |> + gt::gt() |> + gt::tab_header(title = "Hair \u00d7 Eye (plain gt)") |> + include_gt() +``` + +```{r three-way} +color_table(HairEyeColor, + formula = Eye ~ Hair + Sex, + legend = TRUE, + title = "3-way: Eye ~ Hair + Sex") |> + include_gt() +``` diff --git a/extra/include_gt_test.html b/extra/include_gt_test.html new file mode 100644 index 0000000..598ecbe --- /dev/null +++ b/extra/include_gt_test.html @@ -0,0 +1,2283 @@ + + + + + + + + + + + + + +include_gt() test + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+ + + + + + + +
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
BrownBlueHazelGreen
Black 682015 5108
Brown119845429286
Red 26171414 71
Blond 7941016127
Total2202159364592
+
+
color_table(HEC, shade = "freq", title = "Frequency shading") |>
+  include_gt()
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Frequency shading
+
Eye
+
Total
BrownBlueHazelGreen
Black 682015 5108
Brown119845429286
Red 26171414 71
Blond 7941016127
Total2202159364592
+
+
# 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)
HairEyeFreq
BlackBrown68
BrownBrown119
RedBrown26
BlondBrown7
BlackBlue20
BrownBlue84
RedBlue17
BlondBlue94
BlackHazel15
BrownHazel54
RedHazel14
BlondHazel10
BlackGreen5
BrownGreen29
RedGreen14
BlondGreen16
+
+
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
BrownBlueHazelGreen
Black_Male321110 3 56
Black_Female36 9 5 2 52
Brown_Male53502515143
Brown_Female66342914143
Red_Male1010 7 7 34
Red_Female16 7 7 7 37
Blond_Male 330 5 8 46
Blond_Female 464 5 8 81
Total2202159364592
Shading based on residuals from model of complete independence, X^2 = 164.92, df = 24, p = 0
+
+ + + + +
+ + + + + + + + + + + + + + + diff --git a/extra/knit_include.R b/extra/knit_include.R new file mode 100644 index 0000000..963d832 --- /dev/null +++ b/extra/knit_include.R @@ -0,0 +1,77 @@ +#' 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 gt::gtsave() +#' - `htmlwidget` (htmlwidgets family: plotly, DT, leaflet, dygraphs, ...) +#' -- saved via htmlwidgets::saveWidget() +#' + webshot2::webshot() +#' +#' Packages that handle cross-format output natively (flextable, kableExtra, +#' huxtable) do NOT need this helper. +#' +#' For any other class, `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 `gt_tbl` and +#' `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 gt::gtsave() or +#' webshot2::webshot(). +#' +#' @return For `gt_tbl` / `htmlwidget` in non-HTML output: the result of +#' knitr::include_graphics(). Otherwise: `x` unchanged. +#' +#' @examples +#' \dontrun{ +#' ## gt table +#' color_table(HEC) |> knit_include() +#' +#' ## DT widget +#' DT::datatable(mtcars) |> knit_include(width = 900, height = 500) +#' +#' ## plotly figure +#' plotly::plot_ly(mtcars, x = ~wt, y = ~mpg) |> knit_include() +#' } + +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/extra/knit_include_test.Rmd b/extra/knit_include_test.Rmd new file mode 100644 index 0000000..52a7f91 --- /dev/null +++ b/extra/knit_include_test.Rmd @@ -0,0 +1,66 @@ +--- +title: "knit_include() test" +output: + html_document: + toc: true + self_contained: true +--- + +```{r setup, include=FALSE} +knitr::opts_chunk$set(echo = TRUE, message = FALSE, warning = FALSE) +devtools::load_all(quiet = TRUE) +source("knit_include.R") + +data(HairEyeColor) +HEC <- margin.table(HairEyeColor, 1:2) +``` + +## gt_tbl via color_table() + +```{r gt-basic} +color_table(HEC, title = "Hair \u00d7 Eye Color") |> + knit_include() +``` + +```{r gt-freq} +color_table(HEC, shade = "freq", title = "Hair \u00d7 Eye (frequency shading)") |> + knit_include() +``` + +## htmlwidget — DT::datatable() + +```{r dt-basic} +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) +``` + +## htmlwidget — plotly + +```{r plotly-bar} +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) +``` + +## Unknown class — passes through unchanged + +`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. + +```{r passthrough} +# lm summary prints normally in HTML and PDF alike +lm(mpg ~ wt, data = mtcars) |> knit_include() +``` diff --git a/extra/knit_include_test.html b/extra/knit_include_test.html new file mode 100644 index 0000000..9db98c4 --- /dev/null +++ b/extra/knit_include_test.html @@ -0,0 +1,4885 @@ + + + + + + + + + + + + + +knit_include() test + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+ + + + + + +
+ +
+ +
+

gt_tbl via color_table()

+
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
BrownBlueHazelGreen
Black 682015 5108
Brown119845429286
Red 26171414 71
Blond 7941016127
Total2202159364592
+
+
color_table(HEC, shade = "freq", title = "Hair \u00d7 Eye (frequency shading)") |>
+  knit_include()
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Hair × Eye (frequency shading)
+
Eye
+
Total
BrownBlueHazelGreen
Black 682015 5108
Brown119845429286
Red 26171414 71
Blond 7941016127
Total2202159364592
+
+
+
+

htmlwidget — DT::datatable()

+
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)
+
+ +
+
+

htmlwidget — plotly

+
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)
+
+ +
+
+

Unknown class — passes through unchanged

+

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
+
+ + + + +
+ + + + + + + + + + + + + + + diff --git a/man/color_table.Rd b/man/color_table.Rd index a68f326..ee55169 100644 --- a/man/color_table.Rd +++ b/man/color_table.Rd @@ -131,7 +131,7 @@ residuals. The background colors are computed by interpolation using \item{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 \code{...}.} @@ -172,24 +172,42 @@ Otherwise, a fallback based on relative luminance (ITU-R BT.709) is used. \strong{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 \code{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") +} } \section{Methods (by class)}{ \itemize{ diff --git a/man/knit_include.Rd b/man/knit_include.Rd new file mode 100644 index 0000000..b508a9b --- /dev/null +++ b/man/knit_include.Rd @@ -0,0 +1,76 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/knit_include.R +\name{knit_include} +\alias{knit_include} +\title{Include an HTML-renderable object in any knitr output format} +\usage{ +knit_include( + x, + file = tempfile("ki_", tmpdir = "."), + width = 700, + height = 400, + ... +) +} +\arguments{ +\item{x}{Any R object. Specialised handling for \code{gt_tbl} and +\code{htmlwidget}; all other classes are passed through +unchanged.} + +\item{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.} + +\item{width}{Viewport / screenshot width in pixels (non-HTML only).} + +\item{height}{Viewport / screenshot height in pixels (non-HTML only).} + +\item{...}{Additional arguments forwarded to \code{\link[gt]{gtsave}} or +\code{\link[webshot2]{webshot}}.} +} +\value{ +For \code{gt_tbl} / \code{htmlwidget} in non-HTML output: the result +of \code{\link[knitr]{include_graphics}}. Otherwise: \code{x} +unchanged. +} +\description{ +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. +} +\details{ +Supported classes: +\itemize{ +\item \code{gt_tbl} (gt package) -- saved via \code{\link[gt]{gtsave}} +\item \code{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. +} +\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() +} + +} diff --git a/vignettes/articles/color_table.Rmd b/vignettes/articles/color_table.Rmd new file mode 100644 index 0000000..b6e118d --- /dev/null +++ b/vignettes/articles/color_table.Rmd @@ -0,0 +1,132 @@ +--- +title: "Using color_table() in R Markdown" +author: "Michael Friendly" +date: "`r Sys.Date()`" +package: vcdExtra +output: + rmarkdown::html_vignette: + toc: true +--- + +```{r setup, include=FALSE} +knitr::opts_chunk$set( + echo = TRUE, + message = FALSE, + warning = FALSE +) +options(rmarkdown.html_vignette.check_title = 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. + +`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). + +--- + +## HTML output — return the gt object directly + +No `filename` argument is needed for HTML output. + +```{r html-basic} +data(HairEyeColor) +HEC <- margin.table(HairEyeColor, 1:2) # collapse over Sex + +color_table(HEC, title = "Hair \u00d7 Eye Color (residual shading)") +``` + +```{r html-freq} +color_table(HEC, shade = "freq", title = "Hair \u00d7 Eye Color (frequency shading)") +``` + +```{r html-3way} +color_table(HairEyeColor, + formula = Eye ~ Hair + Sex, + legend = TRUE, + title = "Hair \u00d7 Eye \u00d7 Sex (complete independence residuals)") +``` + +--- + +## PDF / Word output — save image, then include it + +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. + +```{r pdf-basic, eval=FALSE} +color_table(HEC, + title = "Hair \u00d7 Eye Color", + filename = "color_table_hec.png", + vwidth = 520, + vheight = 300) + +knitr::include_graphics("color_table_hec.png") +``` + +--- + +## Universal helper — works in any output format + +This small wrapper branches on `knitr::is_html_output()` so the same source +knits correctly to HTML, PDF, or Word without changes. + +```{r helper} +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 universal-demo} +include_color_table(HEC, + title = "Hair \u00d7 Eye Color", + file = "color_table_universal", + width = 520, + height = 300) +``` + +--- + +## More examples + +### Display residual values in cells + +```{r residuals-display} +include_color_table(HEC, + values = "residuals", + title = "Hair \u00d7 Eye \u2014 Pearson residuals", + file = "color_table_resid", + width = 520, + height = 280) +``` + +### Multi-way table: PreSex data + +```{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/vignettes/articles/color_table.html b/vignettes/articles/color_table.html new file mode 100644 index 0000000..fc56e12 --- /dev/null +++ b/vignettes/articles/color_table.html @@ -0,0 +1,3205 @@ + + + + + + + + + + + + + + + + +Using color_table() in R Markdown + + + + + + + + + + + + + + + + + + + + + + + + + + +

Using color_table() in R Markdown

+

Michael Friendly

+

2026-03-13

+ + +
+ +
+ +
+

Overview

+

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

+
+
+
+

HTML output — return the gt object directly

+

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
BrownBlueHazelGreen
Black 682015 5108
Brown119845429286
Red 26171414 71
Blond 7941016127
Total2202159364592
+
+
color_table(HEC, shade = "freq", title = "Hair \u00d7 Eye Color (frequency shading)")
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Hair × Eye Color (frequency shading)
+
Eye
+
Total
BrownBlueHazelGreen
Black 682015 5108
Brown119845429286
Red 26171414 71
Blond 7941016127
Total2202159364592
+
+
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
BrownBlueHazelGreen
Black_Male321110 3 56
Black_Female36 9 5 2 52
Brown_Male53502515143
Brown_Female66342914143
Red_Male1010 7 7 34
Red_Female16 7 7 7 37
Blond_Male 330 5 8 46
Blond_Female 464 5 8 81
Total2202159364592
Shading based on residuals from model of complete independence, X^2 = 164.92, df = 24, p = 0
+
+
+
+
+

PDF / Word output — save image, then include it

+

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")
+
+
+
+

Universal helper — works in any output format

+

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
BrownBlueHazelGreen
Black 682015 5108
Brown119845429286
Red 26171414 71
Blond 7941016127
Total2202159364592
+
+
+
+
+

More examples

+
+

Display residual values in cells

+
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
+
BrownBlueHazelGreen
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
+
+
+
+

Multi-way table: PreSex data

+
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
DivorcedMarried
Yes_Yes 45 15 60
Yes_No114 67181
No_Yes 53 8 61
No_No282452734
Total4945421036
Shading based on residuals from model of complete independence, X^2 = 270.14, df = 11, p = 0
+
+
+
+ + + + + + + + + + +