From e1ee5e7fd15a33c287c280bc69ad231c7844ce2d Mon Sep 17 00:00:00 2001 From: Michael Friendly Date: Fri, 13 Mar 2026 21:48:55 -0400 Subject: [PATCH 1/2] sort out color_table in Rmd/qmd --- .Rbuildignore | 1 + R/color_table.R | 42 +- _pkgdown.yml | 6 + extra/color_table_demo-qmd.qmd | 165 + extra/color_table_demo-rmd.Rmd | 143 + extra/color_table_demo-rmd.html | 4848 +++++++++++++++++++++++++++ extra/color_table_demo.R | 88 + extra/color_table_hec.png | Bin 0 -> 33938 bytes extra/include_gt.R | 61 + extra/include_gt_test.Rmd | 56 + extra/include_gt_test.html | 2283 +++++++++++++ vignettes/articles/color_table.Rmd | 132 + vignettes/articles/color_table.html | 3205 ++++++++++++++++++ 13 files changed, 11018 insertions(+), 12 deletions(-) create mode 100644 extra/color_table_demo-qmd.qmd create mode 100644 extra/color_table_demo-rmd.Rmd create mode 100644 extra/color_table_demo-rmd.html create mode 100644 extra/color_table_demo.R create mode 100644 extra/color_table_hec.png create mode 100644 extra/include_gt.R create mode 100644 extra/include_gt_test.Rmd create mode 100644 extra/include_gt_test.html create mode 100644 vignettes/articles/color_table.Rmd create mode 100644 vignettes/articles/color_table.html diff --git a/.Rbuildignore b/.Rbuildignore index 2a70bcee..7df1e281 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/R/color_table.R b/R/color_table.R index d248104e..0c127d79 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/_pkgdown.yml b/_pkgdown.yml index e795bcce..c3fda3e6 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 diff --git a/extra/color_table_demo-qmd.qmd b/extra/color_table_demo-qmd.qmd new file mode 100644 index 00000000..865ee8ea --- /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 00000000..eda1472e --- /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 00000000..1e8d967d --- /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 00000000..33035686 --- /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 0000000000000000000000000000000000000000..a1aa0ce26041c9783142b800e7e00f97f1c13ec8 GIT binary patch literal 33938 zcmce-byQr>+V4pq0wF+v;0XkGx8Mox?(Xi;xFjLCyVF<$-Ox>NZAfq@cyJ5uG_KS6 zojGe}&U^2gdGA_x{^+%O?cKY&_ES}leCk_~s>(80FG*jbprByM$x5oDprFblKceWU z$SXsq)g&k=uTkVAKWX~p>@VUNP5{=#jxQJaKfx)djz=56I<@&+^+i=1)>xOU1p#0Y6d`b}HU7=5Mmhw^kbb#M;jYe&6Xfkbg9~ zyoH!;A2q#84Zc106Ak!qF>3>?I=K!o23{^30j^K2kRAEKs)LK{&d8_MCnzW{D3?%B zK8L(^L0n{4qa}<=f zXP83*7$_(UA^+vhHy<<<6m0ST_rLj9L;ua6pDCbn_{9*MC~OU5syR<*V8l=>b&ny4 z8F`YOVz|4mcshc_p$XS!^=n|ESORy?+a<#Q2z@%jrW+z7=C`LJ@ghC-MaOZ zY&FxFj>f`YWa;p4IJ}3XV-@tUe^|UNN?h%F#c+K#p9DLC@L;|N0YxY%gn;^F1>u7cn;QCuvU8F_5e+N$$<3p^+#bxA?tTu{Yl3dRg`ZFQWz~=brEN4hA$2@K&v^ zJ$X32NkYX!povilXv@OT5jyM)8UnZZ$5&t0OszCE8x4i8Z~(8f-!(5j|A2DxTmqz* zTkReKF_<~6Cp6L;3xnXvnY)?QCcFx(`oJe>Fk`lCnhjbWt+nOSc4l#*)Ur+j?uoAM zlf~0qx2Rio3REamsG>)02XKQmZ+zTvuC3M5^;%pb3R7U^84i5C&J1?jrtB7?M!P1) zy4rSgD5rV`+SaVia?=%wNzA`0Mj{j#z3)NWCgqRX$SLAGn8v#vOLgfiXoQCtA{W;Uq4FzWhKq2~AKn$4_~zNdTLXew_Y znqd>bN|2n9ap8D|psd11SYO-&e?AE>se`X+_L_PojF3dG=rZwQLQ=)gzH}pK-8nG6dJ=LiGnQFX^0&1%JF&BO)Y5 zH%ZJ%CZ@YU)blvJggig>H1ly5jg0q5cdc-ouk}ETGk+MqOgAZ0PXkY!CAkpRu`Y^R zbn3PzRDBr9axx0mx*p%AadKXOP@&nWfwrX25jQ_=zsEj%jqyTcDdFY92M2UtIrCGG zbx?&R=wbK7dj3f26XhVj_y)-sU(cf6tAV}rQURC0&6db#%uJMVT%;HVMV0;XRMLvSo~~eO02%mv zM{xaU<)88ENC!1vYXugc2=r%JX@b9lT8rtV=Hf>i!2P!OpJ?!sK8}0a8YC;+~z`UjG&gEp<^z@q)evY2vg8I|(qMix+Q`-Y64d5`0}SzpuK_w=%2hhxUA`i<0O(kdMQT ziI`9?eEL!Pc-Iwd(TKhf4M`0Q6!})RU*bd6KvpXvj&YDv0&JYNANo^4FVR zm8M<26Yr$W6ig48DA!bky4a=^hA(%^;IX9RsAYDU5VE{~e)CMrYIpMW^-8w%EsK8r zZ$JEJQO{3Xa3-wH3_p#^5u>KTL#MG_lK$j2oltiC1hR&Q%yXiQw54cvbn6iJN1S3t zV}V@W-P1emY|dGYN3q$By%Izt;qrVkexot9iF*GTc*tJ+pe$K_u-+fH$-`+xDJYm7 z>h==pgn!t6&+|pw;A)V4*dG9HU>h*|$NFVxi z-w0K3=y0Un8lX1&UK;<^v*?n>vW63|_#M^Yz#B2FJK%DCo->L2kYbqHb zJBZKJlj0=JIhisq8`Pi!9?i1yuYB=Po&8pVgyOB6#nJFZfK;)q%rCM}RPlA`DIRt}c z6awCAbb#c)OJO8R{VOGz>yh-%s2ySF$D{SS2k|6gq_P%E%xt8)j|3{NhHqGgUbe^Z zDk7%?GF_ASX=6tk_y8?#C;d^(*gu)_fqX68Dz(JNDlHwKjoXgNf9EX|9yAg#al6F# zF~2AT8)rr!rKM0_U#O;ajZbr2gR+4H64e}Ev-08vX8-4F*>%jzf#?bKQ;4Es7@#)O zQ!7=_d(Y1o8FNCP_KZSpMIwDuyrYu<&+M{ks;qSL5Nk%~P4o5KScdL~ zsn8fUa?J%?cW(@)W1z%DZC300L4pHPd4Bwo*ugTL+*WuAtx;?~;=(}DL1r)<@+`Yw zsjPoUx-36KK?y-7y2S5>Q$wfO@T+;%Wcfc+h9j?F^{jnUbm+E>H&K6yqJxTjN*8z`nUhj`FUVhwsI*ovP7^*m85cOc?ehMsdU{ky99JZ7dw z&$^(x(MZ+|_Cu((z+e{kqU09}5G;w(WIerVJF#&@zHV zpQ1Ph$)T9?_zV_N`;4?`LG&?i&7!5DZVQRu!slv+4U-EDiJJ<_2GX2T;_9C(S#3hP z6*MmR@KL^tBj&p0Gc<9V)-A_@F@t#;@txPu(kq4>nIjI4qr8>U^<$&vICoM}pRL4@} zWVDywFo2qQcvD;q?3o5wBrvc)hao3{NRU}o!H7R^+^(#GQz-SK53amJCQMJO*xrL> zs4q6{niIUm`bx!^zNQkUF-5hEg3d($M4Dg%MMuk73CcHR>=dOae_!mDw)j*Y#M=C- zZltHN{&{NY^iPk5tDn)zXRb(qjcRcq7oHD5?XkGC}iqT2QPDz@2 z2PYXEih}aDVUm_7FsL@PbimnOhB`+Q{3F8k^QTWp>!gffxn|bmy3(b}lbL(*R0%XI zs$T^>(fVZ9LLD(1NuGoP|7*nBDw!Xd_L$KQ2RqhBTy{nZ3~xRhs&bamqx{0`BKvV% z*b4^`87*|_hdY0+sWjHIBE#6)=CY&KX3)LXu9eR$;LCE7_{q9yT~y-eVd#wY1m!uh zTRkYvPhbohy~cm`xps6JMX3wjwVI$?vN96aVSO+-J;BeXD8vl#Co#`p)GO#MgEY}R zARaNMU(qNZk+BNJLOh+3!GD))hgyMYzMYw#Q<1RG8#c0zNmHN}DF6afBA;$=47lcc z@>#8P6w72M<1-gexnIpfHp-9uf&;Agt(JEGW&x&(zfw|XYhsV73KN}BbkI|iQHn;) zD`e#v8*pB{FXXM_LPgPe4&whjHm>;=PBs4v0A}E%Cgn~=G2}!VfEbTB5lF#GgW}r# zw_{J@*)jBzQz}w!UZW7d-2Pjd|2LNY|7bD&ZNP_&S1>mY1?4PWl8TZ8nb7$7v<+<`=u1^fO4UpK9a zqZ(RI6P7ym!JKv;&;f5UJxk<`w5*_3t!X6LSj`VMWB@A~+@vv!F$c1o%VH`@k`xoX zs9shq7L6tZ6ydU=cr$wMKD3(2PGZeyTepJ-oCw%;+`% zBH{h>vgxjxD>LF1w!Di)T#lF7?)zLagjeH;?`fwQp_b5s$x$ud=dX6h_PCR6VY z3{rVSjUV9CZGDycdG>-lq!y|@WpL#Z0X!1Q&xb*4h?i@9Bl#9q zRhoj^n0{UJ#9N&<4fQ8Jw*F)&ZJ%!%-}dIl#}hpn8QZjm%;{cAaSENTgJ8Xp4e`MC z-ztpQYIxt>!4LRyu!>etxs{V5Q_J`btrJ$c7eYRWAKBcDC6C|{dWt-FJx+m0pjllR z!m6ymTxM@eo%F{jR9;4)dt6gPTUE1UEL+h@QKXbe<$V%kibLTWb1@sMTt105$U;z_ z>p|o^LSi??m&~#KDZ6>Npww;&q9MMX#lz!MY}`(7&$_~!eiFIU#O>$yoV&VCsRe3L zZEQ>}fyE4LlA^h?h}QNL*s02v^b5bsQ(X*4;gl*Ye&&vLB|p>EGr@+I{OU zq6n%Y9e(F3`0vHqZ{3{4%*{8HVGioi@*{zdLH&8fEya{VZWSd|eP()G!uUDkKY`Unnoh&UonFWA} zG%lWBYts(Zu(^vwst!Mc{G~-bZBl#E*P;Q5icFYk;e7{z`bH4C7fa}UUwz10%97O% zHfefSw`k>t4w@FBow{!u2HKp%i}0mt1gY6Ttp%NcMLwDEjz4!SAg9u#0SVcrK%FVu zSC(KA`SV@<=?%_XO8B%}!tt9`b^i9Wf)9RZw~DjVh0M#}3z=AKboBdN^RCN06!rX? z*Q@g=(vs;YU^6wugM3|9%@_9hOE&)^M2bPqt)7l4O%CHk-W0*()8qM!awdA}NxJ%P zS!qHzATB0F5c9?43b|J#chPl|#g4yC9iRucH53wPe*Pi%EM@7&i7So_CB|(9O#V}A z1FNLJSLe8^93%`7ODU;jTCjunXL1s$x%mUhG=xNR-fy7I>B=;k_Op9o*^}ApExBP8 zWV~vR+iXzQ2N^5zJ@s@*|IbTi%7_Nez67|ras3_@`={;Z7-RMg7J{Zl_J(0zMrQsp zKRc)ccsRz;stP!5Sy0dwRBbz9mmP6X4VKdwJXBjK86%EN@qOMhAR>84xA@AJta`D{ z)yn#lW;cgtlAED`;E5!zonEJ|ArE0?)P7ajL;>#n+G_{^PToz)U*%UUMlc7WMJ#AfIa=mwRvYYZQ0e6%Ac@Q1$nPGGo-`uC-%#i zC*(f{2g`@^r})mttKbj_WREIZFg8$xm^e*KKQKid-i}OQj&z;-l&i4#kJI|CM!HF% z2OC+uS}-Ah326OnThjV_46Ib#21(9q|Lqy*Qd3+Yi8W*@X6XHkyat_UZ3~{{)iKSS zHDRI;V(TK;oN?X;shL6vY_pva^a)b5Tl))jz-!u_Z3+&wkori&_GlE*pog-kR~Eivc2b>I(ixlVU08E^Nt z+&xvQyRLcs36o&!i02|myZ9hbG?hY2xP;8Qqf+3*B9+~O`CMhx#d=yD@~yv=Lhalg zSc{P^HNZnT=En)K$inCApDKjA!jWTugjfDGRUb`*qe`Z4UYA#Lrp7q4SJU(hoN$$V z88vvDJ>aJXdEOx_jjF+$(&ldG2=gMQQZ~?Cxq3y@e;qgaTZIs~|6zAt)4$I06}lX_ zPenZ};{M>>%g6=};eOv!+UL-*1N_*~3Vi-4*;HKS+J|j5mv)!C70LO!-w*0H=6`J? zFN$d_*|X_t9q1zFYwymmM;YR_&5p*ZAA7soUb3dBtx&?iDW=o^Ca?9rGkK;8W^!PI zvMI1%wy*x1>u7NZTR}?M&N(0g%Gs4~b#88T9>+6@-JigZOwD@VYPUc0JJz=TS~O5B zRmb^>3SdIQt^mSj*sCjVpn#)+XZ<6^XF>9kf2r<1n$~ubW^2YAq@6|g(O*~b+{I=^ZSOdt79$gOqr_H6H%y4t-6ss)>*&2PuCQ^#64s59)h!R>(XQ!Y{M z<{0zltJ$Od(dQ*$siP>msm9wHJf%wd?Nk*M;8id#8|oZ!F8pUMavAg;#6DDR?!-n^iB3eq#Jk^LdtJQh@lxGbT$84-tuu#_Y1B?{; ziwi@fi-1$NXewa`^^u{S@NHg)Goa>PW{7KfFNsQcxG8!AYbWf_M?_NW4G?bi!*=$7 zig#-Hs;>g+6De2U6`Fcena+S?_!Y&d{kM1_7?v7AJ9#3S)C;gKV@PmJw;Neb$iS5u z7_9S))9u5R0&PVYMIjS}`0QECEv6{jF4(59s)0NjMxF8&ivW(beRwLk@9|Bl$jjuJ zKyl}Zs=&?@mQ8Ff(*V&rw7E;Rke|N+ZP*@|<+SoE6+Y+~8n08Mt`nJxc0%jr@k*SA zRcLTuW7Y7_Oxkt|Ito#->xxQG#NO<)NbrnV%7nLIo$Pcj1o_}x7zjyAYDnc3y{3~} z$}F!1hWpti?2rGcXKUZnjpIDN0Ijaxo#M%SkxkA^U>>3y_BkTBC0>c3V5$#7n zlc_UIt7`B4JG~7&8KgC5UecuN4{pkP^`dN{qt1XkVYWzff*LqgD%Gpz%OyL4?)%}O z{c?7IRr>WeBffz-ctt0gBTp9B{D^}PdJZ7nsrhAHpp2&wjj1C?xlx!DmM!5K9e(-y zUlnRCdvp8h{MsOO9G%A@=H520OQH{>wy;vxG&UvYiU%5Hi`4@Ki|HoKLXs$LRxRrk zyBO=6USvNx zdA>FnT4~P?l#_US3rK~ZwDeLwDT)>ZgD1@Sn_t~%G5NLgysl=J@O+j@Abo>hB>H{f zn_@#Uf!|=K9()19C*4EjkhQ<172PCP$)+sFNakRI$RA*yygca{;?3NtP@~;{pkc9C zJGc#Xkq0cI36TzPuTv4R=h)P_x>;W2mt?*DHIK+JD%jc;Yu-!usQY?mzGo~>AydI* zkC#P!q+1!fNCNKei!rLsfV#|^FnEeimoQc2Q`GSQW=YSh)ny?1L;K~f$&sRRMsm+y z{dIc$oy`YVQ88CRHj$&_et@}Ut6SO*1-Wh{FT~ysCp5U58M8BMC^=)WO+2w3PaobpmD3fvii>PGBFZzdkBc3d z#wx^X*Fn44^Xr5Cns+p$+{2S%@(=XPrt{zEaHcP0+rn)7Y(M?|h|wt(1Cx1&!tp-c z>gAR&ZZVW8F!bJb4dKf=VyuL^Wh*s9swQFlN7$YpYfvC-deq?trs{_v4(Kk)B|)>F zy~G?{tn0T*uqFCprsvGp{|d*{B6akx_~#e4_;ViQ^gK!G+V4B+P0Vu;f5HR$EJ93ts$0D2+z~xl%zT%;t2F*C$RWfm!n{0`-S0j6i7)l)&z}C@ ziD{;@9mvP_xSeCHOnkS}^$rBv!VGT8R?#4IG}>fUajzMDCjG~z`@8rQNK2WpWCgG| zN1&-jwbUa>E~ZMDmZ6~!=eOAT5z^&i*R!-cp3}vl_Z~Rolx%fT;12uUi6)zVnyE@> zAx8HyIUY{=1RKd$X?W-WTY2}P_XkezW0tCzndJ%lYOu@9tv@e4sn~P>Hw&n0;L!gw zHR#ddae26$Ns7;ed)%s9`Hn$Dl|8TMEg3LjJy-AO6xB*iuf?m;*W%sg7l083wac;$ zX>Ln{-{=U7pAFHmoE+WB*Nxpfu-h4cA7C3-^<$vMSJ(%{Rh-7ttC{_RhB48Kzg`%w+hs-z zO-yh>*>q*v=N-{yGm(;tdyN`%uQ4(?0pBQdo-0n7mz_k_`5SICtE@AX-jG zOY(jYQ+aq4iwKWcdXt)LiLuPyg8imx<1DgT1FFV-uZziU?**#7hjjb(I;?5EJ4h#u z0m9ElY=Sc%&qfIHf+@#+Ob1Wfb3XJMPx`KQt+um^weJ1Is{FGsDblI*Y=^y7wO8Nu zWKu?G`L2ws_|KHg;XWs>$j4ifgBLsTV%ilos@~4qcF-P|HtLUkJ1%7XjbpQrO0g0_ zO(Q*><#A^NI{*A|=1c`Z)4VaW{oQO+@qO*4=~7g4xcm(BH`rd*-ct0i4*z$eI+I`T zg2fJf0Bd1q+jf@3G430d3Qm58q`^A+5&U1w+~m@eG*qPyN`oj}B*oqc1Gw(xyp4HC z#aLVZRGTBJ8ZsTTJ@-UZtU{lTnN80^W*;x+(9TOLmwq!0xp_ZaGAsuxSk1@WT0EYe zQl0RWTunVBi|#@B-S^l663)G3M<#HLhK=vnh+J%b&2IW54Eo)0ICYAk%SX|}H~A%X zbi3~&S9j(EB6|f8N_y80E+xTbb!WGXxK?6LEx;dZNoee0xUh*Me=E?OTcl8Aa~JJ5 z_7m@x^6aPvXC^K+N-kS>|$%qTw1Oyb$;qCoa-{o=f`W3NoBPcaD!Lo6%4>X zab0SM+g!F({#mvgxYw>mf)T*KA~ufKw(&xlx7+MU3I`o)ru zGUe`z@8`*u@o|a+od7SBo%n@Y5m%8zWPSz>Cqg0~LWwahCDIOLgFcNImNJ!Y=+v5r597Qe*|)n8!-)HdWD^K!2YrNPo`3Q=Scb$d%WZT4P6Vw({FE;`2u>oTV{%k7Y;4GxNeJ1LfUz z>QDTyN8K;6I~VVb8gj3NofAgr)(u`PVt##U$WFB$QxM12hCmHzrd9QrJ+yCDP}#3KE!yo8xYesu;&&%5WKl}f-=_w%>8 zy~V``_Pmd8@aq2AU2F+2Et7vaph+5XfH7@TA*YN*bm^ruXNcRtVzk~ksPiYq`kT+f zEL@{~RCY0fI%poqM*U&N!LeQUL2>3kQEtAorY z9kxT)UVAI;PM}&V(cXBJXe?ijvxcCN0{l?F8n*b%Ge9Xy z*VF$|IlAqu!#2$Xk8w#V5AP>o-K-MuCV9c(VWF#)-ImRXc7HsSfkhEGdplbwM!C5uM1Qw+^OTL zZ8E23o{wPQTt=&jHJ_YPf4m(|yf{ivXVq)4q}ut_2Cu$zSf{=Dm zsM=2M^=jEP>9F1I=1sP>0P~*Wx#wV(%MUE)J%Rum4zSnmq(DdDlL_nB`BCIE%Jl2< zHbrSm?Tc@kYO^}eu5Yut2Ojd?pqd{wg*JolkLwniwM$B+Y&>$AL_I9>B7L3-r?doQ z^kl?n?kJ^ls7zVms=P@|OQpGNKW)Az)anRZ5xHKC6VLx=hmE(4Pz150=+)S-?ok-p zh0mK?Uh4AniMacikE70J(0LUwBda%(+ZisE+59IB=6^sVCv9F`b`{&u9(0RiB1Ghm zL9uXsjAteW;TKWAZLq5R6>Gb8HJ=MWKOo99b4xB&bi2(dciL#ZQ0_46Im#d>0E*p| zms8ZSo#fK#HH-2BrWR{@HC&Rzo|nA#__G1_Zgn(T^LP5S$UIZL;GG>Yc#x#zw<%0a zvpZ+it_Cd?GQ!+k+H9*VnpFxc8Xa~}7_OAknIzh%WOrxD{lLBUrS1grv{T!U_+&gA zZFIg|s+=?HwxumzHnEYh-E;K8-k)gbj@ZVju_V7sEqUCq>dQYwDo1_326DNt82kF7 zRU_-N#HqqvR3kB&U8d{?=C`M} z7~UV8!M$G6i(Q}OR$MfAKTWYW;0{b(y#JMK(tr!Ix34H#USM&Xq3fkkna(S9rh7K( zX7a~g)TR*l0YF#Y4b!UecepD(Hxlc+n66)SnxKHYxj3;7^&KWvXWT7Zi8BAXD?&sY zrTg6Wugx$U8rDVhPy_P{FSasd@~#jr z6-M4d*$Cqsk^!a<|_f38!nqmgi66rDy;cwR1U+W*4jF-TxK-IA%B*RN}50`5{lWvhX)rskVO+blXgyRl1sTlJWXS^Ou5XyTii6 z2PJg5r3J%@cuW&je zEc^Imt~{!(PNy<+0B_rIy;nG|dL+&1Y~Z0i&~mF20XENBooG-P!5`VaJB(&U`uC7@52436Z3?R>JMBo7qJJl;mcdCq>c` z&*;U%rCBv-nX$J0uqHgy1mMQh+Xe7KwN9R>zOHF60gV%Fy7{Mr-mM9VT3#kj)63%j|z^nS`}@O&H^D)+Ye=45>fF4I$7=}iE)GKA<6Zmi&<#EaiN3r0WohO zi`#{KLkW`~xg&_7FUE_W8Bt3nG;z^Nt)H~~o`cR;LCa$}oQ`~;) z(V|fGQDN}a9}ixV-T>$MEFR#)>PjNoH~*nn!5e$8lHyW#f{EMZ*b-`{&B%h9?M}$` zw*T2L7cOp2I(0$tAfzqonP)J*`JqT|S+fB=s{|MDDsUwM^>^B3{PG zj?6YW;4Gr27rmE|rb!mSPakN`3Tk*6r_`~RLGIF?xxu$0H7zrmnW4S1`Ft~q<(Qv) zkyqj78CT|v8)Rvno{jQxO6-0CbJUhSA>ZGtJ^S?TTx5uQb8zU${6K8hXwR;s^lE6Y zG|A0&?XD%m$i7vDm&a|yN%6%TcE=|rK|y!A=W_m}aePWEd{;c-7u?i8i3WD)>!-=B zV8AUFo#y$tOPW1`wd3<&q)-?w;UG#}To!7t4$d)^`=ELXrFpQJ7{#TC>ETjMsl~Ww zrThnl)8iaeY3GVqneFjw)){fE`WB;buwJWOU5>5%oJ_)`cXIM+r2pH2py@xGt?oOn zCzQ<^p#8Y{%wvaXF6L*?pEio+!c>BLoJHGMqjJDnK=pFU$3d(*7I(k z-7+*?+GrxssVau|;kRna%%gfnys&`4q+6v@9VP5{ax}BJ9LM>iUGAp(Wv?J$dF-C) z`YXxw?6Qv{jQ_53sb+Y;<=-s8h_-6yH{+)Ed*YF6k1(SxA|ZrWwHJ+>4&_dVLV%cv zPH$*DHUJn{P;>J-P|j};wg0=KyXa=FXk&KJ;{sGs2zNL2N*)-jFmv ze_z_GSuQ2&A@2jYRh@t0nOJlc6(eZDsC^-!41H_rV>A;bSDWsHV^zDClAFA|o(g!Q zhQ~>RVXwQI{|#AWX_o7t#CUmG*1`TuqnU4F4V9l^UhCnD=1w0ju<8%Z#8U1zmW>=< z4lTEtNUF%liQC}J8-KtHf&{IWuh3s;q6ia3|y&q(uX`rDHT(!FZdqEQW8J3X+Vr zsO1$kE(9BgOqks2qmVKk76VxqIxaXQ{HNS_v8MKq#I(8n51Wib4)m7gG4RRg8x|$y zRDmPXYK@n%T@p&@OO$!kN`6#$29C)1;%{R3$rnvzbQ<{J=puaDavmRf)_ny! zJs2&eaB!@LE!aWS;8klBLyl$KfT6M6u-?3yrKms4dTc4)Hc4hALx9uS z_aQzz-ht)IP1?x*(Sw@!LLN~GwJ9e;yf!MEcXF~i0Fz}Q8jxqWN`PUa^Xt0xpw(=3 z=3EVB($lqZ$-J9TPf^Soa@%V)Z)Z>0Yr#xK{R{PW;3HXZ!ey`@CwC}-|y24E) zc0UTr6P#;*oNH%RiD6OMfB1prAoj@O@q~nZj_gvb!R*mvkpf-yaH;u_uR|cM#IO0v zO(~%-aI3FhfkM~hyoXRLn+-ACsJL}nj!HyJ2tzjqGQw%gJuDe9vM}Gp-r`kXG&$Qu zQ3;ByZ<;~TNOJ4>k(C4zm2=tIZVgJR@1ev(=IF#1lD+_(&> zNn@~%vUvte!l(t@F`tEn6C4jwZ9krroCet`Sot;gdKH~r4+FhGG-C9*{S8KahTT9; zv6EGu%L-$L{pwvBH}~wq3n{VS{efo^wi-`l*c6QpZW z_js~*W7q`$lv)^2q1g;~ld;7qH~dhAfS$2hg|~4}Tn5;%Mg;kJWSMVDu6>zPlBsuM z?Gsh?t`BMEH=8?;#+!lZ!A+%umxjLZzZn!eq_K3n{z;VnTE&u~aqnUn;7rj>xv`R% zvE-fZF;9^J^vp?EZuJQmrGD})BJgC(LiSfaE4W+_eqrgS|7`stOM9szhmR$Fd^&UQ=*Q2FZnK$z+3( z$ANOcn-_3NSkQ3{vDmb;Dj1#_>?~Gl<{tPTcu8nkpB)rtlQZALwo-%CX_s6FMdFF( zs$<9XgSQuZ38M-h&EDtre7^_+ymlZB`EC;50jRO>(o2W;ZwIEeD{r<+`r64Ick7#*4n;P4VlfD0Jf|It zYX5~LHzv&+wtxzN?%+Usv*|R)*rhb5>C&9vl@E!pLd@d$OT$hZ8`tPiJJ*NWz2M2; z9p_>Zhdw2m^JBdO2Y|YHlc1Hb_hWZ5OZUZ1Gg^=TaIK`XTIJat4!EB?TE1_ap>IgF zhTp$i4U1@q-8wgVJlFEPopG=uAnY&;8@Ej5tF007!~=VT~Y#R(jgt1lL;vLNwO*nSMW?*zJG zGY~6}3iQ>eUqx-Q52FeQwDWsV+tRQeyzA#6KJ~$;Jro=$TQZS18t|zi=SoT0!FYvv zFb(Jj-bD-EE+9?gq6OwZYd+0n*O(?EFBEr}J5m?By>#B@Yt;F1Up&o0Lac7{N#Pc=nbxs5Zt?_(}w@XqjK0$C8gT(g;X^bM-?UM5!8Rd?TK>!;{P8rMOjO3fL~X`?~)+pkW9!w_xY zQMeHtdOG9 z!2GhhDgsd3-$V<4C9|wc`rDg%>&*@vY{k^+Eu=jP97oKFX*xcJH8;^7JoBBY56_oL z+UY5k=r*}1!t->zI(Zcck~?g(QA_9NzKcy^jWK@{9x`b_m+KYB)D4 zpYVs6l=)Cyzdq5sz6c}3uvx4UoG>Dr|2h?~Sn5pLF1RmS5jK8TS(bgBS;@Y0^YmmL zY&JRkvoMf6!)3f1C){LS#0J&Uc}`CSk^#y7T!R{DI(#57jgCET(nHL-PdUB7rvs)JBnes*ZozcWNn4>?@L*m1N|=R=$D9m`2iYQem^|0 zV}52+o*xlvZ>ey{s-mve)j!*Gk+0ri?ls_pYN7Ybl5YAqaFOPEBL(A=Zl!cqc^dLq z=Onh#$tmtP#*QQ{u_H+FWDa5JtMu^S+SrNVy>uJe+u5^NPmnVFk>Sv--P`koD%BmI z_prj*gGwtqb(c7eIb&f-m?G13Tn!r+5nH2^TjsWePJc2*kS$G~ne?A~Puf2}+r1B@ z%&%&%-UB=at7!wgM}-pMIrf$qS01ZqdF0NMCJL7>T&gw$Gs1qKeb`3_?iR21?-raF zAJJ?)F>0o@8=mlur8BPb^O0i6@YrWq7}8l2tpz;ujNPzPT9--(2q}fOOnM3^wF!4U zoOP(QmpDtVswvPXCh`WHSaXt1*`3T@Xhf#daPk{3Obop1S!>jq)xsJI1%$7A&Q*-4 zvKc2P7=i6L>Sl!$J^vnRk=kKSheoh-&*_{eheo|M;NE#Pf{jlYt1q!2YKc_(?u!j} ze7$de)MrJi0ks_&#&~`kw-!PFksxlnjmuc?0z4HodfRIcNq>*rZN0cDdH7b^MV5(- z8I{H=@0^00xZBP?Vj_s@cn_9StC6VYsnZf-*%}F?*zx_wr%cK?eE9BPPNFH*bQ3QnC!{j$>$|t2kmT zsSq)Fz^djk>;LiNzDR>Ae;q|zn!(IKPMA>kp5{p=8A8z$&EU}8pOCL?Fr&0mZ$(CW zE&*qc&$2Qj{h+x|;dL_`HLL#Ipln3c!oKsnn*Y!}GP1@Is(asA{X{i)5gwZ)m2Eue zoYd5+0v3a(5?!0lb*4VJtGr?IK+Kkp<1e&*r}VGUZ_*pNc9zn&jF@}F<=k@mTc>!Nk`8m$l1V^6I^TBVZaIUe>^ zL7cz7G&i4{>zRO%5&FRaRXpdT7?%_}7r$+O2K1r$s+D)&9)_jPY&yk9K@N zEdC-!N-B+wjh&uD>%r;D-C8hQ$(phWJl$Eszk*7qy@X8C-3m!A%hKOb>gECy)Kl{1 zRWqOLr+8sxFz}duuh<@)sUe&+_ zKBgN!O0J^ikaR4Zzvlr?90cv)Tt>Lai%iY|7BPX)$G`zOE-PQ>i=!U9#@y@oUQ_;) zFQ^00bH%C$FT9J}q%NiHS)&_I9vY@>9AEV8pt-QO^R9Jz;Rtgq?C?xm%Q%;pD0fg@ z_f+^Ay*z?uEgGzgL5~E{!SK2RNPk5am)-96i4*15&6J^Yx5tXo_6ti@x$z1nGg{;Ak`A7xgjqXefLYDoyD2Y}h$Yziv2}EBWG*WOrt!pI;=G($#F8aS-=P z-T(32Fkvd%URAYeSHv-Re~R_;7z-~_yCiriz+%&2Ph`LNaiSpIlF`4NdS)S8-SaRX z;;iGlNOY^RAyyS3({|filcbsctw_6#yEN{YFnvqfy+r@CSthPA1~37(#4*OFCN zhjn4|8-FN&Y<%XsbVyOMT!f+g0!HFsj(4jR*I{kj8Sv;`TD@y zv~3B|czJoou%*|q^ilZhb+i`Qg~p5VMY|(-yYP>(829s>J{1Ho|KR}&6nmVcysfj9 z*m3vUFcGP~?xuZvc(5mO-;kI|L4MckF1YGR!k#*d=?yjMVeh{pqQqQ!*rQ%|t8|%h zF$gN!KS6_9KHTi$hYl{p5H;#QOh=}%F9m!Q91b$Q8qsRgyO$VF#?R!AwtaA1OBBrZ zoKFD{T{+~@_;!*t{Y0G^F9ZARrO7v6_MN_Cw=5pQJobo7P*4Hg{;7X+AY?tC9OTHS zAH1@dhVV3R)m8R`S>e0>ZIz4Ajg%D7YYxQ*3O$i>&DER8=hlG+5hy>!{l) z2lsEcQYWD!ckKW_zTBT%R(u#Ijj3>^EmQ@Go2y9D-RR!Si%VEN^>aIC4PH_*1*`$< z4@CH>6U`U5E}}Q&6NACl=8DC&4l1%H-Kfp&7y>7N|D(CLjB4v^*S+ghp_D(x3KTC+ zai=X-ytoru+}#POQ3@0&?oc#1MFR;WE$+b~gb<`y(BK3DCw=yQ-Z9R5-o3w_bKY+m z8Ce-?&9T;8^S5}|i zR`-tR5@wu>&k7r+Rp{%3?>W^rtdF?4EXG<}=}KAZqewpb_3w3ZyavCC+N|v_Le?H0 zUOqs;Iz?9E#Ihunv9sPwTH8$2gXwDW3d-<{74urn11Bpw{k+P-NPMpstcFM#eWWiT z!JhPF>6hbG+zD*C3i};->E@Dt#&^uY2n@+PM@l5aEHANwgVYEmjLLau(^kM|jW9ih z=G`i{n9l>CmFT?zbQMzvCtS+&Jps^S3y;vMaCLtcgTz*zrRUi4x*WFexnN@9?v-+V zI&oW93c>Os<&Ct zw=uKr1xO# ze-S;jY|~OJdL48_H(C&xpKGg=hKIrP5_l;>JI1H&{ZT*Bx;gSos-r{R)YXF1UVb^h$@m9J_8 zz?V6?FN)CT9bBCqK3RsHBXaEE&njRKcr$?b)ocjh3u&rZ9CpHe;evM_9aU4`F5SE1 zB$~yh0n0fxFDDrWl&c2iaEQU$~0k1XHvSmr8S+ir@XYDeE%YjdEhW-M|CG148H3%h4?_f4x&b22^i zMaLI{4m<<_A>W}%!IE}GWD}+kqolD!wtIgfi9O;9E@OI`RZw%msAw^ny7a5_B2zt# z#;tYKzWaU}s0$lQ&Jf`Zjl1-)3fVtjWarl2V#M#IcG^wVezDu9ro$7rI~M9hrNpM6 zw_E;otfJbs8J2myM=e4Or6b7d8%+D%hyFSu>+Ap;(SB5N5AIyaEUSlE&ABvLSHs@H zb+pS~gZNULCq9q1cr#qGUPb$>M|#AN+9yb z7V1{F%`6Sohpqv6n=hXy7Hp9qA$!})<2>COkFFk3;y<{g2E>t@{6o~(CG6A zc4z4x7jXZS&E}=?4>jK1Fb&zYUyd`zFF-LJ71J_=y5lpR$Ir7>XU4sPIK&((-CVO* z>biyJ0(llB8<;6|Pi7n)>Sk{=TWA{^G%_NiiSudrM|EKiaFD%P;jfWeJ` zz|jwRmn%a0)JD0ddu-`)6;y%9;@Zx}xrcKJ6H>KFHwMFFyMT90E#ZpJe|75u4N9Ti zh4bC6wJ5?ZEvrHoP~Wec$Uj(?r|phSuoM!sr}k$@)+nx(PJ?W&YZ)SH92c?mI^-svIGu`Nftbt zk857Wu2unp`Zc>L*BFG3@kxlRnL~Bn-e`{Kjyb$je|T)5nk`H6n^dRO-)fiDLyk_@}8z zVB_eBVT+6X2=)zheeiz3L}r^z4)$!EO?R9?5;txRnI#YmtV}yL-!d5xqWeRA_T?c#I9ZR(0FB^pj2eg8b z$qIE1=e;+n?to1+sjI6%Yg8kus#a#B%Xu?2pu;~7Kskl^hPXMvs*bG5M*K%Hiehn2 z#!^d(I)#ng(~Z^yt~g3>BJZX2Lz>r;Rm6Jf({zUmFQU0Z3+-$*SLnX;Fu@xqX^x+X z4{&G8%EO9#nEL^E2TdR>Z2o4)%cP0MPmEA)*iEsY+LF%7$>wrDWlnlV^8vknyozBG zO;$!Og8;kGv#p36sNaZraH?G;p$w8Vh44FDxvUKGZiI1VUp!r0S+jJQj^=ZS-Qkz? zCG_5W)kc}}1qcdq7z`mB8Vyjg{eBI+9~t4Su)oz^T@iEyCQ51<65>6!tuf4cb|B4vu=TmUa?e(Q_HZuIj1&bIPdT0 zmQpAZ%__AEoBViD%X(g$d9HwK%tL1yO6;_&tG17_+Tx1NUyj?9_K|e@Z3DSH*#0Ph zJaN)F*j%$TNY^^|M5&smnB|UNjHw;E+*F_>|G6dxgAnb|=OiV7P zXEVD^HcIsur3!&_VL>X#NYJ0o8rdeD{AFH9rhnMM;=I8C}8JlNrD3x?cnd0-zt-Nua%A3^)>^79Jo`1GO z{F!_rZ!#I`-3^T8(rO7lsvX#j_}sBiY}%QSNOOf9Z6Dse3?jM<-_CHmV?g;O02G$= zJ}}2)e^R#JHgoMmJ_vZKeyLIAARj1yM#c(-Bkbtn4s5o3%t;5^8wRL8`L`DEat57y z>F0HsTRJ!(uf%!dmZf4>oJPdhnrmjh2_y4Rtbk7eo~P#31vm@bXn?T#j(A_XbURIK zlsd7#hSGz4PX1MpSy=7ohS&NoPlagP$Z|tGRgODFm@Mj&;F$7@FRe{LB%!;!q^mh1 z`rZyA!!sHAAbz7RjBis!&qweq~0a5K)kx1SbR^BHLq?v#A2iv1;&9wJFjP=YDd=J%HCQU ztf;E+np@&+D-wt!C2%>DNcM8SdND^H5o5#0&&0O|O!}beLM}c_OHsazLmY1W(7l5m zo{Od-iNm?LwahoCgB5lmYhLdciy&;6;KEY|OW%EHNWtIpT7sRQl{l;IoJCui4`FyV zUW)91*44_)gx8QBvd?*vJqq%l2bj}MShGVNDq-cp~?f*vFCD_ChJdF?_70fAlIW<8uB=T?f_!)GVmJDz?jhD&euE zX}Su^PFp~+vJ3BH9yHtHeT;My)-$FF+f0sR4K3|Y>9`yIqohZvD?ax~p4wYb?o;mp zHAi1Lyh7FJh zymt~}X9oOioJ@`{7@x1NOhz64*!R$M!?PNL~WJ(rhw z?oi|UvD;YyP!Oe3tdNL*1K~YH>A+8(0%03$VsyDPhL?Or?k(E@45FD#4ij+NpReFt zlrbBHJ+lF1lXWrgU!*drl@|=nYy@zqlOiRhgLBFd>mDPeUarFpxcPF2iGU zmNhj7!Ta%Ds~*AvbB^VPuDTqB;oI1jf5vzKk%`Iy{DFmK$x)5(230AJl3W*WzT5kd z)8m0aVG4XI<8sCsdWBi&0{Ezt$x0Y@e!@ViU7vuNxeirO!6X#`0OudGlZ(*ZmGxsV z4Xtv#q95Yfw%%7y)MQY@JU(6IcQ-~IZo0urGSfF)u+g|Fg9)Y=h#fgbD^F<%$4_(A&4#@^>s4IK*7Qf;VUY;oVfgc<1I z@!f33SDHM@a7g9Jo$EmrF$Rv)6dA`Ur9G0?p&NNhE~*K0bupZP;vW|Za7f?ac<k;k;5AKO2gv9|wByek{$quiHst!F2HusORlDfEfvryxD zIqw+yRRV5%@rhGc>e-jX*qf92M>nHNxY18iU6>yVSoY1RmO5qHIVLnZ*53sQ?u$^O)?`Ne@+`iE&?X{=qx@Mh36YTjkbMBX8g= z-uPGOz~;_=)+J#L(V@BTwPKrY_2c&4`~_2%O?*|3Sq7R+W%>K(_BB5Nwp@weE79PUKSg_*-StnYlve8i%jcBx(a?R?!mab2e?)7TJKq8P6vhlw@*x- z4<_Shm}gxwK^+*xnp_3fz*lZGg7bUuyLdg}UT9l&m3fxQgnFnV#F$2aAr*X_vIBny zXK;r*&VF0DWi4gu|JB`(itjr`p*LI~8<-Jh^lMGC$W=moDTb%C^6k`{MC3seb>0hh71;T>>JxjgT8LsgbeZ`WehhbHy{ zHinE5#QE9vMkjC!7zwoA2m4*>c7N+nU?^Jepd@h4a~3juQ+$kpdqa5~?8iS|J$&di zE)*`|^lL3P=<;7&x%(8^L#GY$2@D_&>v;iZQfax+=CSg~({B%Z{c>&-zdCaoEDXme zZTrGPH$g1qBo`5hcJzO_>^%5eDj)Ct{9gfbKjhUtJUOQAu=kL1s@C%tCmV*gp(iU8 ziFcX^2=q4laH_t3Sue@q<%P)o@&Bt-re=rvU+P>kF_v}JQROxrTi3P+iG0^ehYR%S zy>3iO_rBoM@2b%KauPyCOFe}!mvXZQ@HRMI65rHDdXE12iA7p6Y|{MM=-m8t8IU(& zVHkAKD`+Xmc$#Mz50 zcu!IqAls^3K1^xZ2RnDW6lN%$xk0|Ng*Ha}LW{EDJ7Qj6e64J8au9-!b@il0%X0dr zJo1^(6r*JjFP%D@N$`fF2x%=@R|@(-c^b|w%zVve41~N)^`yLnLLRMzBTtwo^DomE zL;OzqI`6IESiKRKIy*WDAFIGz<6BJm#BOM45`R*RFy?{U@7$)Zx)_ z%%IJst+-_n)9++tTa16ZLv_o6$)x*Awnnh|KDb)Xm=C!BwZGO#(a)Oy7p|nH2pG$&Yb*OZnDsHCQ(ndZC zV6-#X5gd$6__qV;8_SqIM%9kt6m*yiLPUGM+2xO~D{(zTKr`4hF8XX4mLtBKOrY{+39Wi>Cd`Yy5^|{vJoG zal$ASd%jXO(9yc7=z+QZe$Wj0P#Sn~a#xuu4oR?0v=>ZA(79a8XqN+TVx zo6N7HnXP!~IGXE<>)u!oa2QKY`53Xs_OWM}VKUHX_lWWf`!Xk4-Q#pk{u^Df)Eh*5 zU5Qn5g^TEj+~1gJa=1T_-&nA_i*D-JUMFL+L)Z^@U^RK>RD0rSLKfC?OKYYa?tFMa z;jkz++AaQvUYC^S=rdY^pQUklL&~s& z@%RskF#a6A>3gkC1!V1*^a)o zcYN}t;O^obCE;*yt)y3*tHF0>D!C99f4TbRd2T;)Nj3F-tHhMY{C-rGBLH2j}%%;K58kQ0<+2OA|=P&B&pn zC`rP%iEq~@{#tk*8Sq!EiW%5dn^~k!7XhM8GZ~nT3vF6on@3m4 z%GE|GFzva`RKV8r8KjC%DO97~lYD3{ zja8&p4fs|tb0G3XnxI1eN4&M=TJae1HoRO$#A>N>VSd$@`gjlK!Id?EDv?vg416b0 z6n3jBsvX_IeW|t>HaE{W&2(dk1+Y?iXhb*pNxI;_G;9r$h-6GQ3yVDuk{=w9xMYrt zv8~}FZDDS|ED~$I6{lQn{skp7blqIgHI$Y?Pa~%6#mbXNJW5C(2RbX$gN_Vb56fvv zarfI00$p&@$Y{>|lPf$X0oR}E^5y@2E}+u#YicX87;*7y;3?E>50rb6pQ@caJLX>; z1II51H3I|9-XDr=svc{&kBWqwQ(_W{1F1VzP^~o?ycr>PXHyw8gP+j(d@tjGp1}E9 zv=XZ$RUS16W*9s9TW0F{!+a$xPh4Jcax(>*$Vc7>$FG|$&Mz-d*bh5r5)5zJ>w;^R zxP|!2>t`k@M8w8TD@YcZe~!o1BA7G!WWm8YDIYB#mg~7>Ro9|)D+<59+dDQ008wre z4(0R+PyDSyph=$7peRIjeuVp_&YRb}sgaOp%Dyo@)yf|Pxdi$t@LtB}xh*{S#vZyx z=ibZjUdy3Nr(qR_0mUD_X*?k8q@ne5t224^T=_01!z>-8%89C@7!iAgVjNQRs*Rbx z4I?m8M1v29CD;=~`YMk76sRt;nzCE{K9L++*z$b$RoN^)I=Hi1Ic2Owng5%Ad5@L* zNa@f?H=|?&shx0l9?e8^7nc95^+^tvV0yb>(LK{ohGe_ZIyo6n`ht6`UA-@PPD!LN zscLkz=U9C=(SB@wvWj0$wW;#0p)L`zCOmy2qIOvU*C12EbkYp%(@KBrqQq4o5#(SS! zn2-mqubJUn!hcB6`a_pWM$&GNSm^!E9& zEjOh5`a$QVG*r51iA>JY2JT!6dgzm-O^KBIt}ulm$j6`dy_UX=#by!Z7JdMlXF zAr$J%brF^4)!nH{RBmegu+{5fvO zeG?A36Tl17=qmrE9H7NDBa#d9PxECa9Brje91LoWh8;;g2{C&Ra}XY8{o;M*7>>iO z&j=b(_!|Bk6!ZpUK0H9SPd-A_P;B4XSpB-1C!|*-p;1>XDWCT>*}diK?i_+)TtT)A zHC023H3}Gyxq87WhtqanPI;-P@{krx6Gl0Y0Ioo4oU-?lxDn+x)I~VaeM=!!KGubk zt6IHv5IKf7f#ZzXyqB6e9Uj0$CZrr412-F8{@s(-`$zU{0 zr}3}6(a*W`V!&@;WXgUd_LF?#x2fFLA8%Dn(->ijc(`h?Y%VD4o#dPe3+ZoPYFHTL5t8?q;ME8S zh2hA)qkm^at~zh-tX_zx!3&B)5eOOSCuOL z4T>ms^7gK7QCW&7C1}#O_)pkeTW>YO%Vn>F!9nfbYJk(!_KERC{Le-Ch_|sa#z>uW z*F%bZ$OLofvD65xf-H;!$i;=<_QJY(Ut|JSfX6UDGQ=z`=j__vYirjc+;b$O$Xll} zFt2dcokxB$HD=ldBGhK7ef!MZJL{(yxG(H<&3(lb(lNBp!RE~VKbr>5n0OtR{%6-f zQLShY0x~X=`@O#PEP$Pt{mA$Smx1;Gs)3jPTOGh<-sb@(;C(%@V^DC#fA!~ug(dIC zJ+!n8?x1TGP<5MkWlkdX!5zU7#h?dL8>}CzYQ%n@G?V0Y=)oFZ3pUAmK~Si_P~Bxz;n^n=a-s;gU->-ZXbT64RfOG8SO&jZ&NW zPqx&WuXHz(CMP8J*DoS|s=Vi9caT}7LNUGj2UM zr{>7x~PPTsWnZ0Q})MiI?H zxG+q-cKvau!b5JvB!*#KwDdUnF_VImB&hTgTp^PAsU_9LPhrp6vr2$-#k8?rV0~2{ z(ZPAF<-Pe*h-r}KnroFz8pH$OHnyJPPk>K#(2WMgmmbf~OffgsHLu%FNKBMbRYpx9 zd8)UL0^39OAQNuexiU7GFW;t}Z23ea82P3fVEK4ohQn0$#A^C=zFTtjKBR`r@!0fQ2P$Jiz^@4MVM0)akK(KyNPx)2Cr=aQ* zrSkRJix(4o^8rP=Gw=bun_V{n~BcmL9dQSH}Rd7sNR# zR7#~mULkC|^>s(9$PB@!u9h)y==tz-^n!Z&GeAIPrj~@*lYjchD3fvSOsrrj^1R=Qh{aaBcy~R@HYi znR98$HslZ@U6{#=j;vNeF}%B5>FQO1V?n2}xoN##`TG@QQxXtYGiJm%xWA4pScp85 z@+*Y1m4r&yNw{%;_xpN_qwDx&)(KP{B<$Il$!+Z4Y+ItR-a=Z8voaOdELsD*JJKnS zm6Wkh*t0}GG+Ph?+Z!>^T%FW^Ku=Ph^b%a9UC0d~7M&E9|1{YDc3o&lY+X-0TNtQB z8@karEAZ(eV^Zttp*=u|V3E#0SZXB*RWr=hgKQ0k1h%Ndi6r89mFQ>4dAa1vD zc54GUb>pycW!kn9mhlXWA8iL3{+O^csf*!KvuHM>`?H~y>vja*2}Lw+ZNz{K)uwnY z+JHaEmWF9B0$rrhlHVsBC^i$orK0D97)~^!*L1R#fS3z|fYkQwYu9Ag7sp*$eI&L4 zOdZn2q=1<6ioCU%#krUiiG@YW?Vr<3uO%P1sSfBUdz>~e;-=eG0B$%~J#8q<>0x{u zXhaQ(8EPas)c#Q!XmrP-9sCdao@wzUlL1nncqGTQj#=!R<_EG0=2!+u|2A%veSSC# zjp6#L2C8)mdcQ##*hlNBF+Pj_^RCo(=7yi{lLj-=0tv>`q{82-zt3@zKl)<<`t={9xsPBYt}#}et$gwl^aw~={fEK>`ThG# z7xyv|sqOo}m-PyUnx$AD(8k`2db{Kka_$`veZ3_6&_!{o^JNX?OZUkm8jW7}#Qyx1 z#q5EbrSo}%N3M10zUA-8OY^mT{9CLm;La+ODFK8^~+?rf^$*#>#3r_Pa0Yl^^3D==5xnY18UpHO z`+!>e$?XGzMgu|R(Vz1hw?c);V*m;9D|*IK`rdY2x3jHwT6~sMH6B3eSF?GEn5N(P zg8V;_U(eIXsN1S2w0CQ)n24H9E8WtJ7y?FdKhlr+@xWdQ)I}XL=dspzCw%j0o68+> zMU9jto3q_yUrGtXhWLh~#rl1W$e*E0?02Rf#R7f^T-`S&(66uXQt+YB8&w?_z{4;{ z$^87dSah4m_T1VwFE#RqyXLCqV_}?1sP+4r(xD)Sci-znU_b|-!MwO=a;L-9O}U1u zJGV`JvCx~F?%!sT92!fYviOsfpzd_$l@7!1+3l7q>#h^bSYzLVw5~auh~aGilXEqA zzUfP0JU@#8>{^{&>cus8kOYOT)A*QObr?LGQ*O-5;EAhDC8X?#IZq++{j%n%rT|*L-?JA!&EkZH${sMo2g83)xJ4 zGO|yQG?eqpbd8yP&#RBJ^LhrGqgNCp%hr*Aft2S8MNw0 z?ITRANhUlyBitth2$9dd?luR*@%8&w5cN5C%>HeR{zhnP*}G`mm}#Vr9JAY2;^eNM z7P9(fc#0gFl$YSZcjCUdcSgq^J*GO;(FYVc9fE+3-%TC21c%3VR?>0eJA@1;HVts;c?q0zJrUj_!rXZD6?V*&Z;8wJig%K(>~I5 z9&j*@RsT^J+%O*!I}Vt*VEkrmU8tiOLvOTDslic=f8lJaj6D3QFy-I@)FH59iojFu zsPp-!8>J`t#plUQieR;!ESdZU#QQVspa|(5X=P*fewhv!pb0hEf5|g;(;|!BtNgIl z90#{|PVmreQkXYi=LO<|+d!h--uHi*8oJ5@fkS|w;&4cRCkf&LjO6gfo;V8&N&PtW zB(_kjGY7WNEoP>237E3yD0S7}NlcGUu`ht_rK|X)NfqC?kjujGrJ8AJbw>pxr(_CH z=CJ#1&3u1;5k^+raP$l_$`UU~Y2N*bNv_o9R@`23RLGOn03+&b<%WsDZ$XQu8_AG{ zQ|IX@w)P(HNhQEcW4W-oljMO#~qMoVkRg+sz!X#?Ud~4xf zUM*4FO3~Ul!>yp5czA>P$2>m_lR1YrwW??rfHlHwC;5esQ|kuJR+I!=x~>N!(+_t# z-Szd2C(ot4WY~fcX7#Zb>udgFzOI~eO#HUN ze}L4MTk<<7pj_pWIJH+`vfXx%nA@^8+QXRB|9SGqD|_xt&sgJf#6g{FGg=E%X)|#= z-E}%>379E*ITR`xxg8;_Tr-0YfQSKl?Sq^VkHEQt>GW~79x{4LjDpW0b#XToE}vc< z$(*4`U1KeJbVRO`ys6QbE+Xrp=b;sMU5d84qo*sglCkFt#vN;6QRP3WrpI3&C-8Vw zL2Ebnco$j#khzuOd=RT0ERcNyd)z3%I7dS5r&^8`C9P~Sp$f;EE-|v?3z7<$x6rE?Nxnc^ju==PjTB#ZC{%mrXX3tqcXotHg{^X z2xi8a6upsWnY_=RO!-wN2BddH4DZjJ-011Nn$<6k%g#u%at5o*%Pxx<=0Nx4!x7aI zUgUROrQl)#ztKZO+Xjtpz17Z{`GIM2l^+^N&!xRg{?|6FEd9bsgUp~phC!~q0~2D{ zn^j@q#Tz_hh0puekV0ImaSKzdPRi{pW`i-;@U^7AVV_?V2i7gDYz!U(G`ICRh5{xF z1-y<_a{sCMh*3kPA}_8CWn_G9n3!y!Lb$xuKp^V-yd3gnKLJq_ic?xZ#`2kQst8+B zyA$5I^h~YP_Nu!U{{Wiur&=RsCi?0m9M^;e3@wJ@O!<7Jc(iV&Y+~;57krPG^vTXNS7{;;7q$CK%++jn0D%h>u5y|@rcwjbIa67+uqmF!%2Af z;UuaH83aTf_gJ$dekaY7Eh_4`>NVG!ixgwbj|i;?6xlSH$f@Mb86(>ts}j23Fs077 zHqN=xzRDjXqNZe!3KcIur1nub>3>XfaS3S*R{=Zxj24_+;nm69>gfx)7J|s0_i=mg zZFehIwsqlzqy1&W1^H3oL-+!PYIkI%r+FsK8*!4 z8RnY^G+!J;f|}E$TXaZuhLo7#fEn@USrF&eba-P&TEob;^F&2KMkr@9MjK3!)c50t z+YLMjs&g^~?PiFzT({fsW+TWnWN)#4YXBX&&1}8>SnEplJl(wXA&X5a;G}@AZRS{f zXH58k#u17WSg+u}gtqe{wP2qoY&mpTYwOHc@Hn-nx?Ze)pzG zl)Ri9tWiEhD2&(7K6eyIE`o0EY`2%eb=sb`nD^qHz2VJ8{cKYLeL%A}Mpk-1s==@V zv_s~f4WD(>D>v>fTbg^41qoTDQ^rW7?mdPrrPn|Nq6fR`hGedVi0D*bhlYf*;0i0G z@&b;{1QIJFWnErKRQl}9&d7{dq2G}f$i zl%5~m@*Nw9&~N-x9{ga3X*yHq*5vb1o!6E>Grw}B@jb9Ir`@c5jevcw+PeLnmw*%F zvZ$9m7&|XJY7b#xO1b%{D*ah9tUSKa&mWwAH@b0*Cj8GULp&jw0Yr(Q*9FW3 zWf`{DCz|vf^c-G)LPv1kl^Si{S*#l@(|81e$*@^+)!o}_MXpip6YjowC`=Z^1)cgW;-mY>z>7|%4|2l&sv zL5Y>jl6I1-#Rb_HzuXz~&TLg;etU158g6FpY=rrnFU_P5Nk0(z27KS{?S|nFdA1(w z_Sfsxew_4mw-dN?OjQxFTGZ&@_A-$(q}kkcV^iCZ(NEkN86Sq9y+tm*ab-9%@oe8H zBQ9kad%r!A>tZv}iZjKFqYDVhLUmVlQJf}l8@IyxYWU2-!Ciw!{Ok}86J9+}U#8V& zwy+Xhb*Y;?bZ{eqAK@{Oj7f8HD{WU}$EG1d=NZpkwd$@vNkJP}s^lKpb9XRF7>Adh zR3EShwKP+7AA?1Y3VL5-59Cg!+BLH|SXJ*26!K$cEZnj&c8gDie+TSuKw#Kcs|$rO zr-rl7>QNT6<$3g@w|7?11o;6sK(de;CFQ!s>0Q$MR_tS^uMbFQdLt?Y$H&Qd|rtEtk0crY|n29_dPm?J`gxf^{qhkDNAd+ErVf^gd{cYXuUBLRnZcFoVc+h0fmY(HyN(}0t zI?P<9qmsmh7A#XBrd^C37toKjTgb?yLDSd(G>n^OovyOKeEo9+%?DZWR~ z+t~z%mhwznR26a+X_>o{wK!n>0%&%WhjGi`zn8Az-ih0y^ToS2z9ZK~@v@+`T>&*- zFgLaqHGa3)&-*?Hy$AlK`qIg%hp%%SLK)tI&9rC=0`H~pZFSR{6F z9zU6Jb3Qk>XaL&Py3Gktvl!Gj9nyPx)cGwq7yf4BeeGUdn~5($^klsX}5ubSO^1_Q>6T1w1ryx zF&1E&A4LD`A#FX@gdjactK6A{N zX(lsfZO*byN8ZEUe~MfCi3o@G_Xq`cX?$4f;}KGEUZ}-yx*V8dT|A7Rt_Y8coD6!E zZNC4Wr*FuHS~Cj57z~`t%Q1rTZ;((Ygb0-hui{%xc#nQkx{`ty7B*H7vUP6~uU#}~ z&*Sf(MuT;}MlRUw5HQ~P8FUZ5OJy(P_i~K9_lw%e8=uF!t8UR|;%0_&1%h`r^4%$d zv@8=E1e`UIiz6u1yXoxj4Y2-q@U^^(0T}9LLEAhqEWQ-?j?v{X)gk`^BW*ALrQ2+g|<5{Tl%i=bbKE2QRJO zYryfx-c|8u!Sh;iTe4(^T9TZeNqR9(%qM z=ud`9Y24ZP;=hp*wkXyAi7|J(A&L=sx(qZi(*;2X#Vdzq*dsj#$>cN%VlOlB2hvs} zjeRN`kTRV+|MY+A4&zV+!FeWik(1TcT07FVs)4G692a%*u;4d7vFSg)O7PmM*)GZw zX8iBtr1w9{wE9Ii0F_90;ohneXAZ{L$irF6BYQKGAbQgF3!SWyViIvB&Mw7;BkDag zqc}y}UY(7 z{3~Ezxgs>~&Kdx<+2F`bQtNwt-p`_^(&qf%tt!m6M>{}uBa(%D^ 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 00000000..9215b977 --- /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 00000000..598ecbe0 --- /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/vignettes/articles/color_table.Rmd b/vignettes/articles/color_table.Rmd new file mode 100644 index 00000000..b6e118dd --- /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 00000000..fc56e121 --- /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
+
+
+
+ + + + + + + + + + + From 78da06f9604146ee149b531cd85330b0ceb8ab69 Mon Sep 17 00:00:00 2001 From: Michael Friendly Date: Fri, 13 Mar 2026 22:25:55 -0400 Subject: [PATCH 2/2] add knit_include() --- NAMESPACE | 3 + R/knit_include.R | 88 + _pkgdown.yml | 1 + extra/check_pkgs.R | 2 + extra/knit_include.R | 77 + extra/knit_include_test.Rmd | 66 + extra/knit_include_test.html | 4885 ++++++++++++++++++++++++++++++++++ man/color_table.Rd | 40 +- man/knit_include.Rd | 76 + 9 files changed, 5227 insertions(+), 11 deletions(-) create mode 100644 R/knit_include.R create mode 100644 extra/check_pkgs.R create mode 100644 extra/knit_include.R create mode 100644 extra/knit_include_test.Rmd create mode 100644 extra/knit_include_test.html create mode 100644 man/knit_include.Rd diff --git a/NAMESPACE b/NAMESPACE index b21fa4f0..6f811835 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/knit_include.R b/R/knit_include.R new file mode 100644 index 00000000..7a277967 --- /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 c3fda3e6..a7fe9215 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -54,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 00000000..1fcffefb --- /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/knit_include.R b/extra/knit_include.R new file mode 100644 index 00000000..963d832d --- /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 00000000..52a7f913 --- /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 00000000..9db98c43 --- /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 a68f326f..ee551699 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 00000000..b508a9ba --- /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() +} + +}