Showing preview only (907K chars total). Download the full file or copy to clipboard to get everything.
Repository: nutterb/pixiedust
Branch: main
Commit: 5d1dfadd1f17
Files: 200
Total size: 852.6 KB
Directory structure:
gitextract_aljgexrk/
├── .Rbuildignore
├── .gitignore
├── .travis.yml
├── CRAN-RELEASE
├── DESCRIPTION
├── NAMESPACE
├── NEWS
├── R/
│ ├── as.data.frame.dust.R
│ ├── chain.R
│ ├── dust.R
│ ├── fixed_header_css.R
│ ├── gaze.R
│ ├── get_dust_part.R
│ ├── glance_foot.R
│ ├── index_to_sprinkle.R
│ ├── is_valid_color.R
│ ├── knit_print.dust.R
│ ├── medley.R
│ ├── medley_all_borders.R
│ ├── perform_function.R
│ ├── pixie_count.R
│ ├── pixiedust-pkg.R
│ ├── pixiedust_print_method.R
│ ├── pixieply.R
│ ├── print.dust.R
│ ├── print_dust_console.R
│ ├── print_dust_html.R
│ ├── print_dust_latex.R
│ ├── print_dust_latex_hhline.R
│ ├── print_dust_markdown.R
│ ├── pval_string.R
│ ├── rbind_internal.R
│ ├── redust.R
│ ├── reshape_data_internal.R
│ ├── sanitize_latex.R
│ ├── sprinkle.R
│ ├── sprinkle_align.R
│ ├── sprinkle_bg.R
│ ├── sprinkle_bg_pattern.R
│ ├── sprinkle_bookdown.R
│ ├── sprinkle_border.R
│ ├── sprinkle_border_collapse.R
│ ├── sprinkle_caption.R
│ ├── sprinkle_caption_number.R
│ ├── sprinkle_colnames.R
│ ├── sprinkle_discrete.R
│ ├── sprinkle_fixed_header.R
│ ├── sprinkle_float.R
│ ├── sprinkle_fn.R
│ ├── sprinkle_font.R
│ ├── sprinkle_gradient.R
│ ├── sprinkle_height.R
│ ├── sprinkle_hhline.R
│ ├── sprinkle_html_preserve.R
│ ├── sprinkle_justify.R
│ ├── sprinkle_label.R
│ ├── sprinkle_longtable.R
│ ├── sprinkle_merge.R
│ ├── sprinkle_na_string.R
│ ├── sprinkle_pad.R
│ ├── sprinkle_print_method.R
│ ├── sprinkle_replace.R
│ ├── sprinkle_rotate_degree.R
│ ├── sprinkle_round.R
│ ├── sprinkle_sanitize.R
│ ├── sprinkle_tabcolsep.R
│ ├── sprinkle_table.R
│ ├── sprinkle_width.R
│ ├── str_extract_base.R
│ ├── sysdata.rda
│ ├── tidy_levels_labels.R
│ └── zzz.R
├── README.Rmd
├── README.md
├── cran-comments.md
├── inst/
│ ├── save_sprinkles_rda.R
│ ├── sprinkle_documentation.csv
│ ├── sprinkle_reference.csv
│ └── sprinkles.csv
├── man/
│ ├── as.data.frame.dust.Rd
│ ├── chain.Rd
│ ├── compoundAssignment.Rd
│ ├── dust.Rd
│ ├── fixed_header_css.Rd
│ ├── gaze.Rd
│ ├── get_dust_part.Rd
│ ├── glance_foot.Rd
│ ├── index_to_sprinkle.Rd
│ ├── is_valid_color.Rd
│ ├── knit_print.dust.Rd
│ ├── medley.Rd
│ ├── medley_all_borders.Rd
│ ├── pixie_count.Rd
│ ├── pixiedust.Rd
│ ├── pixiedust_print_method.Rd
│ ├── pixieply.Rd
│ ├── print.dust.Rd
│ ├── pval_string.Rd
│ ├── rbind_internal.Rd
│ ├── reshape_data_internal.Rd
│ ├── sanitize_latex.Rd
│ ├── sprinkle.Rd
│ ├── sprinkle_align.Rd
│ ├── sprinkle_bg.Rd
│ ├── sprinkle_bg_pattern.Rd
│ ├── sprinkle_bookdown.Rd
│ ├── sprinkle_border.Rd
│ ├── sprinkle_border_collapse.Rd
│ ├── sprinkle_caption.Rd
│ ├── sprinkle_caption_number.Rd
│ ├── sprinkle_colnames.Rd
│ ├── sprinkle_discrete.Rd
│ ├── sprinkle_fixed_header.Rd
│ ├── sprinkle_float.Rd
│ ├── sprinkle_fn.Rd
│ ├── sprinkle_font.Rd
│ ├── sprinkle_gradient.Rd
│ ├── sprinkle_height.Rd
│ ├── sprinkle_hhline.Rd
│ ├── sprinkle_html_preserve.Rd
│ ├── sprinkle_justify.Rd
│ ├── sprinkle_label.Rd
│ ├── sprinkle_longtable.Rd
│ ├── sprinkle_merge.Rd
│ ├── sprinkle_na_string.Rd
│ ├── sprinkle_pad.Rd
│ ├── sprinkle_replace.Rd
│ ├── sprinkle_rotate_degree.Rd
│ ├── sprinkle_round.Rd
│ ├── sprinkle_sanitize.Rd
│ ├── sprinkle_tabcolsep.Rd
│ ├── sprinkle_width.Rd
│ ├── str_extract_base.Rd
│ └── tidy_levels_labels.Rd
├── pixiedust.Rproj
├── tests/
│ ├── testthat/
│ │ ├── test-as.data.frame.R
│ │ ├── test-colors.R
│ │ ├── test-dust.R
│ │ ├── test-dust.grouped_df.R
│ │ ├── test-fixed_header_css.R
│ │ ├── test-gaze.R
│ │ ├── test-get_dust_part.R
│ │ ├── test-glance_foot.R
│ │ ├── test-index_to_sprinkle.R
│ │ ├── test-is_valid_color.R
│ │ ├── test-medley.R
│ │ ├── test-medley_all_borders.R
│ │ ├── test-perform_function.R
│ │ ├── test-pixie_count.R
│ │ ├── test-pixieply.R
│ │ ├── test-print.dust-explicit.R
│ │ ├── test-print.dust.R
│ │ ├── test-print_dust_html.R
│ │ ├── test-print_dust_latex.R
│ │ ├── test-print_dust_latex_hhline.R
│ │ ├── test-print_dust_methods.R
│ │ ├── test-pvalString.R
│ │ ├── test-redust.R
│ │ ├── test-roundSafe.R
│ │ ├── test-sanitize_latex.R
│ │ ├── test-sprinkle_align.R
│ │ ├── test-sprinkle_bg.R
│ │ ├── test-sprinkle_bg_pattern.R
│ │ ├── test-sprinkle_bookdown.R
│ │ ├── test-sprinkle_border.R
│ │ ├── test-sprinkle_border_collapse.R
│ │ ├── test-sprinkle_caption.R
│ │ ├── test-sprinkle_caption_number.R
│ │ ├── test-sprinkle_colnames.R
│ │ ├── test-sprinkle_discrete.R
│ │ ├── test-sprinkle_dust_list.R
│ │ ├── test-sprinkle_fixed_header.R
│ │ ├── test-sprinkle_float.R
│ │ ├── test-sprinkle_fn.R
│ │ ├── test-sprinkle_font.R
│ │ ├── test-sprinkle_gradient.R
│ │ ├── test-sprinkle_height.R
│ │ ├── test-sprinkle_hhline.R
│ │ ├── test-sprinkle_html_preserve.R
│ │ ├── test-sprinkle_justify.R
│ │ ├── test-sprinkle_label.R
│ │ ├── test-sprinkle_longtable.R
│ │ ├── test-sprinkle_merge.R
│ │ ├── test-sprinkle_na_string.R
│ │ ├── test-sprinkle_pad.R
│ │ ├── test-sprinkle_replace.R
│ │ ├── test-sprinkle_rotate_degree.R
│ │ ├── test-sprinkle_round.R
│ │ ├── test-sprinkle_sanitize.R
│ │ ├── test-sprinkle_tabcolsep.R
│ │ ├── test-sprinkle_table.R
│ │ ├── test-sprinkle_width.R
│ │ ├── test-sprinkles.R
│ │ └── test-tidy_label_level.R
│ └── testthat.R
├── vignettes/
│ ├── advancedMagic.Rmd
│ ├── no_css.css
│ ├── pixiedust.Rmd
│ └── sprinkles.Rmd
└── xtable_vs_pixiedust.Rmd
================================================
FILE CONTENTS
================================================
================================================
FILE: .Rbuildignore
================================================
^CRAN-RELEASE$
^.*\.Rproj$
^\.Rproj\.user$
^\.gitignore$
^\.travis.yml$
^\.travis\.yml$
^cran-comments.md$
^README\.Rmd$
^README-.*\.png$
^xtable_vs_pixiedust.html$
^xtable_vs_pixiedust.Rmd$
^\\inst\\save_sprinkles_rda.R$
^revdep$
================================================
FILE: .gitignore
================================================
# History files
.Rhistory
.Rapp.history
# Example code in package build process
*-Ex.R
# RStudio files
.Rproj.user/
# produced vignettes
vignettes/*.html
vignettes/*.pdf
.Rproj.user
# comparisons document
xtable_vs_pixiedust.html
LaTeX_Table_Tests.pdf
# Reverse Dependency check
/revdep/*
================================================
FILE: .travis.yml
================================================
# Sample .travis.yml for R projects
language: r
warnings_are_errors: true
sudo: setuid root
env:
global:
- CRAN: http://cran.rstudio.com
- WARNINGS_ARE_ERRORS=1
- R_BUILD_ARGS=--no-manual
- R_CHECK_ARGS=--no-manual
r_github_packages:
- Rexamine/stringi
notifications:
email:
on_success: change
on_failure: change
r_github_packages:
- jimhester/covr
after_success:
- Rscript -e 'library(covr);coveralls()'
================================================
FILE: CRAN-RELEASE
================================================
This package was submitted to CRAN on 2021-01-15.
Once it is accepted, delete this file and tag the release (commit b38adae).
================================================
FILE: DESCRIPTION
================================================
Package: pixiedust
Title: Tables so Beautifully Fine-Tuned You Will Believe It's Magic
Version: 0.9.4
Authors@R: c(person("Benjamin", "Nutter", email = "benjamin.nutter@gmail.com", role = c("aut", "cre")),
person("David", "Kretch", role = c("ctb")))
Description: The introduction of the 'broom' package has made converting model
objects into data frames as simple as a single function. While the 'broom'
package focuses on providing tidy data frames that can be used in advanced
analysis, it deliberately stops short of providing functionality for reporting
models in publication-ready tables. 'pixiedust' provides this functionality with
a programming interface intended to be similar to 'ggplot2's system of layers
with fine tuned control over each cell of the table. Options for output include
printing to the console and to the common markdown formats (markdown, HTML, and
LaTeX). With a little 'pixiedust' (and happy thoughts) tables can really fly.
Depends:
R (>= 3.1.2)
Imports:
broom,
checkmate (>= 1.8.0),
htmltools,
knitr,
labelVector,
magrittr,
reshape2,
scales
Suggests:
dplyr,
rmarkdown,
testthat
License: GPL (>= 2)
LazyData: true
VignetteBuilder: knitr
URL: https://github.com/nutterb/pixiedust
BugReports: https://github.com/nutterb/pixiedust/issues
RoxygenNote: 7.2.3
NeedsCompilation: no
================================================
FILE: NAMESPACE
================================================
# Generated by roxygen2: do not edit by hand
S3method(as.data.frame,dust)
S3method(as.data.frame,dust_list)
S3method(dust,default)
S3method(dust,grouped_df)
S3method(dust,list)
S3method(knit_print,dust)
S3method(knit_print,dust_list)
S3method(print,dust)
S3method(print,dust_list)
S3method(redust,default)
S3method(redust,dust_list)
S3method(sprinkle,default)
S3method(sprinkle,dust_list)
S3method(sprinkle_align,default)
S3method(sprinkle_align,dust_list)
S3method(sprinkle_bg,default)
S3method(sprinkle_bg,dust_list)
S3method(sprinkle_bg_pattern,default)
S3method(sprinkle_bg_pattern,dust_list)
S3method(sprinkle_bookdown,default)
S3method(sprinkle_bookdown,dust_list)
S3method(sprinkle_border,default)
S3method(sprinkle_border,dust_list)
S3method(sprinkle_border_collapse,default)
S3method(sprinkle_border_collapse,dust_list)
S3method(sprinkle_caption,default)
S3method(sprinkle_caption,dust_list)
S3method(sprinkle_caption_number,default)
S3method(sprinkle_caption_number,dust_list)
S3method(sprinkle_colnames,default)
S3method(sprinkle_colnames,dust_list)
S3method(sprinkle_discrete,default)
S3method(sprinkle_discrete,dust_list)
S3method(sprinkle_fixed_header,default)
S3method(sprinkle_fixed_header,dust_list)
S3method(sprinkle_float,default)
S3method(sprinkle_float,dust_list)
S3method(sprinkle_fn,default)
S3method(sprinkle_fn,dust_list)
S3method(sprinkle_font,default)
S3method(sprinkle_font,dust_list)
S3method(sprinkle_gradient,default)
S3method(sprinkle_gradient,dust_list)
S3method(sprinkle_height,default)
S3method(sprinkle_height,dust_list)
S3method(sprinkle_hhline,default)
S3method(sprinkle_hhline,dust_list)
S3method(sprinkle_html_preserve,default)
S3method(sprinkle_html_preserve,dust_list)
S3method(sprinkle_justify,default)
S3method(sprinkle_justify,dust_list)
S3method(sprinkle_label,default)
S3method(sprinkle_label,dust_list)
S3method(sprinkle_longtable,default)
S3method(sprinkle_longtable,dust_list)
S3method(sprinkle_merge,default)
S3method(sprinkle_merge,dust_list)
S3method(sprinkle_na_string,default)
S3method(sprinkle_na_string,dust_list)
S3method(sprinkle_pad,default)
S3method(sprinkle_pad,dust_list)
S3method(sprinkle_print_method,default)
S3method(sprinkle_print_method,dust_list)
S3method(sprinkle_replace,default)
S3method(sprinkle_replace,dust_list)
S3method(sprinkle_rotate_degree,default)
S3method(sprinkle_rotate_degree,dust_list)
S3method(sprinkle_round,default)
S3method(sprinkle_round,dust_list)
S3method(sprinkle_sanitize,default)
S3method(sprinkle_sanitize,dust_list)
S3method(sprinkle_tabcolsep,default)
S3method(sprinkle_tabcolsep,dust_list)
S3method(sprinkle_table,default)
S3method(sprinkle_table,dust_list)
S3method(sprinkle_width,default)
S3method(sprinkle_width,dust_list)
export("%<>%")
export("%>%")
export(dust)
export(fixed_header_css)
export(gaze)
export(get_dust_part)
export(get_pixie_count)
export(increment_pixie_count)
export(is_valid_color)
export(is_valid_color_single)
export(medley_all_borders)
export(medley_bw)
export(medley_model)
export(pixiemap)
export(pixieply)
export(pvalString)
export(pval_string)
export(redust)
export(sanitize_latex)
export(set_pixie_count)
export(sprinkle)
export(sprinkle_align)
export(sprinkle_background)
export(sprinkle_bg)
export(sprinkle_bg_pattern)
export(sprinkle_bookdown)
export(sprinkle_border)
export(sprinkle_border_collapse)
export(sprinkle_caption)
export(sprinkle_caption_number)
export(sprinkle_colnames)
export(sprinkle_discrete)
export(sprinkle_fixed_header)
export(sprinkle_float)
export(sprinkle_fn)
export(sprinkle_font)
export(sprinkle_gradient)
export(sprinkle_height)
export(sprinkle_hhline)
export(sprinkle_html_preserve)
export(sprinkle_justify)
export(sprinkle_label)
export(sprinkle_longtable)
export(sprinkle_merge)
export(sprinkle_na_string)
export(sprinkle_pad)
export(sprinkle_print_method)
export(sprinkle_replace)
export(sprinkle_rotate_degree)
export(sprinkle_round)
export(sprinkle_sanitize)
export(sprinkle_tabcolsep)
export(sprinkle_table)
export(sprinkle_width)
importFrom(knitr,knit_print)
importFrom(magrittr,"%<>%")
importFrom(magrittr,"%>%")
================================================
FILE: NEWS
================================================
### 0.9.0 (2020-05-10)
* Package now carries fewer dependencies.
* No new features.
* Note: There is no plan for further development of pixiedust. I consider this a usable and stable package. Maintenance will be limited to tasks necessary to retain current features and to remain on CRAN.
### 0.8.4 (2018-06-29)
* Added `gaze` function to produce model summaries side-by-side (#80)
* Small adjustments to work with upcoming version of `broom`.
### 0.8.3 (2018-03-22)
* Repaired recycling in several sprinkles. Sprinkles that permit more than
one value will return an error if given multiple values and
`recycle = "none"`. The user must explicitly designate if recycling
should be done over rows or columns.
* Mapped "slidy" output to HTML.
* Added several tests, bring test coverage up to 96%
### 0.8.2 (2018-02-23)
* Added `caption_number` sprinkle, allowing numbering of tables to be
turned off (#108)
* Changed the license in order to redistribute code from the
`Hmisc` package.
* Added `fixed_header` sprinkle. Allows HTML tables to have a fixed
header over a scrollable body.
* Added lots of tests.
* Added `knit_print` method to allow printing in Rmarkdown documents to
operate more smoothly (#96).
* Fixed text wrapping around left and right justified HTML tables (#107)
* Added tabcolsep argument to \code{dust}
### 0.8.0 (2017-08-26)
* Backward Compatibility Break: the `border_collapse` argument was changed
to a character argument. This allows the full options available in HTML.
The new default is `border_collapse = "collapse"`, which is the equivalent
of `border_collapse = TRUE`. Backward compatibility will be broken only
if the `border_collapse` argument was changed.
* All sprinkles have individual functions to perform their specific task. Now
`sprinkle(bg = "blue")` may also be done via `sprinkle_bg(bg = 'blue')`.
Although this isn't a much of a change to the user, it makes infrastructure
changes possible that will make the codebase easier to support.
* Added the `discrete` and `discrete_colors` sprinkles. (Issue #56)
* Added the `gradient`, `gradient_n`, `gradient_cut`, and `gradient_colors`
sprinkles. (Issue #56)
* Fix hexadecimal color transparency bug (Issue #66)
* Added `get_dust_part` to assist with generation of custom headers and
footers (Issue #72)
* Removed CSS styling for tables from the vignettes. (Issue #69)
* Reduced spacing between table and caption in the LaTeX `longtable`
environment.
* Fixes to support dplyr 0.5.0 (thanks to David Kretch)
* Better control over when to print to interactive environment viewer.
(Issue #88)
### 0.7.5 (26 August 2016)
* Add `pixiemap` for applying differing sprinkles across a `dust_list`
* Add the argument `logical_rows` for dynamically locating rows to sprinkle
* Include a link to the pixiedust webpage for documentation augmentation.
### 0.7.4 (17 June 2016)
* Guard against changes to `options()$scipen` (Issue #62)
* Remove remaining use of `ArgumentCheck` and replace with `checkmate`
#### 0.7.3 (10 June 2016)
* Fixed rotation in HTML tables
* Created a new argument for `print_dust_html` (Issue #57) to
give the user control over the amount of white space
following HTML tables.
* The `replace` sprinkle is now applied during printing. It
had been applied in `sprinkle`, which violated the philosophy
of not changing the content of the data frame until the last
possible moment.
* Added some extra unit tests.
#### 0.7.2 (19 May 2016)
* Fixed the padding specification in HTML tables.
#### 0.7.1 (4 May 2016)
* the sprinkles `bg`, `border_color` and `font_color` now interpret
"transparent" as a valid color. In HTML, it is interpreted as
`"rgba(255,255,255,0)"`; in LaTeX it is interpreted as `""`.
* New Sprinkle: `sanitize`. Defaults to `FALSE` and replaces automatic
sanitization of text in LaTeX output via `Hmisc::latexTranslate`.
This is not backward compatible with 0.7.0, but _is_ consistent with
earlier versions of `pixiedust`. You must opt in to sanitization now.
* New Sprinkle: `sanitize_args`. Takes a list of arguments to pass
to `Hmisc::latexTranslate`, allowing sanitization to be extended to
character sets defined by the user.
#### 0.7.0 (15 April 2016)
* Backward compatibility: The way `pixiedust` deals with
colors has changed. If you are using custom defined colors in your
LaTeX preamble, these will no longer work. `pixiedust` will only accept
colors names in `colors()`, or in the `rgb`, `rgba`, `#RRGGBB`, or
`#RRDDBBAA` formats. This only affects LaTeX output, and provides a
better interface for ensuring all HTML and LaTeX output are as similar
as possible.
* Added justification for tables. Use the `justify` argument in
`dust` and the `justify` sprinkle to move the table to the left,
or right side of the page. Defaults to centered.
* Added auto-detection of the print method. When a document is being
knit, the output format is read from `knitr::opts_knit$get("rmarkdown.pandoc.to")`.
If this resolves to `NULL`, the value of `getOption("pixiedust_print_method")`
is used.
* Added `docx` as a valid print method, which is synonymous with `markdown`.
* labels for HTML and LaTeX tables are automatically generated when
`label = NULL`. First, an attempt is made to generate a label from the
chunk label, and if that fails, a label is generated from `getOption("pixie_count")`
* Added default horizontal alignments for HTML tables
* Added default rounding for numerical values. If the user does not give a value,
the value of `getOption("digits")` is used. This effectively prints as many
decimal places as would be printed in the console.
* Sprinkle recycling is added with `recycle` argument.
* Fixed coordinate pairs is added with `fixed` argument.
* Added recognition of all colors in `colors()`
#### 0.6.3 (8 April 2016)
* Converted `dust`, `sprinkle` functions, and `print` to S3 methods.
This allows for lists of data frames to be processed as
separate tables.
* Added `dust.grouped_df` to give the option of ungrouping a
grouped_df object, or splitting it.
* Added the `bookdown` attribute (and sprinkle) to allow use with
the `bookdown` package.
* Added labeling.
* Added `caption`, `hhline`, and `float` as sprinkles.
* Changed the default colors for `bg_pattern` to "#FFFFFF#" and "#DDDDDD".
The gray in this pattern is a little lighter and should do better when
printed in black and white.
#### 0.6.2 (15 March 2016)
* Implemented a new printing method that makes use of the `hhline`
LaTeX package. This allows borders to be drawn over background
colors. In the existing method, the cell borders are hidden
by background colors. The hhline method can be used by setting
`options(pixiedust_latex_hhline = TRUE)`.
#### 0.6.1 (8 January 2016)
* Table Captions are now implemented.
* Added parameter to place LaTeX tables in a float environment. This was
necessary to make table captions functional in non-longtable situations.
#### 0.6.0 (09 December 2015)
* LaTeX output is fully implemented
* `tabrowsep` element was removed from the `dust` object since it apparently
isn't a real thing.
* Implemented rotated text.
* Pushed version to 0.6.0
#### 0.5.6 (06 December 2015)
* Finished the borders for LaTeX output. This completes the baseline LaTeX output.
#### 0.5.5 (04 December 2015)
* Revamped the LateX output again, pretty much started over entirely. But now
the only thing missing is cell borders, and my previous work will accommodate
those.
* Added `tablewidth`, `tabcolsep`, and `tabrowsep` elements to the dust object.
`tablewidth` allows the user to define cell width in terms of a percentage of
the total expected table width. Not really recommended, but at least preserves
some continuity between HTML and LaTeX output.
* `tabcolsep` and `tabrowsep` control the distance between columns and rows in tables,
but this feature isn't yet implemented.
* Documentation is lacking on `tablewidth`, `tabcolsep`, and `tabrowsep`
#### 0.5.4 (10 November 2015)
* Added the `font_family` sprinkle for HTML output
#### 0.5.3 (5 November 2015)
* Due to a great deal of difficulty getting the last couple of
features to play nicely, I decided to take a different
approach to the LaTeX output. Most features are
available, but I have yet to include column widths,
column heights, or multirow output.
* An option is added to the print method that
turns off the `knitr::asis_output` return.
The motivation behind this was to be able to
use the HTML code in shiny applications.
#### 0.5.2 (4 November 2015)
* Longtable support is added
* Documentation on cell borders is up to date
#### 0.5.1 (3 November 2015)
* Cell borders. Documentation still needs review.
#### 0.5.0 (Change Log Highlights since last CRAN Release)
* `pixiedust` no longer uses the `+` operator.
Please use `%>%` instead.
* Complete support for HTML tables is available.
* Limited support for LaTeX tables is available.
* New vignette: Advanced Magic.
* Added the `replace` sprinkle to replace values in
table columns, rows, or cells.
* Added the `longtable` sprinkle: allows tables to
be printed in multiple sections.
* Added the `na_string` sprinkle.
* Added support for multirow headers and footers.
* Added support for multicell output using the
`merge` sprinkle.
* Added an option `glance_foot`, which places model
summary statistics in the foot of a table.
* Added options for including variables labels and
more detailed descriptions of factors and levels.
* Introduces "medleys", functions that can apply
multiple sprinkles to a `dust` object in a
single line.
* Adds `as.data.frame.dust` method
#### 0.4.3-0 (13 October 2015)
* The majority of LaTeX sprinkles are available, with
the exception of borders, longtable, merging cells,
and rotated text.
#### 0.4.2-0 (5 October 2015)
* Added basic medleys
* Adds as.data.frame.dust method. Closes Issue #33
#### 0.4.1-0 (1 October 2015)
* Started LaTeX Output
#### 0.4.0-0 (25 September 2015)
* Fixed a bug described in Issue #26
* Changes to Advance Magic vignette use a linear model and
glance statistics for examples.
#### 0.3.1-0 (18 September 2015)
* Glance footer is implemented. Vignettes need to be updated
* Variable labels and levels are implemented (well ahead of
schedule!). Vignettes need to be updated
#### 0.3.0-0 (15 September 2015)
* Multi-cell output for HTML is fully supported.
* Data frame row names may be captured in the output with `dust`
argument `keep_rownames`
* A new sprinkle is added. `na_string` defaults to "", and controls how
`NA` is printed in tables.
#### 0.2.0-1 (31 August 2015)
* Multi-cell output is functional for HTML, Markdown, and Console output
* A poor example is added to the `advancedMagic` vignette, but a better
example is really needed.
#### 0.1.1-7 (17 August 2015)
* Finished the Advanced Magic vignette, which serves as the tests for advanced
output since I haven't bothered to code a way to check the results directly.
* Configure the repository for coveralls.
* Adds `covr` and `Hmisc` to Suggests:
#### 0.1.1-6 (12 August 2015)
* Removed 'longtable' option from `print.dust` and made it a sprinkle. This
allows it to be used without having to explicitly call `print`.
* Implemented longtable capacity. Users may now break tables into multiple
divisions of either a default size (25 rows for console, markdown, or HTML)
or a user-specified number of rows.
* Began an "advanced magic" vignette to demonstrate the capabilities of
longtable and eventually multicolumn and multirow support. Similar
vignettes will be needed for console, markdown, and html output, though
not all of them will need to be bundled with the package.
* Added the `roundSafe` helper function to allow rounding to succeed while
skipping true character values.
#### 0.1.1-5 (11 August 2015)
* Added the `longtable` option to `print.dust`. Not yet active, but lays
the groundwork for multipage tables.
* Added multirow headers and footers (but not interfoot)
* Added the `redust` function for adding and/or switching table components. For
example, adding a multirow header, or a foot.
#### 0.1.1-4 (5 August 2015)
* Added the `replace` sprinkle to replace values in table columns, rows, or cells.
This closes Issue #12
#### 0.1.1-3 (4 August 2015)
* Optimizations related to removing ifelse calls.
* Initial values for table attributes are now stored as "" instead of NA.
This increases the object size, but cuts down on the processing time.
* Removed `object` element from the `dust` object. In Issue #13, matthieugomez
pointed out that very large models could create storage space problems.
There's no sense in keeping an extra copy of the model object.
* Removed the `+.dust` method and rewrote the sprinkles as pipable functions.
This resolves Issue #8
#### 0.1.1 (3 August 2015)
* Added the necessary fields to DESCRIPTION to get the vignettes to build.
#### 0.1.0 (1 August 2015)
* CRAN checks are passed. Prepared for release.
#### 0.0.0-9 (31 July 2015)
* Finished tests
* Finished vignettes
#### 0.0.0-8 (30 July 2015)
* Finished HTML rendering
* Adds pixiedust vignette
* Removes old vignettes
#### 0.0.0-7 (29 July 2015)
* Replace nearly all dust bunny functions with `sprinkle`
* Replace `dust_print_method` with `sprinkle_print_method`
* Replace `dust_colnames` with `sprinkle_colnames`
* It occurred to me as I studied the code base that instead
of rows and cols in the ... argument of the dust bunnies,
it made more sense to add the dust bunnies in ... with
formal arguments for row and col. I also came up
with the idea of naming the package `pixiedust` and
sprinkling the dust around. It sounded like fun so
let's hope CRAN lets me get away with it.
* All functionality has been rewritten to support the
pixiedust paradigm, but new tests and vignettes need
to be written to confirm that it all works.
* R CMD check has _NOT_ been run.
#### 0.0.0-6 (28 July 2015)
* Adds `dust_rotate_text`
#### 0.0.0-5 (27 July 2015)
* Adds `dust_cell_valign`
* Adds `dust_border_collapse`
* Adds `dust_table_border`
* Adds `dust_cell_border`
* Adds `dust_cell_padding`
#### 0.0.0-4 (26 July 2015)
* Improved the Dustbunnies vignette to use a color coded table indicating which
dust bunnies are planned, available, and functional for different printing
methods.
* Dropped leading zeroes from the version number.
* Adds `dust_font_color`, `dust_font_size`
* Adds `dust_cell_height`, `dust_cell_width`
#### 0.0.0-003 (25 July 2015)
* Adds halign and valign attributes to `dust$obj`. valign is not yet implemented.
* Adds `dust_cell_halign`
* Adds `dust_head_halign`
* Adds dustbunnies vignette
* Removed the `col_names` attribute of the `dust` object and replaced it with the
`head` object. The `head` object is a data frame holding the attributes of the
table header.
* Renamed the `obj` attributes of the `dust` object to `body`.
* Adds a lot of tests
* Adds `dust_cell_bg` and `dust_bg_pattern`
#### 0.0.0-002 (24 July 2015)
* 'col_names` attribute is now named. The names are the original
column names from the `broom` output.
* Adds `dust_fn`
* Adds `dust_bold`
* Adds `dust_italic`
* Adds `dust_print_format`
* Imports knitr
* Imports `lazyWeave::pvalString`
#### 0.0.0-001 (23 July 2015)
* Adds `dust` and `print.dust`.
* Only the method for printing to the console is available.
* `+.dust` added
* `dust_colnames` added
================================================
FILE: R/as.data.frame.dust.R
================================================
#' @name as.data.frame.dust
#'
#' @title Convert \code{dust} Object to Data Frame
#' @description Sprinkles are applied to the \code{dust} object
#' as if it were being prepared for printing to the console.
#' However, instead of printing, the object is returned
#' as a single data frame.
#'
#' @param x A \code{dust} object.
#' @param ... Arguments to be passed to other methods. Currently unused.
#' @param sprinkled Logical. If \code{TRUE}, the sprinkles attached to the
#' \code{dust} object are applied before returning the data frame.
#' Sprinkles are applied via the same mechanism that prints to the console,
#' so only sprinkles that are applicable to console output are used.
#' When \code{FALSE}, \code{pixiedust} attempts to reconstruct the
#' data frame (or tidied output from \code{broom::tidy}
#' originally given to \code{dust}.
#'
#' @details In its current state, this can be a fairly inefficient function
#' as the table, if the longtable option is in use, will be built in
#' a \code{for} loop and bound together using \code{rbind}. This isn't
#' really intended for large tables, but may be of assistance when
#' there isn't a sprinkle that does what you want to do. (You can
#' at least pull out the object as a data frame and do your own
#' post processing).
#'
#' @author Benjamin Nutter
#'
#' @section Functional Requirements:
#' \enumerate{
#' \item Accepts an object of class \code{dust} or \code{dust_list}
#' \item Accepts a \code{logical(1)} indicating if the sprinkles should
#' be applied to the data.
#' \item For a \code{dust} object, returns an object of class
#' \code{data.frame}
#' \item For a \code{dust_list} object, returns a list of objects of class
#' \code{data.frame}
#' }
#'
#' @examples
#' fit <- lm(mpg ~ qsec + factor(am) + wt * factor(gear), data = mtcars)
#' Dust <- dust(fit) %>%
#' sprinkle(cols = 2:4, round = 2) %>%
#' sprinkle(cols = 5, fn = quote(pvalString(value))) %>%
#' sprinkle(cols = 3, font_color = "#DA70D6") %>%
#' sprinkle_print_method("html")
#'
#' as.data.frame(Dust)
#'
#' @export
as.data.frame.dust <- function(x, ..., sprinkled = TRUE)
{
coll <- checkmate::makeAssertCollection()
checkmate::assert_class(x = x,
classes = "dust",
add = coll)
checkmate::assert_logical(x = sprinkled,
len = 1,
add = coll)
checkmate::reportAssertions(coll)
if (sprinkled)
{
return(print_dust_console(x, return_df = TRUE))
}
else
{
X <- x$body[c("row", "col", "value")]
X <- reshape2::dcast(X,
formula = row ~ col,
value.var = "value")
X <- X[!names(X) %in% "row"]
col_names <- tapply(X = x$body$col_name,
INDEX = x$body$col,
FUN = function(x) x[1])
col_names <- unname(col_names)
names(X) <- col_names
classes <- tapply(X = x$body$col_class,
INDEX = x$body$col,
FUN = function(x) x[1])
classes <- unname(classes)
classes <- sprintf("as.%s", classes)
for (i in seq_along(X)){
X[[i]] <- get(classes[i])(X[[i]])
}
X
}
}
#' @rdname as.data.frame.dust
#' @export
as.data.frame.dust_list <- function(x, ...)
{
checkmate::assert_class(x = x,
classes = "dust_list")
lapply(x,
as.data.frame.dust,
...)
}
================================================
FILE: R/chain.R
================================================
#' @name %>%
#' @rdname chain
#' @importFrom magrittr %>%
#' @export %>%
#' @usage lhs \%>\% rhs
#'
#' @title magrittr forward-pipe operator
#' @description Pipe an object forward into a function or call expression
#'
#' @param lhs,rhs A dataset and function to apply to it
NULL
#' @name %<>%
#' @rdname compoundAssignment
#' @importFrom magrittr %<>%
#' @export %<>%
#' @usage lhs \%<>\% rhs
#'
#' @title Chain together multiple operations
#' @description Chain together multiple operations and save to the object
#' at the start of the chain. See `magrittr` documentation for details.
#'
#' @param lhs,rhs A data set and function to apply it to
NULL
================================================
FILE: R/dust.R
================================================
#' @name dust
#' @export dust
#'
#' @title Dust Table Construction
#' @description Dust tables consist of four primary components that are
#' built together to create a full table. Namely, the \code{head}, the
#' \code{body}, the \code{interfoot}, and the \code{foot}. Dust tables
#' also contain a table-wide attributes \code{border_collapse} and
#' \code{longtable} as well as a \code{print_method} element.
#'
#' @param object An object that has a \code{tidy} method in \code{broom}
#' @param tidy_df When \code{object} is an object that inherits the
#' \code{data.frame} class, the default behavior is to assume that the
#' object itself is the basis of the table. If the summarized table is
#' desired, set to \code{TRUE}.
#' @param keep_rownames When \code{tidy_df} is \code{FALSE}, setting
#' \code{keep_rownames} binds the row names to the data frame as the first
#' column, allowing them to be preserved in the tabulated output. This
#' is only to data frame like objects, as the \code{broom::tidy.matrix} method
#' performs this already.
#' @param glance_foot Arrange the glance statistics for the \code{foot} of the
#' table. (Not scheduled for implementation until version 0.4.0)
#' @param glance_stats A character vector giving the names of the glance statistics
#' to put in the output. When \code{NULL}, the default, all of the available
#' statistics are retrieved. In addition to controlling which statistics are
#' printed, this also controls the order in which they are printed.
#' @param col_pairs An integer indicating the number of column-pairings for the
#' glance output. This must be less than half the total number of columns,
#' as each column-pairing includes a statistic name and value. See the full
#' documentation for the unexported function \code{\link{glance_foot}}.
#' @param byrow A logical, defaulting to \code{FALSE}, that indicates if the
#' requested statistics are placed with priority to rows or columns.
#' See the full documentation for the unexported function \code{\link{glance_foot}}.
#' @param descriptors A character vector indicating the descriptors to
#' be used in the table. Acceptable inputs are \code{"term"},
#' \code{"term_plain"}, \code{"label"}, \code{"level"}, and
#' \code{"level_detail"}. These may be used in any combination and
#' any order, with the descriptors appearing in the table from left
#' to right in the order given. The default, \code{"term"}, returns
#' only the term descriptor and is identical to the output provided
#' by \code{broom::tidy} methods. See Details for a full explanation
#' of each option and the Examples for sample output.
#' See the full documentation for the unexported function \code{\link{tidy_levels_labels}}.
#' @param numeric_level A character string that determines which descriptor
#' is used for numeric variables in the \code{"level_detail"} descriptor
#' when a numeric has an interaction with a factor. Acceptable inputs
#' are \code{"term"}, \code{"term_plain"}, and \code{"label"}.
#' See the full documentation for the unexported function \code{\link{tidy_levels_labels}}.
#' @param caption A character string giving the caption for the table.
#' @param caption_number \code{logical(1)}. Should the table caption be prefixed
#' with the table number?
#' @param float A logical used only in LaTeX output. When \code{TRUE}, the table is
#' set within a \code{table} environment. The default is \code{TRUE}, as with
#' \code{xtable}.
#' @param longtable Allows the user to print a table in multiple sections.
#' This is useful when
#' a table has more rows than will fit on a printed page. Acceptable inputs are \code{FALSE},
#' indicating that only one table is printed (default); \code{TRUE} that the table should be
#' split into multiple tables with the default number of rows per table (see "Longtable"); or a
#' positive integer indicating how many rows per table to include. All other values are
#' interpreted as \code{FALSE}. In LaTeX output, remember that after each section, a page
#' break is forced. This setting may also be set from \code{sprinkle}.
#' @param hhline Logical. When \code{FALSE}, the default, horizontal LaTeX cell borders
#' are drawn using the \code{\\cline} command. These don't necessarily
#' play well with cell backgrounds, however. Using \code{hhline = TRUE}
#' prints horizontal borders using the \code{\\hhline} command. While the
#' \code{hhline} output isn't disrupted by cell backgrounds, it may require
#' more careful coding of the desired borders. In \code{hhline}, cells with
#' adjoining borders tend to double up and look thicker than when using
#' \code{cline}.
#' @param label \code{character(1)}. An optional string for assigning labels with
#' which tables can be referenced elsewhere in the document. If \code{NULL},
#' \code{pixiedust} attempts to name the label \code{tab:[chunk-name]}, where
#' \code{[chunk-name]} is the name of the \code{knitr} chunk. If this also
#' resolves to \code{NULL} (for instance, when you aren't using \code{knitr},
#' the label \code{tab:pixie-[n]} is assigned, where \code{[n]} is the current value
#' of \code{options()$pixie_count}. Note that rendering multiple tables in a
#' chunk without specifying a label will result in label conflicts.
#' @param justify \code{character(1)}. Specifies the justification of the table on
#' the page. May be \code{"center"} (default), \code{"left"}, or \code{"right"}.
#' @param bookdown Logical. When \code{TRUE}, \code{bookdown} style labels are
#' generated. Defaults to \code{FALSE}.
#' @param border_collapse \code{character(1)}. One of \code{"collapse"},
#' \code{"separate"}, \code{"initial"}, or \code{"inherit"}.
#' @param tabcolsep \code{integerish(1)}. For LaTeX output, the distance in
#' \code{pt} between columns of the table.
#' @param fixed_header \code{logical(1)}. For HTML tables, should the
#' header rows be fixed in place over a scrollable body.
#' @param html_preserve \code{logical(1)}. When \code{TRUE}, HTML output is returned
#' wrapped in \code{htmltools::htmlPreserve}. If using LaTeX style equations in
#' an HTML table, it may be necessary to set this to \code{FALSE}. Do this at
#' your own risk; this has not been thoroughly field tested.
#' @param ... Additional arguments to pass to \code{tidy}
#' @param ungroup Used when a \code{grouped_df} object is passed to \code{dust}.
#' When \code{TRUE} (the default), the object is ungrouped and dusted
#' as a single table. When \code{FALSE}, the object is split and each element
#' is dusted separately.
#'
#' @details The \code{head} object describes what each column of the table
#' represents. By default, the head is a single row, but multi row headers
#' may be provided. Note that multirow headers may not render in markdown
#' or console output as intended, though rendering in HTML and LaTeX is
#' fairly reliable. In longtables (tables broken over multiple pages),
#' the \code{head} appears at the top of each table portion.
#'
#' The \code{body} object gives the main body of information. In long tables,
#' this section is broken into portions, ideally with one portion per page.
#'
#' The \code{interfoot} object is an optional table to be placed at the
#' bottom of longtable portions with the exception of the last portion. A
#' well designed \code{interfoot} can convey to the user that the table
#' continues on the next page.
#'
#' The \code{foot} object is the table that appears at the end of the
#' completed table. For model objects, it is recommended that the
#' \code{\link[broom]{glance}} statistics be used to display model fit
#' statistics.
#'
#' The \code{border_collapse} object applies to an entire HTML table. It
#' indicates if the borders should form a single line or distinct lines.
#'
#' The \code{longtable} object determines how many rows per page are printed.
#' By default, all content is printed as a single table. Using the
#' \code{longtable} argument in the \code{\link{sprinkle}} function can change this
#' setting.
#'
#' The \code{table_width} element is specific to LaTeX tables. This is a reference
#' value for when column widths are specified in terms of the \code{\%} units. For
#' example, a column width of \code{20\%} will be defined as \code{table_width * .20}.
#' The value in \code{table_width} is assumed to be in inches and defaults to 6.
#'
#' The \code{tabcolsep} object determines the spacing between columns in a
#' LaTeX table in pt. By default, it is set at 6.
#'
#' The \code{print_method} object determines how the table is rendered when
#' the \code{print} method is invoked. The default is to print to the
#' console.
#'
#' Many of these options may be set globally. See
#' \code{\link{pixiedust}} for a complete list of package options.
#'
#' @return Returns an object of class \code{dust}
#'
#' @section Symbols and Greek Letters:
#' When using markdown, math symbols and greek letters may be employed as
#' they would within a markdown document. For example, \code{"$\alpha$"}
#' will render as the lower case Greek alpha. Math symbols may be rendered
#' in the same manner.
#'
#' @seealso \code{\link[broom]{tidy}} \code{\link{glance_foot}}
#' \code{\link{tidy_levels_labels}} \code{\link{pixiedust}}
#'
#' \code{\link{get_dust_part}} for extracting parts of the \code{dust} object
#' in order to build custom headers and/or footers.
#'
#' @author Benjamin Nutter
#'
#' @examples
#' x <- dust(lm(mpg ~ qsec + factor(am), data = mtcars))
#' x
dust <- function(object, ...)
{
UseMethod("dust")
}
#' @rdname dust
#' @export
dust.default <- function(object, ...,
tidy_df = FALSE, keep_rownames = FALSE,
glance_foot = FALSE, glance_stats = NULL,
col_pairs = 2, byrow = FALSE,
descriptors = "term",
numeric_level = c("term", "term_plain", "label"),
label = NULL,
caption = NULL,
caption_number = getOption("pixied_caption_number", TRUE),
justify = getOption("pixie_justify", "center"),
float = getOption("pixie_float", TRUE),
longtable = getOption("pixie_longtable", FALSE),
hhline = getOption("pixie_hhline", FALSE),
bookdown = getOption("pixie_bookdown", FALSE),
border_collapse = getOption("pixie_border_collapse", "collapse"),
tabcolsep = getOption("pixie_tabcolsep", 6),
fixed_header = getOption("pixie_fixed_header", FALSE),
html_preserve = getOption("pixie_html_preserve", TRUE))
{
coll <- checkmate::makeAssertCollection()
descriptors <- checkmate::matchArg(x = descriptors,
choices = c("term", "term_plain", "label",
"level", "level_detail"),
several.ok = TRUE,
add = coll)
#* By default, we assume data.frame-like objects are to be printed
#* as given. All other objects are tidied.
if (!inherits(object, "data.frame") | tidy_df)
{
tidy_object <- as.data.frame(broom::tidy(object, ...))
}
else if (inherits(object, "data.frame"))
{
if (inherits(object, "data.table"))
{
object <- as.data.frame(object)
}
if (keep_rownames)
{
tidy_object <- cbind(rownames(object),
object)
rownames(tidy_object) <- NULL
tidy_object[, 1] <- as.character(tidy_object[, 1])
names(tidy_object)[1] <- ".rownames"
}
else
{
tidy_object <- object
}
}
if (!inherits(object, "data.frame") & any(!descriptors %in% "term"))
{
nms <- names(tidy_object)
tll <- tidy_levels_labels(object,
descriptors = descriptors,
numeric_level = numeric_level,
argcheck = coll)
tidy_object <-
merge(tidy_object,
tll,
by = "term",
all.x = TRUE)
if ("label" %in% names(tidy_object))
{
is_intercept <- grepl(pattern = "([(]|)Intercept([)]|)",
x = tidy_object[["term"]])
tidy_object[["label"]][is_intercept] <-
tidy_object[["term"]][is_intercept]
}
if ("term_plain" %in% names(tidy_object))
{
is_intercept <- grepl(pattern = "([(]|)Intercept([)]|)",
x = tidy_object[["term"]])
tidy_object[["label"]][is_intercept] <-
tidy_object[["term_plain"]][is_intercept]
}
if (!"term" %in% descriptors)
{
nms <- nms[!nms %in% "term"]
}
tidy_object <- tidy_object[unique(c(descriptors, nms))]
}
checkmate::reportAssertions(coll)
#* Create the table head
head <- as.data.frame(t(names(tidy_object)),
stringsAsFactors=FALSE)
names(head) <- names(tidy_object)
if (glance_foot)
{
foot <- glance_foot(object,
col_pairs = col_pairs,
total_cols = ncol(tidy_object),
glance_stats = glance_stats,
byrow = byrow) %>%
component_table()
}
else
{
foot <- NULL
}
#* Eventually, by default, glance statistics will be inserted into
#* the 'foot' object. Objects passed as data frames should not have
#* glance statistics by default. Perhaps an option for glance_df should
#* be provided here.
out <- structure(list(head = component_table(head, tidy_object),
body = component_table(tidy_object),
interfoot = NULL,
foot = foot,
border_collapse = border_collapse,
caption = caption,
caption_number = caption_number,
label = label,
justify = justify,
float = float,
longtable = longtable,
table_width = 6,
tabcolsep = tabcolsep,
hhline = hhline,
bookdown = bookdown,
fixed_header = fixed_header,
include_fixed_header_css = FALSE, #Flag for if fixed header CSS
#should be generated with the table
fixed_header_param =
list(
fixed_header_class_name = "pixie-fixed",
scroll_body_height = 300,
scroll_body_height_units = "px",
scroll_body_background_color = "white",
fixed_header_height = 20,
fixed_header_height_units = "px",
fixed_header_text_height = 10,
fixed_header_text_height_units = "px",
fixed_header_background_color = "white"
),
html_preserve = html_preserve,
print_method = pixiedust_print_method()),
class = "dust")
out
}
#' @rdname dust
#' @export
dust.grouped_df <- function(object, ungroup = TRUE, ...)
{
if (ungroup)
{
dust.default(as.data.frame(object), ...)
}
else
{
split_var <- attr(object, "var")
# dplyr 0.8.0 replaces the var attribute with groups attribute
if (is.null(split_var)){
split_var <- utils::head(names(attr(object, "groups")), -1)
}
object <- as.data.frame(object)
object <- split(object, object[, as.character(split_var)])
dust.list(object, ...)
}
}
#' @rdname dust
#' @export
dust.list <- function(object, ...)
{
structure(
lapply(X = object,
FUN = dust,
...),
class = "dust_list"
)
}
#***********************************************************
#* Utilities
component_table <- function(tbl, object)
{
#* Get the classes of each column in the data frame.
#* These will be needed later for the 'round' sprinkle.
if (missing(object)) object <- tbl
Classes <- data.frame(col_name = colnames(object),
col_class = vapply(X = object,
FUN = primaryClass,
FUN.VALUE = character(1)),
stringsAsFactors = FALSE)
#* Initialize the table with row index, column index, and value
tab <- gather_tbl(tbl)
#* Initialize default values of table attributes
tab <-
merge(x = tab,
y = cell_attributes_frame(nrow(tbl), ncol(tbl)),
by = c("row", "col"),
all.x = TRUE,
sort = FALSE)
#* Join with column classes
tab <- merge(x = tab,
y = Classes,
by = "col_name",
all.x = TRUE,
sort = FALSE)
return(tab)
}
#*********************************************
gather_tbl <- function(tbl)
{
tbl_name <- names(tbl)
#* Assign the row indices
tbl[["row"]] <- seq_len(nrow(tbl))
tbl <- stats::reshape(data = as.data.frame(tbl),
direction = "long",
varying = list(names(tbl)[!names(tbl) %in% "row"]))
names(tbl)[names(tbl) %in% "time"] <- "col"
names(tbl)[3] <- "value"
tbl <- tbl[names(tbl)[!names(tbl) %in% "id"]]
tbl$col_name <- factor(tbl$col, labels = tbl_name)
tbl$col <- as.numeric(tbl$col_name)
tbl$col_name <- as.character(tbl$col_name)
tbl$value <- as.character(tbl$value)
tbl
}
#*********************************************
cell_attributes_frame <- function(nrow, ncol)
{
frame <-
expand.grid(row = 1:nrow,
col = 1:ncol,
fn = NA,
round = "",
bold = FALSE,
italic = FALSE,
halign = "",
valign = "",
bg = "",
font_family = "",
font_color = "",
font_size = "",
font_size_units = "",
left_border = "",
right_border = "",
top_border = "",
bottom_border = "",
height = "",
height_units = "",
width = "",
width_units = "",
replace = NA,
rotate_degree = "",
sanitize = FALSE,
sanitize_args = "",
pad = "",
rowspan = 1L,
colspan = 1L,
na_string = NA,
stringsAsFactors=FALSE)
frame[["html_row"]] <- frame[["row"]]
frame[["html_col"]] <- frame[["col"]]
frame[["merge_rowval"]] <- frame[["row"]]
frame[["merge_colval"]] <- frame[["col"]]
frame[["merge"]] <- FALSE
frame
}
primaryClass <- function(x)
{
acceptedClasses <- c("integer", "double", "numeric",
"character", "factor", "logical")
class_vector <- class(x)
class_vector[class_vector %in% acceptedClasses][1]
}
================================================
FILE: R/fixed_header_css.R
================================================
#' @name fixed_header_css
#' @title Generate CSS Code for Fixed Header Tables
#'
#' @description Tables with a fixed header may be generated to permit the
#' headings to remain visible with the data. The CSS is not difficult,
#' but it not-trivial and requires some coordination across a few
#' parts. This functions standardizes the generation of the CSS code
#' using as few elements as possible. Note that there is potential for
#' conflicts with existing CSS in this method.
#'
#' @param scroll_body_height \code{integerish(1)}. Sets the height of the scrollable
#' table body.
#' @param scroll_body_height_units \code{character(1)}. Determines the units for the
#' height of the scrollable table. Defaults to \code{"px"}. Must be one
#' of \code{c("px", "pt", "\%", "em")}.
#' @param scroll_body_background_color \code{character(1)}. The color of the background
#' of the body. Must be a valid color. It defaults to white, which may
#' override CSS settings provided by the user. If this needs to be avoided,
#' you may use the \code{\link{fixed_header_css}} function to assist in
#' generating CSS code to use to define the CSS. See Avoiding CSS Conflicts.
#' @param fixed_header_height \code{integerish(1)}. Sets the height of the header
#' row.
#' @param fixed_header_height_units \code{character(1)}. Determines the units for the
#' height of the header row. Defaults to \code{"px"}. Must be one of
#' \code{c("px", "pt", "\%", "em")}.
#' @param fixed_header_text_height \code{numeric(1)}. Sets the height at which the
#' header text appears. By default it is set to half of the header height.
#' This should be approximately centered, but you may alter this to get the
#' precise look you want.
#' @param fixed_header_text_height_units \code{character(1)}. Determines the units for
#' placing the header text. Defaults to \code{"px"}. Must be one of
#' \code{c("px", "pt", "\%", "em")}.
#' @param fixed_header_background_color \code{character(1)}. Sets the background color for
#' the header row. This defaults to white and may override the user's CSS
#' settings. See Avoiding CSS Conflicts.
#' @param fixed_header_class_name \code{character(1)}. When
#' \code{include_fixed_header_css = FALSE}, this
#' class name is used to reference CSS classes provided by the user to
#' format the table correctly.
#' @param pretty \code{logical(1)}. When \code{TRUE}, the result is printed
#' to the console using \code{cat}, making it easy to copy and paste the
#' code to another document. When \code{FALSE}, it is returned as a
#' character string.
#'
#' @details CSS doesn't make this kind of table natural. The solution to
#' generate the fixed headers used by \code{pixiedust} is probably not the
#' best solution in terms of CSS design. It is, however, the most conducive
#' to generating dynamically on the fly.
#'
#' The fixed header table requires nesting several HTML elements.
#' \enumerate{
#' \item a \code{div} tag is used to control the alignment of the table
#' \item a \code{section} tag is used to set up the header row that remains fixed.
#' \item a \code{div} that sets the height of the scrollable body
#' \item the \code{table} tag establishes the actual table.
#' \item The \code{th} tags inside the table are set to full transparency and
#' the content of the headers is duplicated in a \code{div} within the
#' \code{th} tag to display the content.
#' }
#'
#' To accomplish these tasks, some CSS is exported with the table and placed
#' in the document immediately before the table. Read further to understand
#' the conflicts that may arise if you are using custom CSS specifications
#' in your documents.
#'
#' @section Avoiding CSS Conflicts:
#' Because of all of the shenanigans involved, exporting the CSS with the tables
#' may result in conflicts with your custom CSS. Most importantly, any CSS
#' you have applied to the \code{th} or \code{td} tags may be overwritten.
#' If you are using custom CSS, you may want to consider using
#' \code{include_fixed_header_css = FALSE} and then utilizing
#' \code{\link{fixed_header_css}} to generate CSS you can include in your
#' CSS file to provide the fixed headers. The code generated by
#' \code{fixed_header_css} ought to be placed before your definitions for
#' \code{td} and \code{th}.
#'
#' To get the same header design in the fixed table, you will want to modify
#' the \code{.th-pixie-fixed div} definition in the CSS to match your desired
#' \code{th} definition.
#'
#' The code produced by \code{fixed_header_css} will include comments where
#' there is potential for a CSS conflict.
#'
#' @source Jonas Schubert Erlandsson. https://jsfiddle.net/dPixie/byB9d/3/
#'
#' @section Functional Requirements:
#' \enumerate{
#' \item If \code{pretty = TRUE} print results to the console.
#' \item If \code{pretty = FALSE} Return a character string of length 1.
#' \item Cast an error if \code{scroll_body_height} is not \code{integerish(1)}
#' \item Cast an error if \code{scroll_body_height_units} is not \code{character(1)}
#' \item Cast an error if \code{scroll_body_background_color} is not \code{character(1)}
#' \item Cast an error if \code{scroll_body_background_color} is not a valid color.
#' \item Cast an error if \code{fixed_header_height} is not \code{integerish(1)}
#' \item Cast an error if \code{fixed_header_height_units} is not \code{character(1)}
#' \item Cast an error if \code{fixed_header_text_height} is not \code{numeric(1)}
#' \item Cast an error if \code{fixed_header_text_height_units} is not \code{character(1)}
#' \item Cast an error if \code{fixed_header_background_color} is not \code{character(1)}
#' \item Cast an error if \code{fixed_header_background_color} is not a valid color.
#' \item Cast an error if \code{pretty} is not \code{logical(1)}
#' }
#'
#' @export
fixed_header_css <- function(fixed_header_class_name = "pixie-fixed",
scroll_body_height = 300,
scroll_body_height_units = "px",
scroll_body_background_color = "white",
fixed_header_height = 20,
fixed_header_height_units = "px",
fixed_header_text_height = fixed_header_height / 2,
fixed_header_text_height_units = "px",
fixed_header_background_color = "white",
pretty = TRUE)
{
coll <- checkmate::makeAssertCollection()
checkmate::assert_integerish(x = scroll_body_height,
len = 1,
add = coll)
checkmate::assert_character(x = scroll_body_height_units,
len = 1,
add = coll)
checkmate::assert_character(x = scroll_body_background_color,
len = 1,
add = coll)
if (!any(is_valid_color(scroll_body_background_color))){
coll$push("'scroll_body_background_color' is not a valid color")
}
checkmate::assert_integerish(x = fixed_header_height,
len = 1,
add = coll)
checkmate::assert_character(x = fixed_header_height_units,
len = 1,
add = coll)
checkmate::assert_numeric(x = fixed_header_text_height,
len = 1,
add = coll)
checkmate::assert_character(x = fixed_header_text_height_units,
len = 1,
add = coll)
checkmate::assert_character(x = fixed_header_background_color,
len = 1,
add = coll)
if (!any(is_valid_color(fixed_header_background_color))){
coll$push("'fixed_header_background_color' is not a valid color")
}
checkmate::assert_character(x = fixed_header_class_name,
len = 1,
add = coll)
checkmate::assert_logical(x = pretty,
len = 1,
add = coll)
checkmate::reportAssertions(coll)
css <-
paste0("<style>
.", fixed_header_class_name, "-section {
position: relative;
display: inline-block;
padding-top: ", fixed_header_height, fixed_header_height_units,";
background:", fixed_header_background_color, "; <!-- need a color to make the header non-transparent -->
<!-- This is a potential CSS conflict -->
}
.", fixed_header_class_name, "-container {
overflow-y: auto;
height: ", scroll_body_height, scroll_body_height_units, "; <!-- Sets the height of the scrollable table -->
}
.th-", fixed_header_class_name, "{
line-height: 0;
color: transparent; <!-- hide text of the header-->
}
.th-", fixed_header_class_name, " div{
position: absolute;
top: ", fixed_header_text_height, fixed_header_text_height_units, ";
color: black; <!-- the extra div makes the displayable header -->
<!-- This is a potential source of CSS Conflict -->
}
th:first-child div{
border: none;
}
td, th {
background:white; <!-- Set the default background of the table to white.
This can be overruled in the individual cells
This is a potential source of CSS conflict -->
}
</style>")
if (pretty) cat(css)
else css
}
================================================
FILE: R/gaze.R
================================================
#' @name gaze
#' @title Mimic Stargazer Output to Display Multiple Models
#'
#' @description Tidy multiple models and display coefficients and
#' test statistics in a side-by-side format.
#'
#' @param ... models to be tidied. Arguments may be named or unnamed.
#' For named arguments, the model will be identfied by the argument
#' name; for unnamed arguments, the object name will be the identifier.
#' @param include_glance \code{logical(1)} Determines if \code{glance} (fit)
#' statistics are displayed under the models.
#' @param glance_vars \code{character}. A vector of statistics returned by
#' \code{glance} that are to be displayed for each model. Defaults are
#' subject to change in future versions.
#' @param digits \code{numeric(1)} The number of digits used for rounding.
#'
#' @details This function is still in development. Significant stars
#' will be added in a future version. Note that function defaults may
#' be subject to change.
#'
#' @section Functional Requirements:
#' \enumerate{
#' \item Return a data frame object
#' \item Cast an error if \code{include_glance} is not \code{logical(1)}
#' \item Cast an error if \code{glance_vars} is not a \code{character}
#' vector.
#' \item Cast an error if \code{digits} is not \code{"integerish(1)"}.
#' }
#'
#' @examples
#' fit1 <- lm(mpg ~ qsec + am + wt + gear + factor(vs), data = mtcars)
#' fit2 <- lm(mpg ~ am + wt + gear + factor(vs), data = mtcars)
#'
#' gaze(fit1, fit2)
#' gaze(with_qsec = fit1,
#' without_qsec = fit2)
#' gaze(fit1, fit2, include_glance = FALSE)
#' gaze(fit1, fit2, glance_vars = c("AIC", "BIC"))
#'
#' @export
gaze <- function(..., include_glance = TRUE,
glance_vars = c("adj.r.squared", "sigma", "AIC"),
digits = 3){
coll <- checkmate::makeAssertCollection()
checkmate::assert_logical(x = include_glance,
len = 1,
add = coll)
checkmate::assert_character(x = glance_vars,
add = coll)
checkmate::assert_integerish(x = digits,
len = 1,
add = coll)
checkmate::reportAssertions(coll)
fits <- list(...)
if (is.null(names(fits))) names(fits) <- character(length(fits))
# If a fit isn't named, use the object name
dots <- match.call(expand.dots = FALSE)$...
fit_names <- vapply(dots, deparse, character(1))
names(fits)[names(fits) == ""] <- fit_names[names(fits) == ""]
res <- prep_gaze_tidy(fits, names(fits), digits)
if (include_glance){
res <- rbind(res,
prep_gaze_glance(fits, names(fits), glance_vars, digits))
}
res
}
# UNEXPORTED METHODS ------------------------------------------------
prep_gaze_tidy <- function(fits, fit_names, digits){
res <-
mapply(
FUN =
function(fit, name)
{
data.frame(model = name,
broom::tidy(fit),
stringsAsFactors = FALSE)
},
fit = fits,
name = fit_names,
SIMPLIFY = FALSE
)
res <- do.call("rbind", res)
res <- res[c("model", "term", "estimate", "statistic")]
res[["term"]] <- factor(res[["term"]],
levels = unique(res[["term"]]))
res <-
stats::reshape(
data = res,
direction = "long",
varying = list(value = c("estimate", "statistic")),
v.names = "value",
timevar = "variable",
times = c("estimate", "statistic")
)
rownames(res) <- NULL
res[["value"]] <- round(res[["value"]], digits)
statistic_row <- res[["variable"]] == "statistic"
res[["value"]][statistic_row] <-
sprintf("(%s)",
res[["value"]][statistic_row])
res <-
stats::reshape(
data = res[!names(res) %in% "id"],
direction = "wide",
v.names = "value",
idvar = c("term", "variable"),
timevar = c("model"))
res <- res[order(res[["term"]], res[["variable"]]), ]
names(res) <- sub("^value\\.", "", names(res))
res[!names(res) %in% "variable"]
}
prep_gaze_glance <- function(fits, fit_names, glance_vars, digits){
res <-
mapply(
FUN =
function(fit, name)
{
data.frame(model = name,
broom::glance(fit),
stringsAsFactors = FALSE)
},
fit = fits,
name = fit_names,
SIMPLIFY = FALSE
)
res <- do.call("rbind", res)
res <- res[c("model", glance_vars)]
res <-
stats::reshape(
data = res,
direction = "long",
times = glance_vars,
varying = list(value = glance_vars)
)
names(res)[2:3] <- c("term", "value")
res[["value"]] <- round(res[["value"]], digits)
res <-
stats::reshape(
data = res[!names(res) %in% "id"],
direction = "wide",
v.names = "value",
idvar = c("term"),
timevar = c("model"))
names(res) <- sub("^value\\.", "", names(res))
rownames(res) <- NULL
res
}
================================================
FILE: R/get_dust_part.R
================================================
#' @name get_dust_part
#' @title Get a Portion of the Table Stored in a \code{dust} Object
# Documentation -----------------------------------------------------
#' @description Making customized table headers and footers requires a
#' data frame be added to the \code{dust} object that has the same
#' column dimension as the rest of the table. In order to reduce the
#' inconvenience of counting columns, \code{get_dust_part} extracts the
#' data frame portion currently in use. This ensures the column dimension
#' is correct with the current values, and provides an object suitable
#' for editing.
#'
#' @param x An object of class \code{dust}
#' @param part \code{character(1)}, naming the part of the table to
#' retrieve. May be one of \code{"head"}, \code{"foot"}, \code{"interfoot"},
#' or \code{"body"}.
#'
#' @return an object of class \code{data.frame}
#'
#' @section Functional Requirements:
#' \enumerate{
#' \item Return, as a data frame, the part of the table requested in \code{part}
#' \item Cast an error if \code{x} is not a \code{dust} object.
#' \item Cast an error if \code{part} is not one of \code{c("head", "foot",
#' "interfoot", "body")}
#' }
#'
#' @export
# Function Definition -----------------------------------------------
get_dust_part <- function(x, part = c("head", "foot", "interfoot", "body"))
{
# Argument Validations ----------------------------------------------
coll <- checkmate::makeAssertCollection()
checkmate::assert_class(x = x,
classes = "dust",
add = coll)
part <-
checkmate::matchArg(x = part,
choices = c("head", "foot", "interfoot", "body"),
add = coll)
checkmate::reportAssertions(coll)
# Functional Code ---------------------------------------------------
if (!is.null(x[[part]]))
{
X <- x[[part]][c("row", "col", "value")]
X <- stats::reshape(X,
direction = "wide",
timevar = "col",
idvar = "row")
X <- X[-1]
names(X) <- unique(x[[part]][["col_name"]])
}
else
{
col_names <- unique(x[["body"]][["col_name"]])
X <- matrix(nrow=0,
ncol=length(col_names))
X <- data.frame(X)
names(X) <- col_names
}
X
}
================================================
FILE: R/glance_foot.R
================================================
#' @name glance_foot
#'
#' @title Prepare Glance Statistics for \code{pixiedust} Table Footer
#' @description Retrieves the \code{broom::glance} output for a model object and
#' structures it into a table suitable to be placed in the footer. By default,
#' the statistics are displayed in two column-pairings (see Details). This
#' function is not exported but is documented to maintain clarity of its
#' behavior. It is intended for use within \code{dust}, but may be useful
#' elsewhere if used with caution.
#'
#' @param fit A model object with a \code{broom::glance} method.
#' @param col_pairs An integer indicating the number of column-pairings for the
#' glance output. This must be less than half the total number of columns,
#' as each column-pairing includes a statistic name and value.
#' @param total_cols The total number of columns in the body of the pixiedust table
#' @param glance_stats A character vector giving the names of the glance statistics
#' to put in the output. When \code{NULL}, the default, all of the available
#' statistics are retrieved. In addition to controlling which statistics are
#' printed, this also controls the order in which they are printed.
#' @param byrow A logical, defaulting to \code{FALSE}, that indicates if the
#' requested statistics are placed with priority to rows or columns. See Details.
#'
#' @details Statistics are placed in column-pairings. Each column pair consists of
#' two columns named \code{stat_name_x} and \code{stat_value_x}, where \code{x} is
#' the integer index of the column pair. The column-pairings are used to allow
#' the user to further customize the output, more-so than pasting the name and
#' value together would allow. With this design, statistics can be rounded
#' differently by applying sprinkles to the resulting table.
#'
#' The total number of column-pairings must be less than or equal to half the
#' number of total columns. This constraint prevents making glance tables that
#' have more columns than the model table it accompanies.
#'
#' When the total number of column-parings is strictly less than half the total
#' number of columns, "filler" columns are placed between the column pairings.
#' As much as possible, the filler columns are placed evenly between the
#' column pairings, but when the number of filler columns is unequal between
#' column-pairings, there will be more space placed on the left side. For example,
#' if a table has 7 columns and 3 column-pairings, the order of placement would be
#' column-pair-1, filler, column-pair-2, column-pair-3. Since there was only room
#' for one column of filler, it was placed in the left most fill position.
#'
#' The \code{byrow} arguments acts similarly to the \code{byrow} argument in the
#' \code{matrix} function, but defaults to \code{FALSE}. If four statistics are
#' requested and \code{byrow = FALSE}, the left column-pair will have statistics
#' one and two, while the right column-pair will have statistics three and four.
#' If \code{byrow = TRUE}, however, the left column-pair will have statistics
#' one and three, while the right column-pair will have statistics two and four.
#'
#' @author Benjamin Nutter
#'
glance_foot <- function(fit, col_pairs, total_cols,
glance_stats = NULL, byrow = FALSE){
#* col_pairs is less then half of total_cols
#* glance_stats are all found in names(tidy(fit))
g <- broom::glance(fit)
coll <- checkmate::makeAssertCollection()
if (col_pairs > total_cols/2)
{
coll$push("'col_pairs' must be less than 'total_cols/2'")
}
if (is.null(glance_stats))
glance_stats <- names(g)
else
{
invalid_stats <- glance_stats[!glance_stats %in% names(g)]
glance_stats <- glance_stats[glance_stats %in% names(g)]
if (length(invalid_stats) > 0)
{
warning("The following statistics were requested but are not ",
"available for models of class ",
paste0(class(fit), collapse = "; "), ":",
"\n ", paste0(invalid_stats, collapse = ", "))
}
if (length(glance_stats) == 0)
{
coll$push(
sprintf("None of the statistics requested are available for models of class %s",
paste0(class(fit), collapse = "; "))
)
}
}
checkmate::reportAssertions(coll)
g <- data.frame(.rownames = names(g[glance_stats]),
unrowname.x. = unname(unlist(g[glance_stats][1, ])),
stringsAsFactors = FALSE)
# return(g)
if (nrow(g) %% col_pairs > 0){
n_fill <- (col_pairs - nrow(g) %% col_pairs)
stat_fill <- data.frame(.rownames = rep("", n_fill),
x = rep(NA, n_fill),
stringsAsFactors = FALSE)
g <- .rbind_internal(g, stat_fill)
}
g$col <-
if (byrow) rep(1:col_pairs, length.out = nrow(g))
else rep(1:col_pairs, each = nrow(g) / col_pairs)
g$col <- factor(g$col)
fill_cols <- total_cols - (col_pairs * 2)
fill_gaps <- col_pairs - 1
cols_per_gap <- ceiling(fill_cols / fill_gaps)
total_fills <- fill_gaps * cols_per_gap
fills_per_gap_times <- fill_cols %/% cols_per_gap
if (!is.finite(fills_per_gap_times)) fills_per_gap_times <- 0
fills_per_gap <-
c(rep(cols_per_gap, fills_per_gap_times),
fill_cols %% cols_per_gap)
fills_per_gap <- fills_per_gap[fills_per_gap > 0]
Filler <- lapply(fills_per_gap,
build_fill,
rows = nrow(g) / col_pairs)
G <- split(g, g$col)
if (length(Filler) < length(G))
Filler <- c(Filler, lapply(1:(length(G) - length(Filler)),
function(i) NULL))
G <- mapply(intersplice_fill,
G,
Filler,
SIMPLIFY = FALSE)
G <- do.call("cbind", G)
names(G) <- make.unique(names(G))
G
}
build_fill <- function(fills_per_gap, rows){
if (is.na(fills_per_gap)) return(NULL)
Fills <- lapply(1:fills_per_gap,
function(f)
data.frame(fill = rep("", rows),
stringsAsFactors = FALSE))
do.call("cbind", Fills)
}
intersplice_fill <- function(G, Fill){
if (!is.null(Fill)) return(cbind(G[1:2], Fill))
else return(G[1:2])
}
================================================
FILE: R/index_to_sprinkle.R
================================================
#' @name index_to_sprinkle
#' @title Determine the Indices to Sprinkle
#'
#' @description The sprinkle methods accept the rows and columns that are
#' to be modified as matrix coordinates. The \code{dust} object stores
#' the table data in a long form. The tabular coordinates are translated
#' into row indices using this function.
#'
#' @param x An object of class \code{dust}.
#' @param rows Either a numeric vector of rows in the tabular object to be
#' modified or an object of class \code{call}. When a \code{call},
#' generated by \code{quote(expression)}, the expression resolves to
#' a logical vector the same length as the number of rows in the table.
#' Sprinkles are applied to where the expression resolves to \code{TRUE}.
#' @param cols Either a numeric vector of columns in the tabular object to
#' be modified, or a character vector of column names. A mixture of
#' character and numeric indices is permissible.
#' @param fixed \code{logical(1)} indicating if the values in \code{rows} and
#' \code{cols} should be read as fixed coordinate pairs. See Details.
#' @param part \code{character} string. Specifies if the sprinkles are
#' being applied to the head, body, foot, or interfoot of the table. Partial
#' matching is supported.
#' @param recycle \code{character} string. Indicates how recycling is to be
#' performed. Partial matching is supported. See Details.
#' @param coll An optional \code{AssertCollection} object. When \code{NULL},
#' an \code{AssertCollection} object will be created and reported within
#' the call to this function. When not \code{NULL}, any failed assertions
#' will be added to the object in reported in the function that called
#' \code{index_to_sprinkle}.
#'
#' @details When \code{fixed = FALSE}, sprinkles are applied at the
#' intersection of \code{rows} and \code{cols}, meaning that the arguments
#' do not have to share the same length. When \code{fixed = TRUE}, they must
#' share the same length.
#'
#' The value of \code{recycle} determines how sprinkles are
#' managed when the sprinkle input doesn't match the length of the region
#' to be sprinkled. By default, recycling is turned off. Recycling
#' may be performed across rows first (left to right, top to bottom),
#' or down columns first (top to bottom, left to right). \code{"cols"}
#' and \code{"columns"} have the same effect. The two choices to specify
#' are motivated by the fact that I sometimes get confused about which
#' it should be. :)
#'
#' @author Benjamin Nutter
#'
#' @seealso \code{sprinkle}
#'
#' @section Functional Requirements:
#' \enumerate{
#' \item Return the indices of the intersection of \code{rows} and \code{cols}
#' \item If \code{rows = NULL}, assume all rows.
#' \item If \code{rows} is an expression where no values resolve to
#' \code{TRUE}, return \code{x} unchanged.
#' \item If any value in \code{rows} is not a valid row in the table,
#' cast an error.
#' \item If \code{cols = NULL}, assume all columns.
#' \item If any value in \code{cols} does not identify a column in the table,
#' cast an error.
#' \item If \code{fixed = TRUE}, \code{length(rows)} (or \code{sum(rows),
#' if an expression}) and \code{cols} must have the same length.
#' \item Cast an error if \code{fixed} is not a \code{logical(1)}
#' \item Cast an error if \code{part} is not one of \code{"body"},
#' \code{"head"}, \code{"foot"}, or \code{"interfoot"}.
#' }
#'
index_to_sprinkle <- function(x, rows = NULL, cols = NULL, fixed = FALSE,
part = c("body", "head", "foot", "interfoot"),
recycle = c("none", "rows", "cols", "columns"),
coll = NULL)
{
report_here <- is.null(coll)
if (report_here) coll <- checkmate::makeAssertCollection()
# First pass at argument validation ---------------------------------
# The first pass validates the arguments are of the correct type.
# The second pass will validate characteristics that depend on
# the types being correct.
checkmate::assert_class(x = x,
classes = "dust",
add = coll,
.var.name = "x")
if (!is.null(rows))
{
if (!is.numeric(rows) & !is.call(rows))
{
coll$push("`rows` must be either numeric or a call object (via `quote`)")
}
}
if (!is.null(cols))
{
if (!is.numeric(cols) & !is.character(cols))
{
coll$push("`cols` must be a numeric or character vector")
}
}
checkmate::assert_logical(x = fixed,
len = 1,
add = coll,
.var.name = "fixed")
part <-
checkmate::matchArg(x = part,
choices = c("body", "head", "foot",
"interfoot", "table"),
add = coll,
.var.name = "part")
recycle <-
checkmate::matchArg(x = recycle,
choices = c("none", "rows", "cols", "columns"),
add = coll,
.var.name = "recycle")
if (report_here) checkmate::reportAssertions(coll)
else if (!length(part) |
!length(recycle) |
!checkmate::test_logical(x = fixed,
len = 1))
{
# If there is no match for `part`, there is no need to proceed to
# the rest of the function. If this function is called from
# another with a `coll` object, return to that function's execution
# and report the error there.
return(invisible(NULL))
}
# Second pass at argument validations -------------------------------
if (fixed)
{
if (length(rows) != length(cols))
{
coll$push("When `fixed = TRUE`, rows and cols must have the same length")
}
}
if (is.null(rows)) rows <- unique(x[[part]][["row"]])
if (inherits(rows, "class"))
{
rows <- which(eval(rows))
}
invalid_row <- which(!rows %in% unique(x[[part]][["row"]]))
if (length(invalid_row))
{
coll$push(sprintf("The following rows given are not valid row indices: %s",
paste0(rows[invalid_row], collapse = ", ")))
}
if (is.null(cols))
{
cols <- unique(x[[part]][["col"]])
}
else
{
# The cols argument allows character and numeric values to be
# given simultaneously. This block matches the character values
# to numeric column indices
cols_num <- suppressWarnings(as.numeric(cols))
cols_num <- cols_num[!is.na(cols_num)]
cols_str <- match(cols,
unique(x[["head"]][["col_name"]]))
# We don't want to restrict ourselves to just the unique
# columns if we are doing fixed coordinate pairs
if (!fixed) cols <- unique(c(cols_num, cols_str))
cols <- cols[!is.na(cols)]
}
invalid_col <- which(!cols %in% unique(x[[part]][["col"]]))
if (length(invalid_col))
{
coll$push(sprintf("The following columns given are not valid columns: %s",
paste0(cols[invalid_col], collapse = ", ")))
}
if (report_here) checkmate::reportAssertions(coll)
# There's no point in continuing if there are any errors by now
# We return a full vector of indices just to maintain the same input.
if (!coll$isEmpty()) return(1)
# Functional Code ---------------------------------------------------
# Determine the index order for recycling
if (recycle == "columns")
{
recycle <- "cols"
}
recycle_arrange <-
if (recycle == "rows")
{
c("row", "col")
}
else
{
c("col", "row")
}
# Determine and arrange the indices
if (!fixed)
{
indices <- expand.grid(rows = rows,
cols = cols)
indices$i <- rep(TRUE, nrow(indices))
indices <- merge(x[[part]][c("row", "col")],
indices,
by.x = c("col", "row"),
by.y = c("cols", "rows"),
all.x = TRUE)
indices[["index"]] <- seq_len(nrow(indices))
indices <- indices[do.call("order", indices[recycle_arrange]), ]
indices[["i"]][is.na(indices[["i"]])] <- FALSE
indices <- indices[["index"]][indices[["i"]]]
}
else
{
indices <-
which(x[[part]][["row"]] %in% rows &
x[[part]][["col"]] %in% cols)
}
indices
}
================================================
FILE: R/is_valid_color.R
================================================
#' @name is_valid_color
#' @title Test a Character String For Pixiedust Recognized Color Format
#'
#' @description \code{pixiedust} recognizes colors as dvips names,
#' \code{rgb(R,G,B)}, \code{rgba(R,G,B,A)}, \code{#RRGGBB}, or
#' \code{#RRGGBBAA}. This code returns a logical indicating if
#' the given character strings are valid.
#'
#' @param color A character vector of color names.
#'
#' @section Functional Requirements:
#' \enumerate{
#' \item Returns a logical vector correctly identifying valid color formats.
#' \item Casts an error if \code{color} is not a character object.
#' }
#'
#' @export
is_valid_color <- function(color){
checkmate::assert_character(x = color)
vapply(X = color,
FUN = is_valid_color_single,
FUN.VALUE = logical(1),
USE.NAMES = FALSE)
}
#' @rdname is_valid_color
#' @export
is_valid_color_single <- function(color)
{
checkmate::assert_character(x = color,
len = 1)
color <- tolower(color)
color <- gsub("\\s", "", color)
regex_0_255 <- "\\b([0-9]|[0-9][0-9]|0[0-9][0-9]|1[0-9][0-9]|2[0-4][0-9]|25[0-5])\\b"
regex_0_1 <- ",((\\.\\d+)?|0(\\.\\d+)?|1(\\.0+)?)[)]$"
regex_rgb <- sprintf("^rgb[(]%s[)]$",
paste0(rep(regex_0_255, 3), collapse = ","))
regex_rgba <- sprintf("^rgba[(]%s%s$",
paste0(rep(regex_0_255, 3), collapse = ","),
regex_0_1)
regex_html <- "^#[a-f0-9]{6}$"
regex_html_alpha <- "^#[a-f0-9]{8}$"
grepl(regex_rgb, color) | grepl(regex_rgba, color) |
grepl(regex_html, color) | grepl(regex_html_alpha, color) |
color %in% c(grDevices::colors(), "transparent")
}
================================================
FILE: R/knit_print.dust.R
================================================
#' @name knit_print.dust
#' @title \code{knitr} Printing Function
#'
#' @description Custom printing functions for displaying \code{dust} and
#' \code{dust_list} objects in R Markdown documents.
#'
#' @param x A dust object
#' @param options A list of options received from the chunk options.
#' @param ... Additional arguments to pass to other methods.
#'
#' @importFrom knitr knit_print
#' @method knit_print dust
#' @export
knit_print.dust <- function(x, options, ...){
if (missing(options)) options <- list()
print.dust(x,
...,
asis = TRUE,
interactive = is.null(options$results))
}
#' @rdname knit_print.dust
#' @method knit_print dust_list
#' @export
knit_print.dust_list <- function(x, options, ...){
if (missing(options)) options <- list()
print.dust_list(x,
...,
asis = TRUE,
interactive = is.null(options$results))
}
================================================
FILE: R/medley.R
================================================
#' @name medley
#'
#' @title Sprinkle Medleys
#' @description \code{pixiedust} can get to be pretty verbose if you are doing
#' a great deal of customization. Sprinkle medleys can take out some of that
#' code by bundling much of the formatting sprinkling into a single function.
#'
#' \code{pixiedust} comes with a couple very basic medleys that are mostly
#' for illustration of how to write medleys. Once you get the hang of
#' sprinkling, you need only bundle your most common sprinkles into a
#' medley function of your own and cut down on some of the time
#' coding your most basic formatting.
#'
#' @param x a \code{dust} object.
#' @param round A numerical value passed to the \code{round} sprinkle.
#'
#' @author Benjamin Nutter
#'
#' @examples
#' \dontrun{
#' fit <- lm(mpg ~ qsec + factor(am) + wt * factor(gear), data = mtcars)
#'
#' dust(fit) %>%
#' medley_bw() %>%
#' sprinkle_print_method("html")
#'
#' dust(fit, glance_foot = TRUE) %>%
#' medley_model() %>%
#' sprinkle_print_method("html")
#'
#' # Medleys are not generics and do not have methods.
#' # Using a medley on a dust_list object requires pixieply
#'
#' library(dplyr)
#' mtcars %>%
#' group_by(gear) %>%
#' dust(ungroup = FALSE) %>%
#' pixieply(medley_bw) %>%
#' sprinkle_print_method("html")
#' }
#'
#' @export
medley_bw <- function(x){
x %>%
sprinkle(rows = 1, border = "top", part = "head") %>%
sprinkle(rows = 1, border = "top", part = "body") %>%
sprinkle(rows = max(x$body$row), border = "bottom", part = "body")
}
#' @rdname medley
#' @export
medley_model <- function(x, round = 2){
not_pval <- unique(x$body$col_name)
not_pval <- not_pval[!not_pval %in% "p.value"]
x <- x %>%
#* Borders
sprinkle(rows = 1, border = "top", part = "head") %>%
sprinkle(rows = 1, border = "top", part = "body") %>%
sprinkle(rows = max(x$body$row), border = "bottom", part = "body") %>%
#* Rounding
sprinkle(cols = not_pval, round = round, part = "body") %>%
sprinkle(cols = "p.value", fn = quote(pvalString(value)))
if (!is.null(x$foot)){
x <- x %>%
sprinkle(rows = max(x$foot$row), border = "bottom", part = "foot") %>%
sprinkle(round = round, na_string = "", part = "foot")
}
x
}
================================================
FILE: R/medley_all_borders.R
================================================
#' @name medley_all_borders
#' @title Apply Cell Borders to All Cells in a Region
#'
#' @description For most output, specifying a region of cells with borders
#' on all sides is as simple as giving the sprinkle \code{border = "all"}.
#' In LaTeX output, however, this can result in thicker than expected
#' vertical borders. This medley provides a LaTeX save approach to
#' drawing borders on all sides without getting the double vertical
#' border effect.
#'
#' @param x An object of class dust
#' @param rows The rows over which the borders are to be drawn.
#' @param cols The cols over which the borders are to be drawn.
#' @param horizontal Logical. Toggles horizontal borders.
#' @param vertical Logical. Toggles vertical borders
#' @param part A character vector. May contain any of \code{"body",
#' "head", "interfoot", "foot", "table"}. When any element is
#' \code{"table"}, the borders are drawn in all parts of the table.
#'
#' @author Benjamin Nutter
#'
#' @export
medley_all_borders <- function(x, rows=NULL, cols=NULL,
horizontal = TRUE, vertical = TRUE,
part = "body")
{
checkmate::assertClass(x,
classes = "dust")
part <- part <-
match.arg(part,
c("table", "head", "body", "interfoot", "foot"),
several.ok = TRUE)
if ("table" %in% part)
{
part <- c("head", "body", "interfoot", "foot")
}
for (p in part)
{
if (!is.null(x[[p]]))
{
part_rows <- if (is.null(rows)) 1:max(x[[p]][["row"]]) else rows
part_cols <- if (is.null(cols)) 1:max(x[[p]][["col"]]) else cols
x <- sprinkle(x,
rows = part_rows,
cols = part_cols,
border = c(if (vertical) "left" else NULL,
if (horizontal) "bottom" else NULL),
part = p)
if (horizontal)
{
x <- sprinkle(x,
rows = utils::head(part_rows, 1),
cols = part_cols,
border = "top",
part = p)
}
if (vertical)
{
x <- sprinkle(x,
rows = part_rows,
cols = utils::tail(part_cols, 1),
border = "right",
part = p)
}
}
}
x
}
================================================
FILE: R/perform_function.R
================================================
#* perform_function
#* An internal function for dustpan
#* applies the requested function.
#* Applying the function wasn't really straight forward because
#* in dustpan$obj, all of the values are stored as
#* character strings. Handling the conversions has to
#* be done with care to get things to format correctly
perform_function <- function(obj)
{
#* Determine which cells in the table have a function assigned.
have_fn <- which(!is.na(obj$fn))
for (i in have_fn){
#* All of the elements in 'value' are stored as character
#* strings. The if clause allows numeric functions to be
#* performed.
if (obj$col_class[i] %in% c("double", "numeric", "integer"))
value <- do.call(sprintf("as.%s", obj$col_class[i]),
list(obj$value[i]))
#* The else statement allows functions to act on character strings.
else value <- obj$value[i]
res <- eval(parse(text = obj$fn[i]))
obj$value[i] <- res
obj$col_class[i] <- primaryClass(res)
}
obj
}
#*** roundSafe
#* An internal function to perform rounding on dust objects.
#* All values in a dust object are stored as character values, but some may
#* represent numeric values. The roundSafe function will skip true character
#* values when attempting to round.
roundSafe <- function(x, digits){
y <- suppressWarnings(as.numeric(x))
if (length(y[!is.na(y)]) == 0) return(x)
y[!is.na(y)] <- round(y[!is.na(y)], digits[!is.na(y)])
x[!is.na(y)] <- y[!is.na(y)]
x
}
================================================
FILE: R/pixie_count.R
================================================
#' @name pixie_count
#' @title Access and manipulate table numbers counters
#'
#' @description While LaTeX provides the ability to automatically number tables, this
#' functionality is not readily available with console, HTML, or Word output. By
#' keep track of the number of (captioned) tables, we can mimic the behavior of
#' LaTeX tables to provide (mostly) consistent table numbering between formats. The
#' table numbering is stored in the \code{pixie_count} option.
#'
#' @param value The value at which to set the pixie counter.
#' @param increment The value to add to the current pixie count. Defaults to 1.
#'
#' @details The pixie count is stored in the options and may also be accessed using
#' \code{getOption("pixie_count")}.
#'
#' \code{get_pixie_count} returns the current value of the counter.
#'
#' \code{set_pixie_count} sets the value to the user-specification.
#'
#' \code{increment_pixie_count} increments the pixie count, usually by 1. This is called
#' within \code{print.dust} any time a \code{dust} object has a caption.
#'
#' @author Benjamin Nutter
#'
#' @source
#' The concept for these functions is loosely based on a hook meant to work with
#' \code{knitr} to automatically number tables.
#' http://stackoverflow.com/a/18672268/1017276
#'
#' @export
get_pixie_count <- function()
{
getOption("pixie_count")
}
#' @rdname pixie_count
#' @export
set_pixie_count <- function(value)
{
checkmate::assertIntegerish(value)
options(pixie_count = as.integer(value))
}
#' @rdname pixie_count
#' @export
increment_pixie_count <- function(increment = 1)
{
checkmate::assertIntegerish(increment)
options(pixie_count = getOption("pixie_count") + as.integer(increment))
}
================================================
FILE: R/pixiedust-pkg.R
================================================
#' Tables So Beautifully Fine-Tuned You Will Believe It's Magic.
#'
#' The \code{pixiedust} mission is to provide a user friendly
#' and flexible interface by which report-quality tables may
#' be rendered in multiple output formats. Initially,
#' \code{pixiedust} will support markdown, HTML, and LaTeX
#' formats, as well as methods for console output.
#'
#' The advantage of \code{pixiedust} is that it gives you the
#' control to alter the appearance of a table by as little
#' as one cell at a time. This fine-tuned control gives you
#' enormous flexibility in how the final table looks with
#' minimal pre and post processing.
#'
#' Additionally, \code{pixiedust} is largely built on top
#' of the \code{broom} package, allowing for simple and
#' fast generation of tables based on analytical results.
#'
#' The chief disadvantage of \code{pixiedust} is that it
#' can be extremely verbose. If you are applying many
#' customizations, you will find yourself writing a
#' great deal of code.
#'
#' @section Options:
#'
#' \code{pixie_bookdown} determines if references and labels are
#' managed using the \code{bookdown} package methods. This should be set
#' to \code{TRUE} if you are rendering documents via the \code{bookdown}
#' package.
#'
#' \code{border_collapse} determines the settings for border styles in HTML
#' tables. The most common values are \code{"collapse"} - which presses all
#' of the borders between cells on top of each other - and \code{"separate"} -
#' which allows each cell to have its own, distinct border.
#'
#' \code{pixie_count} is used to manage table numbering in non-LaTeX tables.
#' See \code{\link{set_pixie_count}} for methods to manipulate the numbering.
#'
#' \code{pixie_discrete_pal } controls the colors for shading by discrete values.
#'
#' \code{pixie_float} determines if tables in LaTeX output are placed in
#' floating environments.
#'
#' \code{pixie_gradient_pal} controls the colors giving the
#' endpoints of the color scale on which to shade numeric values.
#'
#' \code{pixie_hhline} determins if tables in LaTeX output use the
#' \code{hhline} package for constructing table cells.
#'
#' \code{pixie_html_linebreak} controls the number of line breaks placed
#' after a table in HTML output.
#'
#' \code{pixie_interactive} Allows control over whether HTML and markdown
#' tables are printed to the viewer or to the document.
#'
#' \code{pixie_justify} controls the positioning of the complete table in the
#' document. Note that \code{"none"} renders the table to the left side of
#' the page, and subsequent elements will appear below the table. When using
#' \code{"left"}, subsequent elements will appear to the right of the table.
#' When using \code{"right"}, subsequent elements will appear to the left of
#' the table.
#'
#' \code{pixie_longtable} determines if the \code{longtable} environment is
#' used in LaTeX output.
#'
#' \code{pixie_na_string} sets the default character set for replacing
#' \code{NA} values in tables.
#'
#' \code{pixie_tabcolsep} determines the spacing placed between cells in
#' LaTeX output.
#'
#' \code{pixiedust_print_method} Sets the default printing method for tables.
#' When \code{pixiedust} is being used with \code{knitr} and \code{rmarkdown},
#' the default is the value of \code{knitr::opts_knit$get("rmarkdown.pandoc.to")},
#' otherwise it is \code{"console"}
#'
#' @section Table-Valued Options:
#' \tabular{lll}{
#' Option Name \tab Default \tab Permissible Values \cr
#' \code{pixie_bookdown} \tab \code{FALSE} \tab \code{logical} \cr
#' \code{pixie_border_collapse} \tab \code{"collapse"} \tab \code{collapse, separate, initial, inherit} \cr
#' \code{pixie_count} \tab 0 \tab \code{integer} like value \cr
#' \code{pixie_float} \tab \code{TRUE} \tab \code{logical} \cr
#' \code{pixie_hhline} \tab \code{FALSE} \tab \code{logical} \cr
#' \code{pixie_html_linebreak} \tab 2 \tab \code{integer} like value \cr
#' \code{pixie_justify} \tab \code{"center"} \tab \code{center, none, left, right} \cr
#' \code{pixie_longtable} \tab \code{FALSE} \tab \code{logical} \cr
#' \code{pixie_tabcolsep} \tab 6 \tab \code{integer} like value \cr
#' \code{pixiedust_print_method} \tab \tab \code{console, html, latex, markdown, beamer}
#' }
#'
#'
#' @section Cell-Valued Options:
#' \tabular{lll}{
#' Option Name \tab Default \tab Permissible Values \cr
#' \code{pixie_discrete_pal} \tab \code{scales::hue_pal()} \tab \code{character} of valid colors \cr
#' \code{pixie_gradient_pal} \tab \code{c("#132B43", "#56B1F7")} \tab \code{character(2)} of valid colors \cr
#' \code{pixie_na_string} \tab \code{NA} \tab \code{character}
#' }
#'
#' @name pixiedust
#' @keywords internal
"_PACKAGE"
================================================
FILE: R/pixiedust_print_method.R
================================================
#' @name pixiedust_print_method
#' @title Determine the Current Print Method
#'
#' @description The user has the option of designating the print method to use, or
#' allowing package to select one from the \code{knitr} settings. This
#' function manages the logic of assigning the correct print method within the
#' \code{dust} call.
#'
#' @details The function \code{pixiedust_print_method} first uses
#' \code{getOption("pixiedust_print_method")} to determine if the user has set
#' a print method. If the user has not, it then looks to
#' \code{knitr::opts_knit$get("rmarkdown.pandoc.to")}. Finally, if this is also
#' \code{NULL}, then the option is set to \code{"console"}.
pixiedust_print_method <- function()
{
print_method <-
getOption("pixiedust_print_method",
knitr::opts_knit$get("rmarkdown.pandoc.to"))
if (is.null(print_method))
{
print_method <- "console"
}
switch(print_method,
"beamer" = "latex",
print_method)
}
================================================
FILE: R/pixieply.R
================================================
#' @name pixieply
#' @title Apply Functions Over `dust_list` Objects
#'
#' @description The \code{sprinkle} methods work with \code{dust_list}
#' objects very naturally, but medleys pose a slightly more difficult problem.
#' Medleys are intended to be predefined collections of sprinkles that reduce
#' the time required to format a table with a particular look and style.
#' It seems counter-productive to expect a user to define each of her or his
#' medleys as a method that can work with both \code{dust} and \code{dust_list}
#' objects. \code{pixieply} is a wrapper to \code{lapply} that preserves the
#' \code{dust_list} class of the object.
#'
#' \code{pixiemap} provides functionality to apply differing sprinkles over
#' each element of a \code{dust_list}. The most common example is probably
#' adding a unique caption to each table.
#'
#' @param X An object of class \code{dust_list}.
#' @param FUN A function to apply to each element of \code{X}
#' @param ... Additional arguments to pass to \code{FUN}
#' @param MoreArgs a list of other arguments to FUN
#' @param SIMPLIFY logical or character string; attempt to reduce the result
#' to a vector, matrix or higher dimensional array; see the \code{simplify}
#' argument of \code{\link{sapply}}
#' @param USE.NAMES logical; use names if the first ... argument has names,
#' or if it is a character vector, use that character vector as the names.
#'
#' @examples
#' \dontrun{
#' #* This example will only display the last table
#' #* in the viewer pane. To see the full output,
#' #* run this example in an Rmarkdown document.
#' x <- split(mtcars, list(mtcars$am, mtcars$vs))
#' dust(x) %>%
#' sprinkle_print_method("html") %>%
#' pixieply(medley_bw)
#' }
#'
#' \dontrun{
#' #* This is the full text of an RMarkdown script
#' #* for the previous example.
#' ---
#' title: "Pixieply"
#' output: html_document
#' ---
#'
#' ```{r}
#' library(pixiedust)
#' x <- dplyr::group_by(mtcars, am, vs)
#' dust(x, ungroup = FALSE) %>%
#' sprinkle_print_method("html") %>%
#' pixieply(medley_bw)
#' ```
#' }
#'
#' @export
pixieply <- function(X, FUN, ...)
{
checkmate::assertClass(X, "dust_list")
structure(
lapply(X = X,
FUN = FUN,
...),
class = "dust_list"
)
}
#' @rdname pixieply
#' @export
pixiemap <- function(X, FUN, ..., MoreArgs = NULL, SIMPLIFY = FALSE, USE.NAMES = TRUE)
{
checkmate::assertClass(X, "dust_list")
structure(
mapply(FUN = FUN,
X,
...,
MoreArgs = MoreArgs,
SIMPLIFY = SIMPLIFY,
USE.NAMES = USE.NAMES),
class = "dust_list"
)
}
================================================
FILE: R/print.dust.R
================================================
#' @name print.dust
#' @export
#' @method print dust
#'
#' @title Print A \code{dust} Table
#' @description Apply the formatting to a \code{dust} object and print the table.
#'
#' @param x An object of class \code{dust}
#' @param ... Additional arguments to pass to the print method. Currently ignored.
#' @param asis A logical value that controls if the output is printed using
#' \code{knitr::asis_output}. See Details.
#' @param linebreak_at_end Used only in HTML tables; defines the number of
#' line break tags \code{</br>} appended to the end of the table in order to
#' generate whitespace between then end of the table and the subsequent
#' element. By default, two line breaks are used.
#'
#' @details The printing format is drawn from \code{options()$dustpan_output} and may take any of
#' the values \code{"console"}, \code{"markdown"}, \code{"html"}, or \code{"latex"}
#'
#' The markdown, html, and latex output is returned via \code{\link[knitr]{asis_output}},
#' which forces the output into the 'asis' environment. It is intended to work
#' with Rmarkdown, and the tables will be rendered regardless of the
#' chunk's \code{results} argument. Currently, there is no way to to capture
#' the code for additional post processing.
#'
#' When \code{asis = TRUE} (the default), the output is returned via \code{knitr::asis_output},
#' which renders the output as if the chunk options included \code{results = 'asis'}. Under
#' this setting, the table will be rendered regardless of the value of the \code{results}
#' option. Using \code{asis = FALSE} returns a character string with the code for the table.
#' This may be rendered in a markdown document via \code{cat(print(x, asis = FALSE))} with the
#' chunk option \code{results = 'asis'}. (If working with an Rnw file, the chunk option is
#' \code{results = tex}). The only way to use the \code{asis} argument is with an explicit
#' call to \code{print.dust}.
#'
#'
#' @author Benjamin Nutter
#'
#' @examples
#' dust(lm(mpg ~ qsec + factor(am), data = mtcars))
print.dust <- function(x, ..., asis = TRUE, linebreak_at_end = 2)
{
print_method <- x$print_method
if (print_method == "latex" & x$hhline)
print_method <- "latex_hhline"
switch(print_method,
"console" = print_dust_console(x, ..., asis = asis),
"docx" = print_dust_markdown(x, ..., asis = asis),
"markdown" = print_dust_markdown(x, ..., asis = asis),
"html" = print_dust_html(x, ..., asis = asis, linebreak_at_end = linebreak_at_end),
"latex" = print_dust_latex(x, ..., asis = asis),
"latex_hhline" = print_dust_latex_hhline(x, ..., asis = asis),
"slidy" = print_dust_html(x, ..., asis = asis, linebreak_at_end = linebreak_at_end),
stop(sprintf("'%s' is not an valid print method",
x[["print_method"]])))
}
#' @rdname print.dust
#' @export
print.dust_list <- function(x, ..., asis = TRUE)
{
lapply(X = x,
FUN = print.dust,
asis = asis,
...)
}
================================================
FILE: R/print_dust_console.R
================================================
print_dust_console <- function(x, ..., return_df = FALSE, asis=TRUE)
{
if (!is.null(x$caption) & x$caption_number) increment_pixie_count()
caption_number_prefix <-
if (x$caption_number) sprintf("Table %s: ", get_pixie_count())
else ""
#* Determine the number of divisions
#* It looks more complicated than it is, but the gist of it is
#* total number of divisions: ceiling(total_rows / longtable_rows)
#* The insane looking data frame is just to make a reference of what rows
#* go in what division.
if (!is.numeric(x$longtable) & x$longtable) longtable_rows <- 25L
else if (!is.numeric(x$longtable) & !x$longtable) longtable_rows <- as.integer(max(x$body$row))
else longtable_rows <- as.integer(x$longtable)
Divisions <- data.frame(div_num = rep(1:ceiling(max(x$body$row) / longtable_rows),
each = longtable_rows)[1:max(x$body$row)],
row_num = 1:max(x$body$row))
total_div <- max(Divisions$div_num)
#* Format table parts
head <- part_prep_console(x$head)
body <- part_prep_console(x$body)
foot <- if (!is.null(x$foot)) part_prep_console(x$foot) else NULL
interfoot <- if (!is.null(x$interfoot)) part_prep_console(x$interfoot) else NULL
names(body) <- names(head) <- head[1, ]
if (!is.null(foot)) names(foot) <- names(head)
if (!is.null(interfoot)) names(interfoot) <- names(head)
if (return_df) DF <- NULL
#* Run a loop to print all the divisions
for (i in 1:total_div){
tbl <-
.rbind_internal(if (nrow(head) > 1) head[-1, ] else NULL,
body[Divisions$row_num[Divisions$div_num == i], ],
if (i == total_div) foot else interfoot)
if (return_df) DF <- rbind(DF, tbl)
else {
if (!is.null(x$caption)) cat(caption_number_prefix, x$caption, "\n\n",
sep = "")
print(as.data.frame(tbl))
cat("\n\n")
}
}
if (return_df) return(as.data.frame(DF))
}
#**** Helper functions
part_prep_console <- function(part)
{
#* values in the dust object are all stored as character strings.
#* These classes need to be converted to numerics for rounding
#* to have the appropriate effect.
numeric_classes <- c("double", "numeric")
#* If functions are assigned, perform the function.
part <- perform_function(part)
#* Perform any rounding
logic <- part$round == "" & part$col_class %in% numeric_classes
part$round[logic] <- getOption("digits")
logic <- part$col_class %in% numeric_classes
if (any(logic)){
part$value[logic] <-
as.character(roundSafe(part$value[logic], as.numeric(part$round[logic])))
}
#* Replacement
logic <- !is.na(part[["replace"]])
part[["value"]][logic] <- part[["replace"]][logic]
#* Bold text. In the console, bold text is denoted by "**". In order
#* to keep the all of the formatting lined up in columns, the data
#* frame is grouped by column, and if any cell in the column has bold
#* text, the unbolded text gets two spaces on either side to make the
#* columns the same width.
part <- split(part, part$col)
part <- lapply(part,
function(x){
if (any(x$bold)){
x$value <- ifelse(x$bold,
sprintf("**%s**", x$value),
sprintf(" %s ", x$value))
}
if (any(x$italic)){
x$value <- ifelse(x$italic,
sprintf("_%s_", x$value),
sprintf(" %s_", x$value))
}
x
})
part <- do.call("rbind", part)
part$value <- ifelse(part$rowspan == 0, "", part$value)
part$value <- ifelse(part$colspan == 0, "", part$value)
part$value <- ifelse(is.na(part$value) & !is.na(part$na_string),
part$na_string,
part$value)
part <- .make_dataframe_wide(part)
part
}
================================================
FILE: R/print_dust_html.R
================================================
print_dust_html <- function(x, ..., asis=TRUE,
linebreak_at_end = getOption("pixie_html_linebreak", 2),
interactive = getOption("pixie_interactive"))
{
if (is.null(interactive)) interactive <- interactive()
if (!is.null(x$caption) & x$caption_number) increment_pixie_count()
caption_number_prefix <-
if (x$caption_number) sprintf("Table %s: ", get_pixie_count())
else ""
label <-
if (is.null(x[["label"]]))
{
chunk_label <- knitr::opts_current$get("label")
if (is.null(chunk_label))
sprintf("tab:pixie-%s", getOption("pixie_count"))
else
sprintf("tab:%s", chunk_label)
}
else
{
sprintf("tab:%s", x[["label"]])
}
label <-
if (x[["bookdown"]])
{
sprintf("(\\#%s)", label)
}
else
{
caption_number_prefix
}
#* Determine the number of divisions
#* It looks more complicated than it is, but the gist of it is
#* total number of divisions: ceiling(total_rows / longtable_rows)
#* The insane looking data frame is just to make a reference of what rows
#* go in what division.
if (!is.numeric(x$longtable) & x$longtable) longtable_rows <- 25L
else if (!is.numeric(x$longtable) & !x$longtable) longtable_rows <- as.integer(max(x$body$row))
else longtable_rows <- as.integer(x$longtable)
Divisions <- data.frame(div_num = rep(1:ceiling(max(x$body$row) / longtable_rows),
each = longtable_rows)[1:max(x$body$row)],
row_num = 1:max(x$body$row))
total_div <- max(Divisions$div_num)
#* Format the table parts
head <- part_prep_html(x$head, head = TRUE,
fixed_header = x[["fixed_header"]],
fixed_header_class_name = x[["fixed_header_param"]][["fixed_header_class_name"]])
body <- part_prep_html(x$body)
foot <- if (!is.null(x$foot)) part_prep_html(x$foot) else NULL
interfoot <- if (!is.null(x$interfoot)) part_prep_html(x$interfoot) else NULL
tmpfile <- tempfile(fileext=".html")
non_interactive <- ""
#* Run a for loop to build all the table divisions
for (i in 1:total_div){
tbl <- .rbind_internal(head,
body[Divisions$row_num[Divisions$div_num == i], , drop=FALSE],
if (i == total_div) foot else interfoot)
rows <- apply(tbl, 1, paste0, collapse = "\n")
rows <- sprintf("<tr>\n%s\n</tr>", rows)
justify <-
if (x[["justify"]] == "center") "margin:auto"
else sprintf("float:%s", x[["justify"]])
# Tables aligned to the left or right of the page need a barrier with the
# clear propert set to prevent text from being placed next to the table.
float_guard <-
if (x[["justify"]] == "center") ""
else "<div style = 'clear:both'></div>"
fixed_head_css <-
if (x[["fixed_header"]] & x[["include_fixed_header_css"]])
do.call(fixed_header_css,
c(x[["fixed_header_param"]],
list(pretty = FALSE)))
else ""
if (x[["fixed_header"]]){
fixed_head_open_tag <-
sprintf("<div style = 'text-align:%s'><section class='%s-section'><div class='%s-container'><div>",
x[["justify"]],
x[["fixed_header_param"]][["fixed_header_class_name"]],
x[["fixed_header_param"]][["fixed_header_class_name"]])
fixed_head_close_tag <- "</div></section></div>"
}
else{
fixed_head_open_tag <- fixed_head_close_tag <- ""
}
html_code <- sprintf("%s%s%s<table style = '%s;border-collapse:%s;'>\n%s\n</table>%s%s%s",
float_guard,
fixed_head_css,
fixed_head_open_tag,
justify,
x$border_collapse,
paste0(rows, collapse = "\n"),
fixed_head_close_tag,
float_guard,
paste0(rep("</br>", linebreak_at_end), collapse = ""))
if (!is.null(x$caption))
html_code <- sub(">",
sprintf(">\n<caption>%s %s</caption>",
label, x$caption),
html_code)
#* When interactive, write to a temporary file so that it
#* can be displayed in the viewer
if (interactive & asis){
write(html_code, tmpfile, append = i > 1)
}
else non_interactive <- paste0(non_interactive, html_code)
}
# print(html_code)
if (interactive & asis){
getOption("viewer")(tmpfile)
}
else if (asis){
if (x$html_preserve) knitr::asis_output(htmltools::htmlPreserve(non_interactive))
else knitr::asis_output(non_interactive)
}
else {
if (x$html_preserve) htmltools::htmlPreserve(non_interactive)
else non_interactive
}
}
#**** Helper functions
part_prep_html <- function(part, head=FALSE,
fixed_header = FALSE, fixed_header_class_name = "")
{
numeric_classes <- c("double", "numeric")
dh <-
if (head)
{
if (fixed_header){
sprintf("th class = 'th-%s'", fixed_header_class_name)
}
else
{
"th"
}
}
else
{
"td"
}
#* apply a function, if any is indicated
part <- perform_function(part)
#* Perform any rounding
logic <- part$round == "" & part$col_class %in% numeric_classes
part$round[logic] <- getOption("digits")
logic <- part$col_class %in% numeric_classes
if (any(logic))
part$value[logic] <-
as.character(roundSafe(part$value[logic], as.numeric(part$round[logic])))
#* Replacement
logic <- !is.na(part[["replace"]])
part[["value"]][logic] <- part[["replace"]][logic]
#* Bold and italic
boldify <- part$bold
part$bold[boldify] <- "font-weight:bold;"
part$bold[!boldify] <- ""
italicize <- part$italic
part$italic[italicize] <- "font-style:italic;"
part$italic[!italicize] <- ""
#* Alignments. With horizontal alignment, first we determine
#* default alignment for any cell without a given designation.
#* The defaults are right aligned for numeric, left aligned for
#* all otheres. The `default_halign` function is defined in
#* `print_dust_latex.R`
logic <- part$halign == ""
part$halign[logic] <- vapply(X = part$col_class[logic],
FUN = default_halign,
FUN.VALUE = character(1),
print_method = "html")
part$halign <-
with(part, sprintf("text-align:%s;", halign))
logic <- part$valign != ""
part$valign[logic] <-
with(part, sprintf("vertical-align:%s;", valign[logic]))
#** Background
logic <- part$bg != ""
part$bg[logic] <-
with(part, sprintf("background-color:%s;", bg[logic]))
#* Font Family
logic <- part$font_family != ""
part$font_family[logic] <-
with(part, sprintf("font-family:%s;", font_family[logic]))
#* Font Color
logic <- part$font_color != ""
part$font_color[logic] <-
with(part, sprintf("color:%s;", font_color[logic]))
#* Font size
logic <- part$font_size != ""
part$font_size[logic] <-
with(part, sprintf("font-size:%s%s;",
font_size[logic],
font_size_units[logic]))
#* cell height and width
logic <- part$height != ""
part$height[logic] <-
with(part, sprintf("height:%s%s;", height[logic], height_units[logic]))
logic <- part$width != ""
part$width[logic] <-
with(part, sprintf("width:%s%s;", width[logic], width_units[logic]))
#* Borders
logic <- part$top_border != ""
part$top_border[logic] <-
with(part, sprintf("border-top:%s;", top_border[logic]))
logic <- part$bottom_border != ""
part$bottom_border[logic] <-
with(part, sprintf("border-bottom:%s;", bottom_border[logic]))
logic <- part$left_border != ""
part$left_border[logic] <-
with(part, sprintf("border-left:%s;", left_border[logic]))
logic <- part$right_border != ""
part$right_border[logic] <-
with(part, sprintf("border-right:%s;", right_border[logic]))
#* Set NA (missing) values to na_string
logic <- is.na(part$value) & !is.na(part$na_string)
part$value[logic] <-
part$na_string[logic]
#* Padding
logic <- part$pad != ""
part$pad[logic] <-
with(part, sprintf("padding:%spx;", pad[logic]))
#* Text Rotation
logic <- part$rotate_degree != ""
part$rotate_degree[logic] <-
with(part, rotate_tag(rotate_degree[logic]))
#* Generate css style definitions for each cell.
part$value <-
with(part, sprintf("<%s colspan = '%s'; rowspan = '%s'; style='%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s'>%s %s</%s>",
dh, colspan, rowspan,
bold, italic, halign, valign, bg, font_family, #6
font_color, font_size, height, width, #4
top_border, bottom_border, left_border, right_border, #4
rotate_degree, pad, #2
value,
if (fixed_header) paste0("<div>", value, "</div>") else "",
substr(dh, 1, 2)))
ncol <- max(part$col)
part <- part[!(part$rowspan == 0 | part$colspan == 0), ]
logic <-
part[["row"]] == part[["html_row"]] &
part[["col"]] == part[["html_col"]] &
part[["colspan"]] > 1
if ("html_row_pos" %in% names(part))
part[["html_row"]][logic] <- part[["html_row_pos"]][logic]
if ("html_col_pos" %in% names(part))
part[["html_col"]][logic] <- part[["html_col_pos"]][logic]
#* Spread to wide format for printing
part <- part[c("html_row", "html_col", "value")]
part <- reshape2::dcast(part,
html_row ~ html_col,
value.var = "value",
fill = "")
part <- part[!names(part) %in% "html_row"]
if (ncol(part) != ncol){
part <- cbind(part,
do.call("cbind",
lapply(1:(ncol - ncol(part)),
function(i) data.frame(value = "",
stringsAsFactors = FALSE))))
names(part) <- 1:ncol
}
part
}
#***********************************
#* Rotation tags vary by browser. To make the rotation as robust as
#* possible, specifying a rotation applies tags for webkit (Chrome?),
#* Mozilla, Internet Explorer, Opera, and a generic transformation.
rotate_tag <- function(degree)
{
sprintf(
paste0("-webkit-transform:rotate(%sdeg);",
"-moz-transform:rotate(%sdeg);",
"-ms-transform:rotate(%sdeg);",
"-o-transform:rotate(%sdeg);",
"transform:rotate(%sdeg);"),
degree, degree, degree, degree, degree)
}
================================================
FILE: R/print_dust_latex.R
================================================
print_dust_latex <- function(x, ..., asis=TRUE)
{
if (!is.null(x$caption) & x$caption_number) increment_pixie_count()
label <-
if (is.null(x[["label"]]))
{
chunk_label <- knitr::opts_current$get("label")
if (is.null(chunk_label))
paste0("tab:pixie-", getOption("pixie_count"))
else
paste0("tab:", chunk_label)
}
else
{
paste0("tab:", x[["label"]])
}
label <-
if (x[["bookdown"]])
{
paste0("(\\#", label, ")")
}
else
{
paste0("\\label{", label, "}")
}
#* Determine the number of divisions
#* It looks more complicated than it is, but the gist of it is
#* total number of divisions: ceiling(total_rows / longtable_rows)
#* The insane looking data frame is just to make a reference of what rows
#* go in what division.
if (!is.numeric(x$longtable) & x$longtable) longtable_rows <- 25L
else if (!is.numeric(x$longtable) & !x$longtable) longtable_rows <- as.integer(max(x$body$row))
else longtable_rows <- as.integer(x$longtable)
tab_env <- if (is.numeric(x$longtable) || x$longtable) "longtable" else "tabular"
Joint <- joint_reference_table(x)
col_width <- determine_column_width(Joint)
col_halign_default <- get_column_halign(Joint)
row_height <- lapply(list(x$head, x$body, x$foot, x$interfoot),
determine_row_height)
#* Format the table parts
head <- part_prep_latex(x$head, col_width, col_halign_default, head = TRUE)
body <- part_prep_latex(x$body, col_width, col_halign_default)
foot <- if (!is.null(x$foot)) part_prep_latex(x$foot, col_width, col_halign_default) else NULL
interfoot <- if (!is.null(x$interfoot)) part_prep_latex(x$interfoot, col_width, col_halign_default) else NULL
#* Write the LaTeX Code
prebegin <- numeric_longtable_newline(longtable_rows, is.numeric(x$longtable))
prebegin <- paste0(prebegin,
"\\setlength{\\tabcolsep}{", x$tabcolsep, "pt}", sep = "\n")
if (tab_env == "longtable")
{
begin <- paste0("\\begin{longtable}[",
gsub("n", "l", substr(x[["justify"]], 1, 1)), "]{",
paste0(col_halign_default$default_halign, collapse = ""), "}\n",
if (!is.null(x$caption))
paste0("\\caption",
if (x$caption_number) "" else "*",
"{", x$caption, "}")
else "",
"\n", label, "\\\\ \n")
end <- "\\end{longtable}"
}
else if (x$float)
{
begin <- paste0("\\begin{table}\n",
if (x[["justify"]] == "center") "\\centering\n" else "",
if (!is.null(x$caption))
paste0("\\caption",
if (x$caption_number) "" else "*",
"{", x$caption, "}")
else "",
"\n", label,
"\\begin{tabular}{",
paste0(col_halign_default$default_halign, collapse = ""), "}\n")
end <- paste0("\\end{tabular}\n\\end{table}\n")
}
else
{
begin <- paste0(if (x[["justify"]] == "center")
"\\begin{center}\n"
else
"",
if (!is.null(x$caption))
paste0("\\captionof{table}{", x$caption, "}")
else "",
"\n", label,
"\\begin{tabular}{",
paste0(col_halign_default$default_halign, collapse = ""), "}\n")
end <- paste0("\\end{tabular}\n",
if (x[["justify"]] == "center")
"\\end{center}\n"
else
"")
}
#* Convert each part into a character string
#* Returns a character vector of length 4.
tbl <- mapply(paste_latex_part,
list(head, body, foot, interfoot),
row_height,
MoreArgs = list(newline = if (is.numeric(x$longtable)) " \\ltabnewline" else " \\\\"))
#* Append longtable tags
if (is.numeric(x$longtable) || x$longtable){
tbl <- paste0(tbl[c(1, 4, 3, 2)],
c("\n\\endhead\n", "\n\\endfoot\n", "\n\\endlastfoot\n", ""))
}
tbl <- paste(tbl, collapse = "\n")
if (asis) knitr::asis_output(paste(prebegin, begin, tbl, end, collapse = "\n"))
else paste(prebegin, begin, tbl, end, collapse = "\n")
}
#* Prepare Cell Values for Printing
part_prep_latex <- function(part, col_width, col_halign_default, head=FALSE)
{
part <- part[!names(part) %in% "width"]
part <- merge(part,
col_width,
by = "col",
all.x = TRUE,
sort = FALSE)
part <- merge(part,
col_halign_default,
by = "col",
all.x = TRUE,
sort = FALSE)
part$width_units <- rep("pt", nrow(part))
part$halign <- ifelse(part$halign == "",
part$default_halign,
part$halign)
#* Calculate the row cell width for multicolumn cells
Widths <- part[c("html_row", "html_col", "width", "merge")]
Widths <- Widths[!duplicated(Widths), ]
Widths <- split(Widths, Widths[c("html_row", "html_col")])
Widths <- lapply(Widths,
function(x){
x$width <- ifelse(x$merge == TRUE,
sum(x$width[x$merge]),
x$width)
x
})
Widths <- do.call(".rbind_internal", Widths)
numeric_classes <- c("double", "numeric")
#* apply a function, if any is indicated
part <- perform_function(part)
#* Perform any rounding
logic <- part$round == "" & part$col_class %in% numeric_classes
part$round[logic] <- getOption("digits")
logic <- part$col_class %in% numeric_classes
if (any(logic))
part$value[logic] <-
as.character(roundSafe(part$value[logic], as.numeric(part$round[logic])))
#* Replacement
logic <- !is.na(part[["replace"]])
part[["value"]][logic] <- part[["replace"]][logic]
#* Set NA (missing) values to na_string
logic <- is.na(part$value) & !is.na(part$na_string)
part$value[logic] <-
part$na_string[logic]
#* Sanitize value strings
logic <- part[["sanitize"]]
part[["value"]][logic] <- sanitize(part[["value"]][logic],
part[["sanitize_args"]][logic])
#* Bold and italic
boldify <- part$bold
part$value[boldify] <- paste0("\\textbf{", part$value[boldify], "}")
italicize <- part$italic
part$value[italicize] <- paste0("\\emph{", part$value[italicize], "}")
#* Font Color
logic <- part$font_color != ""
part$font_color <- vapply(part$font_color,
convertColor,
character(1))
part$value[logic] <-
paste0("\\textcolor", part$font_color[logic], "{", part$value[logic], "}")
#* Font size
logic <- part$font_size != ""
part$font_size_units[logic] <- ifelse(part$font_size_units[logic] %in% c("%", "px"),
"pt",
part$font_size_units[logic])
part$value[logic] <-
paste0("{\\fontsize{", part$font_size[logic],
part$font_size_units[logic], "}{1em}\\selectfont ",
part$value[logic], "}")
logic <- part$rotate_degree != ""
part$value[logic] <-
paste0("\\rotatebox{", part$rotate_degree[logic], "}{", part$value[logic], "}")
#** Background
logic <- part$bg != ""
part$bg[logic] <-
paste0("{\\cellcolor", vapply(part$bg[logic],
convertColor,
character(1)), "}")
part$value[logic] <- paste(part$bg[logic], part$value[logic])
#** Borders
logic <- part$left_border != ""
part$left_border[logic] <-
vapply(part$left_border[logic], latex_vertical_border_code, character(1))
logic <- part$right_border != ""
part$right_border[logic] <-
vapply(part$right_border[logic], latex_vertical_border_code, character(1))
logic <- part$bottom_border != ""
part$bottom_border[logic] <-
mapply(latex_horizontal_border_code,
part$bottom_border[logic],
part$col[logic])
bottom_borders <- part[c("row", "col", "bottom_border")]
bottom_borders <- reshape2::dcast(bottom_borders,
row ~ col,
value.var = "bottom_border")
bottom_borders <- bottom_borders[!names(bottom_borders) %in% "row"]
bottom_borders <- apply(bottom_borders,
MARGIN = 1,
paste0,
collapse = "")
logic <- part$top_border != ""
part$top_border[logic] <-
mapply(latex_horizontal_border_code,
part$top_border[logic],
part$col[logic])
top_borders <- part[c("row", "col", "top_border")]
top_borders <- reshape2::dcast(top_borders,
row ~ col,
value.var = "top_border",
fill = "")
top_borders <- top_borders[!names(top_borders) %in% "row"]
top_borders <- apply(top_borders,
MARGIN = 1,
FUN = paste0,
collapse = "")
parbox <- needs_parbox(part)
part$halign_parbox <- part$halign
part$halign_parbox[parbox] <-
c("r" = "\\raggedleft",
"c" = "\\centering",
"l" = "\\raggedright",
"p" = "\\raggedright")[substr(part$halign[parbox], 1, 1)]
part$value[parbox] <-
paste0("\\parbox[", substr(part$valign[parbox], 1, 1), "]{", part$width[parbox], "pt}{",
part$halign_parbox[parbox], " ",
part$value[parbox], "}")
#* Add the multirow tag where appropriate
logic <- part$rowspan > 1
part$value[logic] <-
paste0("\\multirow{", part$rowspan[logic], "}{*}{", part$value[logic], "}")
#* Add blank multicolumn tags to fill multirow spaces
#* set the colspan and rowspan to prevent deletion.
#* They are set to -1 to indicate that they are fillers
logic <- part$html_row != part$row & part$html_col == part$col
part$value[logic] <- paste0("\\multicolumn{", part$colspan[logic], "}",
"{", part$left_border[logic], "c", part$right_border[logic], "}{}")
part$rowspan[logic] <- -1
part$colspan[logic] <- part$colspan[logic] * -1
#* Place multicolumn tags where needed
logic <- part$colspan > 1 | (part$left_border != "" | part$right_border != "") |
!(part$html_row != part$row & part$html_col == part$col)
part$value[logic] <-
paste0("\\multicolumn{", part$colspan[logic], "}{",
part$left_border[logic],
#* 'p' isn't a valid alignment in 'multicol', so we replace it with 'r'
sub("p", "r", substr(part$halign[logic], 1, 1)),
part$right_border[logic], "}{", part$value[logic], "}")
#* Remove value where a merged cell is not the display cell
ncol <- max(part$col)
part <- part[!(part$rowspan == 0 | part$colspan == 0), ]
#* In order to get the multirow to render correctly, the cell with
#* the multirow needs to be at the top of the block. This
#* rearranges the merged cells so that the multirow is at the top.
proper_multirow <- part[part$colspan != 1, ]
proper_multirow$group <- paste0(proper_multirow$html_row,
proper_multirow$html_col)
proper_multirow <- split(proper_multirow,
proper_multirow$group)
proper_multirow <- lapply(proper_multirow,
function(x){
x[order(x$colspan, decreasing = TRUE), ]
x$row <- sort(x$row)
x
})
proper_multirow <- do.call(".rbind_internal", proper_multirow)
part <- part[part$colspan == 1, ]
part <- .rbind_internal(part, proper_multirow)
part <- .make_dataframe_wide(part)
cbind(top_borders,
bottom_borders,
part)
}
#* Converts the data frame object to one line of LaTeX
#* code per row.
paste_latex_part <- function(part, row_height, newline = " \\\\"){
paste_row <- function(r) paste(r[!is.na(r)], collapse = " & ")
if (is.null(part)) return("")
#* This commented line existed when I had horizontal
#* borders worked out. It may be needed again.
apply(part[, -(1:2), drop = FALSE], 1, paste_row) %>%
# apply(part[, , drop = FALSE], 1, paste_row) %>%
paste(row_height) %>%
paste(newline) %>%
paste(part[, 2]) %>% #* also from borders
paste(part[, 1], .) %>% #* also from borders
paste0(collapse = "\n")
}
#**************************************************
#**************************************************
convertColor <- function(color){
if (length(color) == 0) return(character(0))
color <- gsub("rgba[(]255,255,255,0[)]", "", color)
if (grepl("#", color)){
return(paste0("[HTML]{", sub("#", "", color), "}"))
}
else if (grepl("rgb", color, ignore.case = TRUE)){
rgb <- str_extract_base(color, "\\d{1,3}")[1, 1:3]
return(paste0("[RGB]{", paste0(rgb, collapse=","), "}"))
}
else return(paste0("{", color, "}"))
}
#**************************************************
#**************************************************
#* Writes the code that is necessary to force
#* longtable breaks at the user-specified number
#* of lines
numeric_longtable_newline <- function(n, redefine = FALSE){
if (redefine)
return(paste0("\\newcount\\mylineno \n",
"\\mylineno=0 \n",
"\\def\\ltabnewline{% \n",
"\\global\\advance\\mylineno by 1 \n",
"\\ifnum\\mylineno=", n, " \n",
"\\global\\mylineno=0 \n",
"\\\\ \n",
"\\newpage \n",
"\\else \n",
"\\\\ \n",
"\\fi \n",
"}"))
else return("")
}
#**************************************************
#**************************************************
#* Determine if the cell needs a parbox
needs_parbox <- function(x)
{
is.finite(x$width) |
(x$halign != x$default_halign) |
x$valign != "" |
x$merge
}
#**************************************************
#**************************************************
#* Combine the four table parts for convenience of looking for common traits
joint_reference_table <- function(x){
numeric_classes <- c("double", "numeric")
addPartCol <- function(p, part_name) {
if (is.null(p)) return(NULL)
p$part <- part_name
return(p)
}
Joint <-
mapply(addPartCol,
x[c("head", "body", "foot", "interfoot")],
part_name = c("head", "body", "foot", "interfoot"),
SIMPLIFY = FALSE)
Joint <- do.call(".rbind_internal", Joint)
Joint$width <- as.numeric(Joint$width)
Joint$table_width <- x$table_width * 72.27
Joint$width <- ifelse(Joint$width_units == "in",
Joint$width * 72.27,
ifelse(Joint$width_units == "cm",
Joint$width * 27.45,
ifelse(Joint$width_units == "%",
Joint$width/100 * Joint$table_width,
Joint$width)))
#* apply a function, if any is indicated
Joint <- perform_function(Joint)
#* Perform any rounding
logic <- Joint$round != "" & Joint$col_class %in% numeric_classes
if (any(logic))
Joint$value[logic] <-
as.character(roundSafe(Joint$value[logic], as.numeric(Joint$round[logic])))
Joint$halign[Joint$halign == ""] <-
vapply(Joint$col_class[Joint$halign == ""],
default_halign,
character(1))
Joint$halign <- substr(Joint$halign, 1, 1)
Joint <- split(Joint, Joint$col)
Joint <- lapply(Joint,
function(x){
x$default_halign <- names(sort(table(x$halign),
decreasing = TRUE))[1]
x
})
Joint <- do.call(".rbind_internal", Joint)
Joint$parbox <- needs_parbox(Joint)
Joint$width_by_char <- nchar(Joint$value) * 4.5
Joint <- split(Joint, Joint$col)
Joint <- lapply(Joint,
function(x){
x$replace <- all(is.na(x$width)) & any(x$parbox)
x$width_by_char <- max(x$width_by_char, na.rm = TRUE)
x
})
Joint <- do.call(".rbind_internal", Joint)
Joint$width <- ifelse(Joint$replace,
Joint$width_by_char,
Joint$width)
Joint <- Joint[c("col", "row", "width", "default_halign")]
Joint
}
#**************************************************
#**************************************************
#* Get the default column alignments.
#* Right aligned for numeric, otherwise, left aligned
determine_column_width <- function(Joint, x)
{
Joint <- Joint[c("row", "col", "width")]
suppressWarnings(Joint <- tapply(Joint$width, Joint$col, max, na.rm = TRUE))
Joint <- data.frame(col = names(Joint),
width = unname(Joint),
stringsAsFactors = FALSE)
Joint$width <- ifelse(is.finite(Joint$width),
Joint$width,
NA)
Joint
}
determine_row_height <- function(part)
{
if (is.null(part)) return("")
part <- part[c("row", "col", "height", "height_units")]
part$height <- as.numeric(part$height)
part$height <- ifelse(part$height_units == "in",
part$height * 72.27,
ifelse(part$height_units == "cm",
part$height * 28.45,
part$height))
suppressWarnings(part <- tapply(part$height,
INDEX = part$row,
FUN = max,
na.rm = TRUE))
part <- data.frame(row = names(part),
height = unname(part),
stringsAsFactors = FALSE)
part$height <- ifelse(!is.finite(part$height),
"",
paste0("\\\\[", part$height, "pt]"))
part$height
}
#**************************************************
#**************************************************
#* Get the default column alignments.
#* Right aligned for numeric, otherwise, left aligned
get_column_halign <- function(Joint){
Joint$default_halign <- ifelse(is.na(Joint$width),
Joint$default_halign,
paste0("p{", Joint$width, "pt}"))
Joint <- Joint[c("row", "col", "default_halign")]
Joint <- tapply(Joint$default_halign,
Joint$col,
function(x) x[1])
Joint <- data.frame(col = names(Joint),
default_halign = unname(Joint),
stringsAsFactors = FALSE)
Joint
}
default_halign <- function(col_class, print_method = "latex"){
tag <-
if (print_method == "latex") c("r", "l")
else c("right", "left")
if (col_class %in% c("numeric", "int", "double")) tag[1] else tag[2]
}
#**************************************************
#**************************************************
#* Prepares code for vertical borders
latex_vertical_border_code <- function(x){
border <- str_split_fixed_base(x, " ", 3)
border[, 1] <- gsub("px", "pt", border[, 1])
border[, 2] <- ifelse(border[, 2] %in% c("dashed", "dotted"),
"dashed",
ifelse(border[, 2] %in% c("groove", "ridge", "inset", "outset", "hidden"),
"solid", border[, 2]))
if (border[, 2] %in% c("hidden", "none")) return("")
if (border[, 2] == "dashed"){
border_code <- paste("!{\\color", convertColor(border[, 3]), "\\vdashline}")
return(border_code)
}
if (border[, 2] %in% c("solid", "double")){
border_code <- paste0("!{\\color", convertColor(border[, 3]), "\\vrule width ", border[, 1], "}")
return(border_code)
}
}
#**************************************************
#**************************************************
#* Prepares code for horizontal borders
latex_horizontal_border_code <- function(x, col){
border <- str_split_fixed_base(x, " ", 3)
border[, 1] <- gsub("px", "pt", border[, 1])
border[, 2] <- ifelse(border[, 2] %in% c("dashed", "dotted"),
"dashed",
ifelse(border[, 2] %in% c("groove", "ridge", "inset", "outset", "hidden"),
"solid", border[, 2]))
if (border[, 2] %in% c("hidden", "none")) return("")
if (border[, 2] == "dashed"){
border_code <- paste0("\\arrayrulecolor", convertColor(border[, 3]),
"\\cdashline{", col, "-", col, "}")
return(border_code)
}
if (border[, 2] %in% c("solid", "double")){
border_code <- paste0("\\arrayrulecolor", convertColor(border[, 3]),
"\\cline{", col, "-", col, "}")
return(border_code)
}
}
#* NA safe sanitization function
sanitize <- function(x, args)
{
sanitize_index <- !is.na(x)
if (sum(sanitize_index))
{
x[sanitize_index] <-
do.call(what = sanitize_latex,
args = c(list(object = x[sanitize_index]),
eval(parse(text = args[sanitize_index])))
)
}
x
}
utils::globalVariables(c("halign", "left_border", "right_border",
"bottom_border", "top_border",
"require_multicol", "height", "width",
"height_units", "width_units", "table_width",
"parbox", "width_by_char", "html_row",
"html_col", "rowspan", "colspan", "value", "col_name",
"col_class", "group", "."))
================================================
FILE: R/print_dust_latex_hhline.R
================================================
#* This provides an alternative method for generating horizontal lines in
#* LaTeX tables, using the hhline package. The advantage to hhline is that
#* when both backgrounds and borders are applied, the cell background won't
#* overshadow the borders as is the case when using \cline (the approach
#* used by print_dust_latex.
#* Use of the hhline method is determined by the package option
#* getOption("pixiedust_latex_hhline"), with the default being TRUE.
print_dust_latex_hhline <- function(x, ..., asis=TRUE)
{
if (!is.null(x$caption) & x$caption_number) increment_pixie_count()
label <-
if (is.null(x[["label"]]))
{
chunk_label <- knitr::opts_current$get("label")
if (is.null(chunk_label))
paste0("tab:pixie-", getOption("pixie_count"))
else
paste0("tab:", chunk_label)
}
else
{
paste0("tab:", x[["label"]])
}
label <-
if (x[["bookdown"]])
{
paste0("(\\#", label, ")")
}
else
{
paste0("\\label{", label, "}")
}
#* Determine the number of divisions
#* It looks more complicated than it is, but the gist of it is
#* total number of divisions: ceiling(total_rows / longtable_rows)
#* The insane looking data frame is just to make a reference of what rows
#* go in what division.
if (!is.numeric(x$longtable) & x$longtable) longtable_rows <- 25L
else if (!is.numeric(x$longtable) & !x$longtable) longtable_rows <- as.integer(max(x$body$row))
else longtable_rows <- as.integer(x$longtable)
tab_env <- if (is.numeric(x$longtable) || x$longtable) "longtable" else "tabular"
Joint <- joint_reference_table(x)
col_width <- determine_column_width(Joint)
col_halign_default <- get_column_halign(Joint)
row_height <- lapply(list(x$head, x$body, x$foot, x$interfoot),
determine_row_height)
#* Format the table parts
head <- part_prep_latex_hhline(x$head, col_width, col_halign_default, head = TRUE)
body <- part_prep_latex_hhline(x$body, col_width, col_halign_default)
foot <- if (!is.null(x$foot)) part_prep_latex_hhline(x$foot, col_width, col_halign_default) else NULL
interfoot <- if (!is.null(x$interfoot)) part_prep_latex_hhline(x$interfoot, col_width, col_halign_default) else NULL
#* Write the LaTeX Code
prebegin <- numeric_longtable_newline(longtable_rows, is.numeric(x$longtable))
prebegin <- paste0(prebegin,
"\\setlength{\\tabcolsep}{", x$tabcolsep, "pt}", sep = "\n")
if (tab_env == "longtable")
{
begin <- paste0("\\begin{longtable}[",
sub("n", "l", substr(x[["justify"]], 1, 1)), "]{",
paste0(col_halign_default$default_halign, collapse = ""), "}\n",
if (!is.null(x$caption))
paste("\\caption",
if (x$caption_number) "" else "*",
"{", x$caption, "}")
else "",
"\n", label, "\\\\ \n")
end <- "\\end{longtable}"
}
else if (x$float)
{
begin <- paste0("\\begin{table}\n",
if (x[["justify"]] == "center") "\\centering\n" else "",
if (!is.null(x$caption))
paste0("\\caption",
if (x$caption_number) "" else "*",
"{", x$caption, "}")
else "",
"\n", label,
"\\begin{tabular}{",
paste0(col_halign_default$default_halign, collapse = ""), "}\n")
end <- paste0("\\end{tabular}\n\\end{table}\n")
}
else
{
begin <- paste0(if (x[["justify"]] == "center")
"\\begin{center}\n"
else
"",
if (!is.null(x$caption))
paste0("\\captionof{table}{", x$caption, "}")
else "",
"\n", label,
"\\begin{tabular}{",
paste0(col_halign_default$default_halign, collapse = ""), "}\n")
end <- paste0("\\end{tabular}\n",
if (x[["justify"]] == "center")
"\\end{center}\n"
else
"")
}
#* Convert each part into a character string
#* Returns a character vector of length 4.
tbl <- mapply(paste_latex_part,
list(head, body, foot, interfoot),
row_height,
MoreArgs = list(newline = if (is.numeric(x$longtable)) " \\ltabnewline" else " \\\\"))
#* Append longtable tags
if (is.numeric(x$longtable) || x$longtable){
tbl <- paste0(tbl[c(1, 4, 3, 2)],
c("\n\\endhead\n", "\n\\endfoot\n", "\n\\endlastfoot\n", ""))
}
tbl <- paste(tbl, collapse = "\n")
if (asis) knitr::asis_output(paste(prebegin, begin, tbl, end, collapse = "\n"))
else paste(prebegin, begin, tbl, end, collapse = "\n")
}
#* Prepare Cell Values for Printing
part_prep_latex_hhline <- function(part, col_width, col_halign_default, head=FALSE)
{
part <- part[!names(part) %in% "width"]
part <- merge(part,
col_width,
by = "col",
all.x = TRUE,
sort = FALSE)
part <- merge(part,
col_halign_default,
by = "col",
all.x = TRUE,
sort = FALSE)
part$width_units <- rep("pt", nrow(part))
part$halign <- ifelse(part$halign == "",
part$default_halign,
part$halign)
#* Calculate the row cell width for multicolumn cells
Widths <- part[c("html_row", "html_col", "width", "merge")]
Widths <- Widths[!duplicated(Widths), ]
Widths <- split(Widths, Widths[c("html_row", "html_col")])
Widths <- lapply(Widths,
function(x){
x$width <- ifelse(x$merge == TRUE,
sum(x$width[x$merge]),
x$width)
x
})
Widths <- do.call(".rbind_internal", Widths)
numeric_classes <- c("double", "numeric")
#* apply a function, if any is indicated
part <- perform_function(part)
#* Perform any rounding
logic <- part$round == "" & part$col_class %in% numeric_classes
part$round[logic] <- getOption("digits")
logic <- part$col_class %in% numeric_classes
if (any(logic))
part$value[logic] <-
as.character(roundSafe(part$value[logic], as.numeric(part$round[logic])))
#* Replacement
logic <- !is.na(part[["replace"]])
part[["value"]][logic] <- part[["replace"]][logic]
#* Set NA (missing) values to na_string
logic <- is.na(part$value) & !is.na(part$na_string)
part$value[logic] <-
part$na_string[logic]
#* Sanitize value strings
#* `sanitize` is defined in `print_dust_latex.R`
logic <- part[["sanitize"]]
part[["value"]][logic] <- sanitize(part[["value"]][logic],
part[["sanitize_args"]][logic])
#* Bold and italic
boldify <- part$bold
part$value[boldify] <- paste0("\\textbf{", part$value[boldify], "}")
italicize <- part$italic
part$value[italicize] <- paste0("\\emph{", part$value[italicize], "}")
#* Font Color
logic <- part$font_color != ""
part$font_color <- vapply(part$font_color,
convertColor,
character(1))
part$value[logic] <-
paste0("\\textcolor", part$font_color[logic], "{", part$value[logic], "}")
#* Font size
logic <- part$font_size != ""
part$font_size_units[logic] <- ifelse(part$font_size_units[logic] %in% c("%", "px"),
"pt",
part$font_size_units[logic])
part$value[logic] <-
paste0("{\\fontsize{", part$font_size[logic],
part$font_size_units[logic], "}{1em}\\selectfont ",
part$value[logic], "}")
logic <- part$rotate_degree != ""
part$value[logic] <-
paste0("\\rotatebox{", part$rotate_degree[logic], "}{", part$value[logic], "}")
#** Background
logic <- part$bg != ""
part$bg[logic] <-
paste0("\\cellcolor", vapply(part$bg[logic],
convertColor,
character(1)))
part$value[logic] <- paste(part$bg[logic], part$value[logic])
#** Borders
logic <- part$left_border != ""
part$left_border[logic] <-
vapply(part$left_border[logic], latex_vertical_border_code, character(1))
logic <- part$right_border != ""
part$right_border[logic] <-
vapply(part$right_border[logic], latex_vertical_border_code, character(1))
logic <- part$bottom_border != ""
part$bottom_border[logic] <-
mapply(latex_horizontal_border_code_hhline,
part$bottom_border[logic],
part$col[logic])
part$bottom_border[!logic] <- "~"
bottom_borders <- part[c("row", "col", "bottom_border")]
bottom_borders <- reshape2::dcast(bottom_borders,
row ~ col,
value.var = "bottom_border")
bottom_borders <- bottom_borders[!names(bottom_borders) %in% "row"]
bottom_borders <- apply(bottom_borders,
MARGIN = 1,
paste0,
collapse = "")
bottom_borders <- paste0("\\hhline{", bottom_borders, "}")
logic <- part$top_border != ""
part$top_border[logic] <-
mapply(latex_horizontal_border_code_hhline,
part$top_border[logic],
part$col[logic])
part$top_border[!logic] <- "~"
top_borders <- part[c("row", "col", "top_border")]
top_borders <- reshape2::dcast(top_borders,
row ~ col,
value.var = "top_border",
fill = "")
top_borders <- top_borders[!names(top_borders) %in% "row"]
top_borders <- apply(top_borders,
MARGIN = 1,
FUN = paste0,
collapse = "")
top_borders <- paste0("\\hhline{", top_borders, "}")
parbox <- needs_parbox(part)
part$halign_parbox <- part$halign
part$halign_parbox[parbox] <-
c("r" = "\\raggedleft",
"c" = "\\centering",
"l" = "\\raggedright",
"p" = "\\raggedright")[substr(part$halign[parbox], 1, 1)]
part$value[parbox] <-
paste0("\\parbox[", substr(part$valign[parbox], 1, 1), "]{", part$width[parbox], "pt}{",
part$halign_parbox[parbox], " ",
part$value[parbox], "}")
#* Add the multirow tag where appropriate
logic <- part$rowspan > 1
part$value[logic] <-
paste0("\\multirow{", part$rowspan[logic], "}{*}{", part$value[logic], "}")
#* Add blank multicolumn tags to fill multirow spaces
#* set the colspan and rowspan to prevent deletion.
#* They are set to -1 to indicate that they are fillers
logic <- part$html_row != part$row & part$html_col == part$col
part$value[logic] <- paste0("\\multicolumn{", part$colspan[logic], "}",
"{", part$left_border[logic], "c", part$right_border[logic], "}{}")
part$rowspan[logic] <- -1
part$colspan[logic] <- part$colspan[logic] * -1
#* Place multicolumn tags where needed
logic <- part$colspan > 1 | (part$left_border != "" | part$right_border != "") |
!(part$html_row != part$row & part$html_col == part$col)
part$value[logic] <-
paste0("\\multicolumn{", part$colspan[logic], "}{",
part$left_border[logic],
#* 'p' isn't a valid alignment in 'multicol', so we replace it with 'r'
sub("p", "r", substr(part$halign[logic], 1, 1)),
part$right_border[logic], "}{", part$value[logic], "}")
#* Remove value where a merged cell is not the display cell
ncol <- max(part$col)
part <- part[!(part$rowspan == 0 | part$colspan == 0), ]
#* In order to get the multirow to render correctly, the cell with
#* the multirow needs to be at the top of the block. This
#* rearranges the merged cells so that the multirow is at the top.
proper_multirow <- part[part$colspan != 1, ]
proper_multirow$group <- paste0(proper_multirow$html_row,
proper_multirow$html_col)
proper_multirow <- split(proper_multirow,
proper_multirow$group)
proper_multirow <- lapply(proper_multirow,
function(x){
x[order(x$colspan, decreasing = TRUE), ]
x$row <- sort(x$row)
x
})
proper_multirow <- do.call(".rbind_internal", proper_multirow)
part <- part[part$colspan == 1, ]
part <- .rbind_internal(part, proper_multirow)
part <- .make_dataframe_wide(part)
cbind(top_borders,
bottom_borders,
part)
}
#**************************************************
#**************************************************
#* Prepares code for horizontal borders
latex_horizontal_border_code_hhline <- function(x, col){
border <- str_split_fixed_base(x, " ", 3)
border[, 1] <- gsub("px", "pt", border[, 1])
border[, 2] <- ifelse(test= border[, 2] %in% c("dashed", "dotted", "groove",
"ridge", "inset", "outset"),
yes = "solid",
no = border[, 2])
if (border[, 2] %in% c("hidden", "none")) return("~")
if (border[, 2] == "solid"){
border_code <- paste0("<{\\arrayrulecolor",
convertColor(border[, 3]),
"}-")
return(border_code)
}
if (border[, 2] %in% c("double")){
border_code <- paste0(">{\\arrayrulecolor",
convertColor(border[, 3]),
"}=")
return(border_code)
}
}
utils::globalVariables(c("halign", "left_border", "right_border",
"bottom_border", "top_border",
"require_multicol", "height", "width",
"height_units", "width_units", "table_width",
"parbox", "width_by_char", "html_row",
"html_col", "rowspan", "colspan", "group"))
================================================
FILE: R/print_dust_markdown.R
================================================
print_dust_markdown <- function(x, ..., asis=TRUE,
interactive = getOption("pixie_interactive"))
{
if (is.null(interactive)) interactive <- interactive()
if (!is.null(x$caption) & x$caption_number) increment_pixie_count()
caption_number_prefix <-
if (x$caption_number) sprintf("Table %s: ", get_pixie_count())
else ""
#* Determine the number of divisions
#* It looks more complicated than it is, but the gist of it is
#* total number of divisions: ceiling(total_rows / longtable_rows)
#* The insane looking data frame is just to make a reference of what rows
#* go in what division.
if (!is.numeric(x$longtable) & x$longtable) longtable_rows <- 25L
else if (!is.numeric(x$longtable) & !x$longtable) longtable_rows <- as.integer(max(x$body$row))
else longtable_rows <- as.integer(x$longtable)
Divisions <- data.frame(div_num = rep(1:ceiling(max(x$body$row) / longtable_rows),
each = longtable_rows)[1:max(x$body$row)],
row_num = 1:max(x$body$row))
total_div <- max(Divisions$div_num)
#* If the table is not being run interactively (ie, in an rmarkdown script)
#* detect the type of output. The spacing between tables is output-specific
if (!interactive){
output_type <- knitr::opts_knit$get('rmarkdown.pandoc.to')
linebreak <- if (is.null(output_type)) " "
else if (output_type == "html") "<br>"
else if (output_type == "latex") "\\ \\linebreak"
else " "
}
else linebreak <- " "
#* Format the table divisions
head <- part_prep_markdown(x$head)
body <- part_prep_markdown(x$body)
foot <- if (!is.null(x$foot)) part_prep_markdown(x$foot) else NULL
interfoot <- if (!is.null(x$interfoot)) part_prep_markdown(x$interfoot) else NULL
names(body) <- names(head) <- head[1, ]
if (!is.null(foot)) names(foot) <- names(head)
if (!is.null(interfoot)) names(interfoot) <- names(head)
subhead <- head[-1, ]
subhead <- lapply(subhead, function(v) paste0("**", v, "**")) %>%
as.data.frame(stringsAsFactors=FALSE)
numeric_classes <- c("numeric", "double", "int")
#* Determine the alignments. Alignments in 'knitr::kable' are assigned
#* by the first letter of the HTML alignment. If no alignment is
#* assigned, a default is chosen based on the variable type. Numerics
#* are aligned right, characters are aligned left.
alignments <- x$head[x$head$row == 1, ]
alignments <- alignments[c("row", "col", "halign", "col_class")]
alignments$halign <- ifelse(alignments$halign == "",
ifelse(alignments$col_class %in% numeric_classes,
"r",
"l"),
substr(alignments$halign, 1, 1))
#* Run a for loop to generate all the code.
#* Not the most efficient way to do this, probably, but
#* it's easy to read and understand.
tbl_code <- ""
for (i in 1:total_div){
tbl <- .rbind_internal(if (nrow(head) > 1) subhead else NULL,
body[Divisions$row_num[Divisions$div_num == i], ],
if (i == total_div) foot else interfoot)
tbl_code <- paste0(tbl_code,
paste(c("", "",
knitr::kable(tbl,
format = "markdown",
align = substr(alignments$halign, 1, 1)),
"\n", linebreak, "\n", linebreak, "\n"),
collapse = "\n"))
if (!is.null(x$caption))
tbl_code <- paste0(caption_number_prefix, x$caption, "\n", tbl_code)
}
if (asis) knitr::asis_output(tbl_code)
else tbl_code
}
#**** Helper functions
part_prep_markdown <- function(part)
{
numeric_classes <- c("double", "numeric")
part <- perform_function(part)
#* Perform any rounding
logic <- part$round == "" & part$col_class %in% numeric_classes
part$round[logic] <- getOption("digits")
logic <- part$col_class %in% numeric_classes
if (any(logic))
part$value[logic] <-
as.character(roundSafe(part$value[logic], as.numeric(part$round[logic])))
#* Replacement
logic <- !is.na(part[["replace"]])
part[["value"]][logic] <- part[["replace"]][logic]
#* Bold text
logic <- part$bold
part$value[logic] <-
with(part, paste0("**", value[logic], "**"))
#* Italic text
logic <- part$italic
part$value[logic] <-
with(part, paste0("_", value[logic], "_"))
part$value[part$rowspan == 0] <- ""
part$value[part$colspan == 0] <- ""
#* Set NA (missing) values to na_string
logic <- is.na(part$value) & !is.na(part$na_string)
part$value[logic] <-
part$na_string[logic]
#* Spread to wide format for printing
.make_dataframe_wide(part)
}
================================================
FILE: R/pval_string.R
================================================
#' @name pval_string
#' @export pval_string
#'
#' @title Format P-values for Reports
#' @description Convert numeric p-values to character strings according to
#' pre-defined formatting parameters. Additional formats may be added
#' for required or desired reporting standards.
#'
#' @param p a numeric vector of p-values.
#' @param format A character string indicating the desired format for
#' the p-values. See Details for full descriptions.
#' @param digits For \code{"exact"} and \code{"scientific"}; indicates the
#' number of digits to precede scientific notation.
#' @param ... Additional arguments to be passed to \code{format}
#'
#' @details When \code{format = "default"}, p-values are formatted:
#' \enumerate{
#' \item \emph{p > 0.99}: "> 0.99"
#' \item \emph{0.99 > p > 0.10}: Rounded to two digits
#' \item \emph{0.10 > p > 0.001}: Rounded to three digits
#' \item \emph{0.001 > p}: "< 0.001"
#' }
#'
#' When \code{format = "exact"}, the exact p-value is printed with the
#' number of places after the deimal equal to \code{digits}. P-values smaller
#' that 1*(10^-\code{digits}) are printed in scientific notation.
#'
#' When \code{format = "scientific"}, all values are printed in scientific
#' notation with \code{digits} digits printed before the \code{e}.
#'
#' @section Functional Requirements:
#' \enumerate{
#' \item When \code{format = "default"}, print p-values greater than
#' 0.99 as "> 0.99"; greater than 0.10 with two digits;
#' greater than 0.001 with three digits; and less than 0.001 as
#' "< 0.001".
#' \item when \code{format = "exact"}, print the exact p-value out to at most
#' \code{digits} places past the decimal place.
#' \item When \code{format = "scientific"}, print the p-value in
#' scientific notation with up to \code{digits} values ahead of the
#' \code{e}.
#' \item Cast an error if \code{p} is not numeric on the interval [0, 1]
#' \item Cast an error if format is not one of \code{c("default", "exact",
#' "scientific")}.
#' \item Cast an error if \code{digits} is not \code{integerish(1)}.
#' }
#'
#' @author Benjamin Nutter
#'
#' @examples
#' p <- c(1, .999, .905, .505, .205, .125, .09531,
#' .05493, .04532, .011234, .0003431, .000000342)
#' pvalString(p, format="default")
#' pvalString(p, format="exact", digits=3)
#' pvalString(p, format="exact", digits=2)
#' pvalString(p, format="scientific", digits=3)
#' pvalString(p, format="scientific", digits=4)
#'
pval_string <- function(p, format=c("default", "exact", "scientific"),
digits=3, ...){
coll <- checkmate::makeAssertCollection()
checkmate::assert_numeric(x = p,
lower = 0,
upper = 1,
add = coll)
format <- checkmate::matchArg(x = format,
choices = c("default", "exact", "scientific"),
add = coll)
checkmate::assert_integerish(x = digits,
len = 1,
add = coll)
checkmate::reportAssertions(coll)
#* Alpha beta format
if (format == "default"){
ps <- ifelse(p > .99,
"> 0.99",
ifelse(p > 0.10,
format(round(p, 2),
digits = 2),
ifelse(p >= 0.001,
format(round(p, 3),
digits = 3),
"< 0.001")))
}
#* exact format
else if (format == "exact"){
ps <- ifelse(p < 1*(10^-digits),
format(p,
scientific = TRUE,
digits=digits),
format(round(p, digits),
digits = digits))
}
#* scientific notation format
else if (format == "scientific"){
ps <- format(p,
scientific = TRUE,
digits = digits)
}
ps
}
#' @rdname pval_string
#' @export
pvalString <- pval_string
================================================
FILE: R/rbind_internal.R
================================================
#' @name rbind_internal
#' @title Bind Rows in Base R
#'
#' @description Stack data frames on top of each other. Data frames do not have to
#' have all of the same columns.
#'
#' @param ... data frames
#' @param deparse.level See \code{deparse.level} in \code{rbind}.
#'
#' @author Benjamin Nutter
.rbind_internal <- function(..., deparse.level = 1){
df_list <- list(...)
df_list <- df_list[!vapply(df_list, is.null, logical(1))]
all_data_frame <- vapply(X = df_list,
FUN = inherits,
FUN.VALUE = logical(1),
what = "data.frame")
if (!all(all_data_frame)){
stop("All objects in ... must be data frames")
}
all_name <- unique(unlist(lapply(df_list, names)))
df_list <-
lapply(df_list,
function(d){
miss_var <- setdiff(all_name, names(d))
miss_frame <- lapply(miss_var,
function(x) rep(NA, nrow(d)))
miss_frame <- as.data.frame(miss_frame,
stringsAsFactors = FALSE)
names(miss_frame) <- miss_var
if (nrow(miss_frame) > 0){
cbind(d, miss_frame)
} else {
d
}
})
do.call("rbind", df_list)
}
================================================
FILE: R/redust.R
================================================
#' @rdname dust
#'
#' @param x A dust object
#' @param table A data frame of similar dimensions of the part being replaced.
#' @param part The part of the table to replace with \code{table}
#' @export
redust <- function(x, table, part = c("head", "foot", "interfoot", "body"))
{
UseMethod("redust")
}
#' @rdname dust
#' @export
redust.default <- function(x, table, part = c("head", "foot", "interfoot", "body"))
{
coll <- checkmate::makeAssertCollection()
#* x must have class 'dust'
checkmate::assertClass(x = x,
classes = "dust",
add = coll)
part_str <- checkmate::matchArg(x = part,
choices = c("head", "foot",
"interfoot", "body"),
add = coll)
colCounts <- vapply(x[c("head", "body", "foot", "interfoot")],
col_count, 1)
n_colCounts <- unique(colCounts[!is.na(colCounts)])
if (length(n_colCounts) > 1){
coll$push(
paste0("All parts of the table must have the same number of columns (or none).\n",
" Currently: ",
paste0(paste0(c("head", "body", "foot", "interfoot"), " (", colCounts, ")"),
collapse = ", "))
)
}
if (!all(colCounts[!is.na(colCounts)] %in% ncol(table)))
coll$push(
paste0("The current table has ", paste0(n_colCounts, collapse = "/"), " columns and you ",
"are attempting to impose a part\n",
" with ", ncol(table), " columns.")
)
checkmate::reportAssertions(coll)
col_name_class <-
x[["head"]][x[["head"]][["row"]] == 1, ]
col_name_class <- col_name_class[c("row", "col", "col_name", "col_class")]
col_name_class <- col_name_class[order(col_name_class[["row"]],
col_name_class[["col"]]), ]
part <- component_table(table)
part$col_name <- rep(col_name_class$col_name, each = nrow(table))
part$col_class <- rep(col_name_class$col_class, each = nrow(table))
x[[part_str]] <- part
x
}
#' @rdname dust
#' @export
redust.dust_list <- function(x, table, part = c("head", "foot", "interfoot", "body"))
{
structure(
lapply(X = x,
FUN = redust.default,
table = table,
part = part),
class = "dust_list"
)
}
#*****
col_count <- function(p){
if (is.null(p)) return(NA) else return(max(p$col))
}
================================================
FILE: R/reshape_data_internal.R
================================================
#' @name reshape_data_internal
#'
#' @title Reshape data frames for Pixiedust
#' @description Pixiedust reshapes data to have one row per cell in the table. This
#' permits adjustments to be made to individual cells. These internal functions
#' are provided to simplify the reshaping process. It is slower than using
#' the tidyr functions `gather` and `spread` (or whatever their newer counterparts
#' are), but keeps me off of other people's development schedules.
#'
#' @param data A \code{data.frame}
#'
#' @details No validations are performed in these functions, and it is assumed that
#' the input data set has the components it needs.
#'
#' @author Benjamin Nutter
#'
.make_dataframe_long <- function(data){
out <- stats::reshape(data = data,
varying = list(names(data)),
direction = "long")
names(out) <- c("col", "value", "row")
out$col_name <- names(data)[match(out$col, seq_along(names(data)))]
out <- out[c("row", "col", "col_name", "value")]
rownames(out) <- NULL
out
}
.make_dataframe_wide <- function(data){
col_order <- unique(data$col_name)
out <- reshape2::dcast(data,
row ~ col_name,
value.var = "value")
out[col_order]
}
================================================
FILE: R/sanitize_latex.R
================================================
#' @name sanitize_latex
#' @title Escape Characters for Printing in LaTeX Output
#'
#' @description \code{sanitize_latex} translates particular items in
#' character strings to LaTeX format, e.g., makes \code{a^2 = a\$^2\$}
#' for superscript within variable labels. LaTeX names of greek letters
#' (e.g., "alpha") will have backslashes added if \code{greek==TRUE}.
#' Math mode is inserted as needed. \code{sanitize_latex} assumes that
#' input text always has matches, e.g. \code{[) [] (] ()}, and that
#' surrounding by \code{\$\$} is OK.
#'
#' @param object \code{character} vector of strings to translate.
#' Any NAs are set to blank strings before conversion.
#' @param inn \code{character} vector. Additional strings to translate.
#' @param out \code{character} vector the same length as \code{inn}.
#' This gives the translated value of the corresonding element in
#' \code{inn}
#' @param greek \code{logical(1)}. set to \code{TRUE} to have
#' \code{sanitize_latex} put names for greek letters in math mode and
#' add backslashes.
#' @param pb \code{logical(1)} If \code{pb=TRUE}, \code{sanitize_latex} also
#' translates \code{[()]} to math mode using \code{\\left}, \code{\\right}.
#' @param na \code{character(1)} Single character string to translate
#' \code{NA} values to.
#' @param ... Additional arguments for other methods. Currently ignored.
#'
#' @return
#' Vector of chracter strings.
#'
#' @author
#' This code is lifted from the \code{Hmisc} package in order to
#' avoid depending on that package.
#'
#' Frank E. Harrell Jr.\cr
#' Department of Biostatistics,\cr
#' Vanderbilt University,\cr
#' f.harrell@@vanderbilt.edu\cr
#'
#' Richard M. Heiberger,\cr
#' Department of Statistics,\cr
#' Temple University, Philadelphia, PA.\cr
#' rmh@@temple.edu\cr
#'
#' David R. Whiting,\cr
#' School of Clinical Medical Sciences (Diabetes),\cr
#' University of Newcastle upon Tyne, UK.\cr
#' david.whiting@@ncl.ac.uk\cr
#'
#' @seealso \code{Hmisc::latexTranslate}, \code{Hmisc::sedit}
#'
#' @examples
#' sanitize_latex("75% of the cars were | more than $20,000 Delta = 1.30", greek = TRUE)
#'
#' @export
sanitize_latex <- function(object, inn=NULL, out=NULL, pb=FALSE,
greek=FALSE, na='', ...)
{
text <- ifelse(is.na(object), na, as.character(object))
inn <- c("|", "%", "#", "<=", "<", ">=", ">", "_", "\\243",
"&", inn,
if(pb)
c("[", "(", "]", ")"))
out <- c("$|$", "\\%", "\\#", "$\\leq$", "$<$", "$\\geq$", "$>$", "\\_",
"\\pounds", "\\&", out,
if(pb)
c("$\\left[", "$\\left(", "\\right]$", "\\right)$"))
text <- sedit(text, '$', 'DOLLARS', wild.literal=TRUE)
text <- sedit(text, inn, out)
##See if string contains an ^ - superscript followed by a number
## (number condition added 31aug02)
dig <- c('0','1','2','3','4','5','6','7','8','9')
for(i in seq_along(text)) {
lt <- nchar(text[i])
x <- substring(text[i], 1 : lt, 1 : lt)
j <- x == '^'
if(any(j)) {
is <- ((1 : lt)[j])[1] #get first ^
remain <- x[-(1 : is)]
k <- remain %in% c(' ',',',')',']','\\','$')
if(remain[1] %in% dig ||
(length(remain) > 1 && remain[1] == '-' && remain[2] %in% dig))
k[-1] <- k[-1] | !remain[-1] %in% dig
ie <- if(any(k)) is + ((1 : length(remain))[k])[1]
else
length(x)+1
##See if math mode already turned on (odd number of $ to left of ^)
dol <- if(sum(x[1 : is] == '$') %% 2) ''
else '$'
substring2(text[i],is,ie-1) <-
paste(dol, '^{', substring(text[i], is + 1, ie - 1), '}', dol,sep='')
}
if(greek) {
gl <- c('alpha','beta','gamma','delta','epsilon','varepsilon','zeta',
'eta','theta','vartheta','iota','kappa','lambda','mu','nu',
'xi','pi','varpi','rho','varrho','sigma','varsigma','tau',
'upsilon','phi','carphi','chi','psi','omega','Gamma','Delta',
'Theta','Lambda','Xi','Pi','Sigma','Upsilon','Phi','Psi','Omega')
for(w in gl)
text[i] <- gsub(paste('\\b', w, '\\b', sep=''),
paste('$\\\\',w,'$', sep=''),
text[i])
}
}
sedit(text, 'DOLLARS', '\\$', wild.literal=TRUE)
}
# UNEXPORTED --------------------------------------------------------
sedit <- function(text, from, to, test=NULL, wild.literal=FALSE)
{
to <- rep(to, length=length(from))
for(i in seq_along(text)) {
s <- text[i]
if(length(s))
for(j in 1:length(from)) {
old <- from[j]
front <- back <- FALSE
if(!wild.literal) {
if(substring(old,1,1) == '^') {
front <- TRUE;
old <- substring(old,2)
}
if(substring(old,nchar(old)) == '$') {
back <- TRUE; old <- substring(old, 1, nchar(old)-1)
}
}
new <- to[j]
lold <- nchar(old)
if(lold > nchar(s))
next
ex.old <- substring(old, 1:lold, 1:lold)
if(!wild.literal && any(ex.old == '*'))
s <- replace.substring.wild(s, old, new, test=test, front=front, back=back)
else {
l.s <- nchar(s)
is <- 1:(l.s-lold+1)
if(front)
is <- 1
ie <- is + lold - 1
if(back)
ie <- l.s
ss <- substring(s, is, ie)
k <- ss == old
if(!any(k))
next
k <- is[k]
substring2(s, k, k+lold-1) <- new
}
}
text[i] <- s
}
text
}
'substring2<-' <- function(text, first, last=100000, value)
{
if(is.character(first)) {
if(!missing(last))
stop('wrong # arguments')
return(sedit(text, first, value)) ## value was setto 25May01
}
lf <- length(first)
if(length(text) == 1 && lf > 1) {
if(missing(last))
last <- nchar(text)
last <- rep(last, length=lf)
for(i in 1:lf) {
text <- paste(if(first[i]>1)
substring(text, 1, first[i]-1),
value,
substring(text, last[i]+1), sep='')
if(i < lf) {
j <- (i+1):lf
w <- nchar(value) - (last[i]-first[i]+1)
first[j] <- first[j] + w
last[j] <- last[j] + w
}
}
return(text)
}
text <- paste(ifelse(first>1,substring(text, 1, first-1),''), value,
substring(text, last+1), sep='')
text
}
replace.substring.wild <- function(text, old, new, test=NULL,
front=FALSE, back=FALSE)
{
if(length(text)>1)
stop('only works with a single character string')
if(missing(front) && missing(back)) {
if(substring(old,1,1) == '^') {
front <- TRUE;
old <- substring(old,2)
}
if(substring(old, nchar(old)) == '$') {
back <- TRUE
old <- substring(old, 1, nchar(old)-1)
}
}
if((front || back) && old!='*')
stop('front and back (^ and $) only work when the rest of old is *')
star.old <- substring.location(old,'*')
if(length(star.old$first)>1)
stop('does not handle > 1 * in old')
if(sum(star.old$first) == 0)
stop('no * in old')
star.new <- substring.location(new,'*')
if(length(star.new$first)>1)
stop('cannot have > 1 * in new')
if(old == '*' && (front | back)) {
if(front && back)
stop('may not specify both front and back (or ^ and $) with old=*')
if(length(test) == 0)
stop('must specify test= with old=^* or *$')
et <- nchar(text)
if(front) {
st <- rep(1, et);
en <- et:1
} else {
st <- 1:et;
en <- rep(et,et)
}
qual <- test(substring(text, st, en))
if(!any(qual))
return(text)
st <- (st[qual])[1]
en <- (en[qual])[1]
text.before <- if(st == 1)''
else substring(text, 1, st-1)
text.after <- if(en == et)''
else substring(text, en+1, et)
text.star <- substring(text, st, en)
new.before.star <-
if(star.new$first>1)
substring(new, 1, star.new$first-1)
else ''
new.after.star <- if(star.new$last == length(new))''
else substring(new, star.new$last+1)
return(paste(text.before, new.before.star, text.star, new.after.star,
text.after, sep=''))
}
old.before.star <- if(star.old$first == 1)''
else substring(old, 1, star.old$first-1)
old.after.star <- if(star.old$last == nchar(old))''
else substring(old, star.old$first+1)
if(old.before.star == '')
loc.before <- list(first=0, last=0)
else {
loc.before <- substring.location(text, old.before.star)
loc.before <- list(first=loc.before$first[1], last=loc.before$last[1])
}
if(sum(loc.before$first+loc.before$last) == 0)
return(text)
loc.after <- if(old.after.star == '') list(first=0, last=0)
else {
la <- substring.location(text, old.after.star,
restrict=c(loc.before$last+1,1e10))
lastpos <- length(la$first)
la <- list(first=la$first[lastpos], last=la$last[lastpos])
if(la$first+la$last == 0)
return(text)
la
}
loc.star <- list(first=loc.before$last+1,
last=if(loc.after$first == 0) nchar(text)
else loc.after$first-1)
star.text <- substring(text, loc.star$first, loc.star$last)
if(length(test) && !test(star.text))
return(text)
if(star.new$first == 0)
return(paste(if(loc.before$first>1)substring(text,1,loc.before$first-1),
new, sep=''))
new.before.star <- if(star.new$first == 1)''
else substring(new, 1, star.new$first-1)
new.after.star <- if(star.new$last == nchar(new)) ''
else substring(new, star.new$first+1)
paste(if(loc.before$first>1)substring(text,1,loc.before$first-1),
new.before.star,
substring(text,loc.star$first,loc.star$last),
new.after.star,
if(loc.after$last<nchar(text) && loc.after$last>0)
substring(text,loc.after$last+1),
sep='')
}
substring.location <- function(text, string, restrict)
{
if(length(text) > 1)
stop('only works with a single character string')
l.text <- nchar(text)
l.string <- nchar(string)
if(l.string > l.text)
return(list(first=0,last=0))
if(l.string == l.text)
return(if(text == string)
list(first=1,last=l.text)
else
list(first=0,last=0))
is <- 1:(l.text-l.string+1)
ss <- substring(text, is, is+l.string-1)
k <- ss == string
if(!any(k))
return(list(first=0,last=0))
k <- is[k]
if(!missing(restrict))
k <- k[k>=restrict[1] & k<=restrict[2]]
if(length(k) == 0)
return(list(first=0,last=0))
list(first=k, last=k+l.string-1)
}
## if(version$major < 5) 14Sep00
substring2 <- function(text, first, last=100000L)
base::substring(text, first, last)
================================================
FILE: R/sprinkle.R
================================================
#' @name sprinkle
#' @export sprinkle
#'
#' @title Define Customizations to a Table
#' @description Customizations to a \code{dust} table are added by "sprinkling"
#' with a little extra pixie dust. Sprinkles are a collection of attributes
#' to be applied over a subset of table cells. They may be added to any
#' part of the table, or to the table as a whole.
# Parameters --------------------------------------------------------
#' @param x A dust object
#' @param rows A numeric vector specifying the rows of the table to sprinkle.
#' See details for more about sprinkling.
#' @param cols A numeric (or character) vector specifying the columns (or
#' column names) to sprinkle. See details for more about sprinkling.
#' @param part A character string denoting which part of the table to modify.
#' @param fixed \code{logical(1)} indicating if the values in \code{rows}
#' and \code{cols} should be read as fixed coordinate pairs. By default,
#' sprinkles are applied at the intersection of \code{rows} and \code{cols},
#' meaning that the arguments do not have to share the same length.
#' When \code{fixed = TRUE}, they must share the same length.
#' @param recycle A \code{character} one that determines how sprinkles are
#' managed when the sprinkle input doesn't match the length of the region
#' to be sprinkled. By default, recycling is turned off. Recycling
#' may be performed across rows first (left to right, top to bottom),
#' or down columns first (top to bottom, left to right).
#' @param ... named arguments, each of length 1, defining the customizations
#' for the given cells. See "Sprinkles" for a listing of these arguments.
#'
# Details -----------------------------------------------------------
#' @details Sprinkling is done over the intersection of rows and columns
#' (unless \code{fixed = TRUE}. If
#' rows but no columns are specified, sprinkling is performed over all columns
#' of the given given rows. The reverse is true for when columns but no rows
#' are specified. If neither columns nor rows are specified, the attribute
#' is applied over all of the cells in the table part denoted in \code{part}.
#'
#' If at least one of \code{border}, \code{border_thickness}, \code{border_units},
#' \code{border_style} or \code{border_color} is specified, the remaining
#' unspecified attributes assume their default values.
#'
#' Other sprinkle pairings are \code{height} and \code{height_units};
#' \code{width} and \code{width_units}; \code{font_size} and \code{font_size_units};
#' \code{bg_pattern} and \code{bg_pattern_by}
#'
#' The sprinkles \code{bg} and \code{bg_pattern} may not be used together.
#'
#' A more detailed demonstration of the use of sprinkles is available in
#' \code{vignette("pixiedust", package = "pixiedust")}
#'
#' Using \code{sprinkle_table}, sprinkles may be applied to the columns of multiple tables. Table
#' parts are required to have the same number of columns, but not necessarily the same number
#' of rows, which is why the \code{rows} argument is not available for the \code{sprinkle_table}.
#' In contrast to \code{sprinkle}, the \code{part} argument in \code{sprinkle_table} will
#' accept multiple parts. If any of the named parts is \code{"table"}, the sprinkle will be
#' applied to the columns of all of the parts.
#'
# Sprinkles ---------------------------------------------------------
#' @section Sprinkles:
#' The following table describes the valid sprinkles that may be defined in the
#' \code{...} dots argument. All sprinkles may be defined for any output type, but
#' only sprinkles recognized by that output type will be applied when printed.
#' A more readable format of this information is available in
#' \code{vignette("sprinkles", package = "pixiedust")}.
#'
#' \tabular{lll}{
#' bg \tab \tab \cr
#' \tab action \tab Modifies the background color of a cell. \cr
#' \tab default \tab \cr
#' \tab accepts \tab dvips color names; rgb(R,G,B); rgba(R,G,B,A); \cr
#' \tab \tab #RRGGBB; #RRGGBBAA. See the "Colors" section \cr
#' \tab \tab for further details. \cr
#' \tab console \tab Not recognized \cr
#' \tab markdown \tab Not recognized \cr
#' \tab html \tab Accepts any of the listed formats; \cr
#' \tab \tab recognizes transparency \cr
#' \tab latex \tab Accepts any of the listed formats, \cr
#' \tab \tab but ignores transparency \cr
#' bg_pattern \tab \tab \cr
#' \tab action \tab Generates a pattern of background colors. \cr
#' \tab \tab Can be used to make striping \cr
#' \tab \tab by rows or by columns. \cr
#' \tab default \tab c("#FFFFFF", "#DDDDDD") \cr
#' \tab accepts \tab A vector of color names: \cr
#' \tab \tab dvips color names; rgb(R,G,B); rgba(R,G,B,A); \cr
#' \tab \tab #RRGGBB; #RRGGBBAA \cr
#' \tab console \tab Not recognized \cr
#' \tab markdown \tab Not recognized \cr
#' \tab html \tab Accepts any of the listed formats; \cr
#' \tab \tab recognizes transparency \cr
#' \tab latex \tab Accepts any of the listed formats, \cr
#' \tab \tab but ignores transparency \cr
#' bg_pattern_by \tab \tab \cr
#' \tab action \tab Determines if a `bg_pattern` is patterned \cr
#' \tab \tab by row or by columns. \cr
#' \tab default \tab "rows" \cr
#' \tab accepts \tab "rows", "columns", "cols" \cr
#' \tab console \tab Not recognized \cr
#' \tab markdown \tab Not recognized \cr
#' \tab html \tab Recognized \cr
#' \tab latex \tab Recognized \cr
#' bold \tab \tab \cr
#' \tab action \tab Renders text within a cell in bold. \cr
#' \tab default \tab FALSE \cr
#' \tab accepts \tab logical(1) \cr
#' \tab console \tab Recognized; rendered as double asterisks on either\cr
#' \tab \tab side of the text \cr
#' \tab markdown \tab Recognized \cr
#' \tab html \tab Recognized \cr
#' \tab latex \tab Recognized \cr
#' border_collapse \tab \tab \cr
#' \tab action \tab Sets the `border-collapse` property in an \cr
#' \tab \tab HTML table. The property sets whether the \cr
#' \tab \tab table borders are collapsed into a \cr
#' \tab \tab single border or detached as in standard HTML. \cr
#' \tab default \tab TRUE \cr
#' \tab accepts \tab logical(1) \cr
#' \tab console \tab Not recognized \cr
#' \tab markdown \tab Not recognized \cr
#' \tab html \tab Recognized \cr
#' \tab latex \tab Not recognized \cr
#' border \tab \tab \cr
#' \tab action \tab Sets a border on the specified side of a cell. \cr
#' \tab default \tab \cr
#' \tab accepts \tab Any combination of "all", "bottom", "left", "top",\cr
#' \tab \tab "right". Using "all" results in all borders \cr
#' \tab \tab being drawn, regardless of what other values are \cr
#' \tab \tab passed with it. \cr
#' \tab console \tab Not recognized \cr
#' \tab markdown \tab Not recognized \cr
#' \tab html \tab Recognized \cr
#' \tab latex \tab Recognized \cr
#' border_color \tab \tab \cr
#' \tab action \tab Sets the color of the borders specified for a cell. \cr
#' \tab default \tab "Black" \cr
#' \tab accepts \tab character(1) \cr
#' \tab \tab dvips color names; rgb(R,G,B); rgba(R,G,B,A); \cr
#' \tab \tab #RRGGBB; #RRGGBBAA. See the "Colors" section \cr
#' \tab \tab for further details. \cr
#' \tab console \tab Not recognized \cr
#' \tab markdown \tab Not recognized \cr
#' \tab html \tab Recognized \cr
#' \tab latex \tab Recognized \cr
#' border_style \tab \tab \cr
#' \tab action \tab Sets the border style for a specified cell \cr
#' \tab default \tab "solid" \cr
#' \tab accepts \tab character(1) \cr
#' \tab \tab "solid", "dashed", "dotted", "double", "groove", \cr
#' \tab \tab "ridge", "inset", "outset", "hidden", "none" \cr
#' \tab console \tab Not recognized \cr
#' \tab markdown \tab Not recognized \cr
#' \tab html \tab Accepts any of the values listed. \cr
#' \tab latex; hhline = FALSE \tab accepts "solid", "dashed", "dotted", \cr
#' \tab \tab "hidden", "none" \cr
#' \tab \tab "dotted" is silently changed to "dashed" \cr
#' \tab \tab "hidden" and "none" are equivalent. \cr
#' \tab latex; hhline = TRUE \tab accepts "solid", "double", "hidden", "none" \cr
#' \tab \tab "hidden" and "none" are equivalent. \cr
#' border_thickness \tab \tab \cr
#' \tab action \tab Sets the thickness of the specified border \cr
#' \tab default \tab 1 \cr
#' \tab accepts \tab numeric(1) \cr
#' \tab console \tab Not recognized \cr
#' \tab markdown \tab Not recognized \cr
#' \tab html \tab Recognized \cr
#' \tab latex \tab Recognized \cr
#' border_units \tab \tab \cr
#' \tab action \tab Sets the unit of measure for the specified border \cr
#' \tab \tab thickness \cr
#' \tab default \tab "pt" \cr
#' \tab accepts \tab "pt", "px" \cr
#' \tab console \tab Not recognized \cr
#' \tab markdown \tab Not recognized \cr
#' \tab html \tab Recognized \cr
#' \tab latex \tab Silently changes "px" to "pt" \cr
#' caption \tab \tab \cr
#' \tab action \tab Adds or alters the `caption` property \cr
#' \tab default \tab \cr
#' \tab accepts \tab character(1) \cr
#' \tab console \tab Recognized \cr
#' \tab markdown \tab Recognized \cr
#' \tab html \tab Recognized \cr
#' \tab latex \tab Recognized \cr
#' discrete \tab \tab \cr
#' \tab action \tab Adds distinct background colors based on \cr
#' \tab \tab discrete values in the selected region. \cr
#' \tab \tab May not be used concurrently with \code{bg}. \cr
#' \tab \tab \code{"font"} is an alias for \code{"font_color"} \cr
#' \tab \tab and \code{"border"} is an alias for \cr
#' \tab \tab all borders. \cr
#' \tab default \tab "bg" \cr
#' \tab accepts \tab "bg", "font", "font_color", "border", \cr
#' \tab \tab "left_border", "top_border", "right_border", \cr
#' \tab \tab "bottom_border" \cr
#' \tab console \tab Not recognized \cr
#' \tab markdown \tab Not recognized \cr
#' \tab html \tab Recognized \cr
#' \tab latex \tab Recognized \cr
#' discrete_color \tab \tab \cr
#' \tab action \tab Sets the color palette from which \code{discrete} \cr
#' \tab \tab selects background colors. If \code{NULL} \cr
#' \tab \tab colors are automatically selected using \cr
#' \tab \tab the \code{scales} package. \cr
#' \tab default \tab \code{getOption("pixie_discrete_pal", NULL)} \cr
#' \tab accepts \tab character \cr
#' \tab console \tab Not recognized \cr
#' \tab markdown \tab Not recognized \cr
#' \tab html \tab Recognized \cr
#' \tab latex \tab Recognized \cr
#' float \tab \tab \cr
#' \tab action \tab Sets the `float` property \cr
#' \tab default \tab TRUE \cr
#' \tab accepts \tab logical(1) \cr
#' \tab console \tab Not recognized \cr
#' \tab markdown \tab Not recognized \cr
#' \tab html \tab Not recognized \cr
#' \tab latex \tab Recognized \cr
#' fn \tab \tab \cr
#' \tab action \tab Applies a function to the value of a cell. \cr
#' \tab \tab The function should be an \cr
#' \tab \tab expression that acts on the variable `value`. \cr
#' \tab \tab For example, \code{quote(format(value, nsmall = 3))} \cr
#' \tab default \tab \cr
#' \tab accepts \tab call \cr
#' \tab console \tab Recognized \cr
#' \tab markdown \tab Recognized \cr
#' \tab html \tab Recognized \cr
#' \tab latex \tab Recognized \cr
#' font_color \tab \tab \cr
#' \tab action \tab Sets the color of the cell text \cr
#' \tab default \tab Black \cr
#' \tab accepts \tab dvips color names; rgb(R,G,B); rgba(R,G,B,A); \cr
#' \tab \tab #RRGGBB; #RRGGBBAA. See the "Colors" section \cr
#' \tab \tab for further details. \cr
#' \tab console \tab Not recognized \cr
#' \tab markdown \tab Not recognized \cr
#' \tab html \tab Recognized; transparency recognized \cr
#' \tab latex \tab Recognized; transparency ignored \cr
#' font_family \tab \tab \cr
#' \tab action \tab Sets the font for the text \cr
#' \tab default \tab Times New Roman \cr
#' \tab accepts \tab character(1) \cr
#' \tab \tab http://www.w3schools.com/cssref/css_websafe_fonts.asp \cr
#' \tab console \tab Not recognized \cr
#' \tab markdown \tab Not recognized \cr
#' \tab html \tab Recognized \cr
#' \tab latex \tab Not recognized \cr
#' font_size \tab \tab \cr
#' \tab action \tab Sets the size of the font in the cell \cr
#' \tab default \tab \cr
#' \tab accepts \tab numeric(1) \cr
#' \tab console \tab Not recognized \cr
#' \tab markdown \tab Not recognized \cr
#' \tab html \tab Recognized \cr
#' \tab latex \tab Recognized \cr
#' font_size_units \tab \tab \cr
#' \tab action \tab Determines the units in which `font_size` \cr
#' \tab \tab is measured \cr
#' \tab default \tab "px" \cr
#' \tab accepts \tab "px", "pt", "\%", "em" \cr
#' \tab console \tab Not recognized \cr
#' \tab markdown \tab Not recognized \cr
#' \tab html \tab Recognized \cr
#' \tab latex \tab Only recognizes "pt" and "em". \cr
#' \tab \tab All others are coerced to "pt" \cr
#' gradient \tab \tab \cr
#' \tab action \tab Adds distinct background colors based on \cr
#' \tab \tab progressively increasing values in the \cr
#' \tab \tab selected region. May not be used concurrently \cr
#' \tab \tab with \code{bg}. \cr
#' \tab \tab \code{"font"} is an alias for \code{"font_color"} \cr
#' \tab \tab and \code{"border"} is an alias for \cr
#' \tab \tab all borders. \cr
#' \tab default \tab "bg" \cr
#' \tab accepts \tab "bg", "font", "font_color", "border", \cr
#' \tab \tab "left_border", "top_border", "right_border", \cr
#' \tab \tab "bottom_border" \cr
#' \tab console \tab Not recognized \cr
#' \tab markdown \tab Not recognized \cr
#' \tab html \tab Recognized \cr
#' \tab latex \tab Recognized \cr
#' gradient_colors \tab \tab \cr
#' \tab action \tab Provides the colors between which to \cr
#' \tab \tab shade gradients. \cr
#' \tab default \tab \code{getOptions("pixie_gradient_pal", NULL)} \cr
#' \tab accepts \tab character \cr
#' \tab console \tab Not recognized \cr
#' \tab markdown \tab Not recognized \cr
#' \tab html \tab Recognized \cr
#' \tab latex \tab Recognized \cr
#' gradient_cut \tab \tab \cr
#' \tab action \tab Determines the breaks points for the \cr
#' \tab \tab gradient shading. When \code{NULL} \cr
#' \tab \tab equally spaced quantiles are used, the \cr
#' \tab \tab number of which are determined by \cr
#' \tab \tab \code{gradient_n}. \cr
#' \tab default \tab NULL \cr
#' \tab accepts \tab numeric \cr
#' \tab console \tab Not recognized \cr
#' \tab markdown \tab Not recognized \cr
#' \tab html \tab Recognized \cr
#' \tab latex \tab Recognized \cr
#' gradient_n \tab \tab \cr
#' \tab action \tab Determines the number of shades to use \cr
#' \tab \tab between the colors in \code{gradient_colors}.\cr
#' \tab default \tab 10 \cr
#' \tab accepts \tab numeric \cr
#' \tab console \tab Not recognized \cr
#' \tab markdown \tab Not recognized \cr
#' \tab html \tab Recognized \cr
#' \tab latex \tab Recognized \cr
#' gradient_na \tab \tab \cr
#' \tab action \tab Sets the color of NA values when gradients \cr
#' \tab \tab are shaded. \cr
#' \tab default \tab grey \cr
#' \tab accepts \tab character(1) \cr
#' \tab console \tab Not recognized \cr
#' \tab markdown \tab Not recognized \cr
#' \tab html \tab Recognized \cr
#' \tab latex \tab Recognized \cr
#' halign \tab \tab \cr
#' \tab action \tab Sets the horizontal alignment of the text in \cr
#' \tab \tab the cell \cr
#' \tab default \tab \cr
#' \tab accepts \tab "left", "center", "right" \cr
#' \tab console \tab Not recognized \cr
#' \tab markdown \tab Recognized; numeric values will auto align to the \cr
#' \tab \tab right if no value given. \cr
#' \tab html \tab Recognized. Does not currently employ auto \cr
#' \tab \tab alignment of numeric values, but this may change. \cr
#' \tab latex \tab Recognized; numeric values will auto align to \cr
#' \tab \tab the right if no value given. \cr
#' height \tab \tab \cr
#' \tab action \tab Sets the height of the cell \cr
#' \tab default \tab \cr
#' \tab accepts \tab numeric(1) \cr
#' \tab console \tab Not recognized \cr
#' \tab markdown \tab Not recognized \cr
#' \tab html \tab Recognized \cr
#' \tab latex \tab Recognized \cr
#' height_units \tab \tab \cr
#' \tab action \tab Determines the units in which `height` is measured \cr
#' \tab default \tab "pt" \cr
#' \tab accepts \tab "px", "pt", "cm", "in", "\%" \cr
#' \tab console \tab Not recognized \cr
#' \tab markdown \tab Not recognized \cr
#' \tab html \tab Recognized \cr
#' \tab latex \tab Recognized; "px" is coerced to "pt" \cr
#' hhline \tab \tab \cr
#' \tab action \tab Toggles the option for cell border drawing with \cr
#' \tab \tab the `hhline` LaTeX package \cr
#' \tab default \tab FALSE \cr
#' \tab accepts \tab logical(1) \cr
#' \tab console \tab Not recognized \cr
#' \tab markdown \tab Not recognized
gitextract_aljgexrk/ ├── .Rbuildignore ├── .gitignore ├── .travis.yml ├── CRAN-RELEASE ├── DESCRIPTION ├── NAMESPACE ├── NEWS ├── R/ │ ├── as.data.frame.dust.R │ ├── chain.R │ ├── dust.R │ ├── fixed_header_css.R │ ├── gaze.R │ ├── get_dust_part.R │ ├── glance_foot.R │ ├── index_to_sprinkle.R │ ├── is_valid_color.R │ ├── knit_print.dust.R │ ├── medley.R │ ├── medley_all_borders.R │ ├── perform_function.R │ ├── pixie_count.R │ ├── pixiedust-pkg.R │ ├── pixiedust_print_method.R │ ├── pixieply.R │ ├── print.dust.R │ ├── print_dust_console.R │ ├── print_dust_html.R │ ├── print_dust_latex.R │ ├── print_dust_latex_hhline.R │ ├── print_dust_markdown.R │ ├── pval_string.R │ ├── rbind_internal.R │ ├── redust.R │ ├── reshape_data_internal.R │ ├── sanitize_latex.R │ ├── sprinkle.R │ ├── sprinkle_align.R │ ├── sprinkle_bg.R │ ├── sprinkle_bg_pattern.R │ ├── sprinkle_bookdown.R │ ├── sprinkle_border.R │ ├── sprinkle_border_collapse.R │ ├── sprinkle_caption.R │ ├── sprinkle_caption_number.R │ ├── sprinkle_colnames.R │ ├── sprinkle_discrete.R │ ├── sprinkle_fixed_header.R │ ├── sprinkle_float.R │ ├── sprinkle_fn.R │ ├── sprinkle_font.R │ ├── sprinkle_gradient.R │ ├── sprinkle_height.R │ ├── sprinkle_hhline.R │ ├── sprinkle_html_preserve.R │ ├── sprinkle_justify.R │ ├── sprinkle_label.R │ ├── sprinkle_longtable.R │ ├── sprinkle_merge.R │ ├── sprinkle_na_string.R │ ├── sprinkle_pad.R │ ├── sprinkle_print_method.R │ ├── sprinkle_replace.R │ ├── sprinkle_rotate_degree.R │ ├── sprinkle_round.R │ ├── sprinkle_sanitize.R │ ├── sprinkle_tabcolsep.R │ ├── sprinkle_table.R │ ├── sprinkle_width.R │ ├── str_extract_base.R │ ├── sysdata.rda │ ├── tidy_levels_labels.R │ └── zzz.R ├── README.Rmd ├── README.md ├── cran-comments.md ├── inst/ │ ├── save_sprinkles_rda.R │ ├── sprinkle_documentation.csv │ ├── sprinkle_reference.csv │ └── sprinkles.csv ├── man/ │ ├── as.data.frame.dust.Rd │ ├── chain.Rd │ ├── compoundAssignment.Rd │ ├── dust.Rd │ ├── fixed_header_css.Rd │ ├── gaze.Rd │ ├── get_dust_part.Rd │ ├── glance_foot.Rd │ ├── index_to_sprinkle.Rd │ ├── is_valid_color.Rd │ ├── knit_print.dust.Rd │ ├── medley.Rd │ ├── medley_all_borders.Rd │ ├── pixie_count.Rd │ ├── pixiedust.Rd │ ├── pixiedust_print_method.Rd │ ├── pixieply.Rd │ ├── print.dust.Rd │ ├── pval_string.Rd │ ├── rbind_internal.Rd │ ├── reshape_data_internal.Rd │ ├── sanitize_latex.Rd │ ├── sprinkle.Rd │ ├── sprinkle_align.Rd │ ├── sprinkle_bg.Rd │ ├── sprinkle_bg_pattern.Rd │ ├── sprinkle_bookdown.Rd │ ├── sprinkle_border.Rd │ ├── sprinkle_border_collapse.Rd │ ├── sprinkle_caption.Rd │ ├── sprinkle_caption_number.Rd │ ├── sprinkle_colnames.Rd │ ├── sprinkle_discrete.Rd │ ├── sprinkle_fixed_header.Rd │ ├── sprinkle_float.Rd │ ├── sprinkle_fn.Rd │ ├── sprinkle_font.Rd │ ├── sprinkle_gradient.Rd │ ├── sprinkle_height.Rd │ ├── sprinkle_hhline.Rd │ ├── sprinkle_html_preserve.Rd │ ├── sprinkle_justify.Rd │ ├── sprinkle_label.Rd │ ├── sprinkle_longtable.Rd │ ├── sprinkle_merge.Rd │ ├── sprinkle_na_string.Rd │ ├── sprinkle_pad.Rd │ ├── sprinkle_replace.Rd │ ├── sprinkle_rotate_degree.Rd │ ├── sprinkle_round.Rd │ ├── sprinkle_sanitize.Rd │ ├── sprinkle_tabcolsep.Rd │ ├── sprinkle_width.Rd │ ├── str_extract_base.Rd │ └── tidy_levels_labels.Rd ├── pixiedust.Rproj ├── tests/ │ ├── testthat/ │ │ ├── test-as.data.frame.R │ │ ├── test-colors.R │ │ ├── test-dust.R │ │ ├── test-dust.grouped_df.R │ │ ├── test-fixed_header_css.R │ │ ├── test-gaze.R │ │ ├── test-get_dust_part.R │ │ ├── test-glance_foot.R │ │ ├── test-index_to_sprinkle.R │ │ ├── test-is_valid_color.R │ │ ├── test-medley.R │ │ ├── test-medley_all_borders.R │ │ ├── test-perform_function.R │ │ ├── test-pixie_count.R │ │ ├── test-pixieply.R │ │ ├── test-print.dust-explicit.R │ │ ├── test-print.dust.R │ │ ├── test-print_dust_html.R │ │ ├── test-print_dust_latex.R │ │ ├── test-print_dust_latex_hhline.R │ │ ├── test-print_dust_methods.R │ │ ├── test-pvalString.R │ │ ├── test-redust.R │ │ ├── test-roundSafe.R │ │ ├── test-sanitize_latex.R │ │ ├── test-sprinkle_align.R │ │ ├── test-sprinkle_bg.R │ │ ├── test-sprinkle_bg_pattern.R │ │ ├── test-sprinkle_bookdown.R │ │ ├── test-sprinkle_border.R │ │ ├── test-sprinkle_border_collapse.R │ │ ├── test-sprinkle_caption.R │ │ ├── test-sprinkle_caption_number.R │ │ ├── test-sprinkle_colnames.R │ │ ├── test-sprinkle_discrete.R │ │ ├── test-sprinkle_dust_list.R │ │ ├── test-sprinkle_fixed_header.R │ │ ├── test-sprinkle_float.R │ │ ├── test-sprinkle_fn.R │ │ ├── test-sprinkle_font.R │ │ ├── test-sprinkle_gradient.R │ │ ├── test-sprinkle_height.R │ │ ├── test-sprinkle_hhline.R │ │ ├── test-sprinkle_html_preserve.R │ │ ├── test-sprinkle_justify.R │ │ ├── test-sprinkle_label.R │ │ ├── test-sprinkle_longtable.R │ │ ├── test-sprinkle_merge.R │ │ ├── test-sprinkle_na_string.R │ │ ├── test-sprinkle_pad.R │ │ ├── test-sprinkle_replace.R │ │ ├── test-sprinkle_rotate_degree.R │ │ ├── test-sprinkle_round.R │ │ ├── test-sprinkle_sanitize.R │ │ ├── test-sprinkle_tabcolsep.R │ │ ├── test-sprinkle_table.R │ │ ├── test-sprinkle_width.R │ │ ├── test-sprinkles.R │ │ └── test-tidy_label_level.R │ └── testthat.R ├── vignettes/ │ ├── advancedMagic.Rmd │ ├── no_css.css │ ├── pixiedust.Rmd │ └── sprinkles.Rmd └── xtable_vs_pixiedust.Rmd
Condensed preview — 200 files, each showing path, character count, and a content snippet. Download the .json file or copy for the full structured content (934K chars).
[
{
"path": ".Rbuildignore",
"chars": 231,
"preview": "^CRAN-RELEASE$\n^.*\\.Rproj$\n^\\.Rproj\\.user$\n^\\.gitignore$\n^\\.travis.yml$\n^\\.travis\\.yml$\n^cran-comments.md$\n^README\\.Rmd$"
},
{
"path": ".gitignore",
"chars": 293,
"preview": "# History files\n.Rhistory\n.Rapp.history\n\n# Example code in package build process\n*-Ex.R\n\n# RStudio files\n.Rproj.user/\n\n#"
},
{
"path": ".travis.yml",
"chars": 440,
"preview": "# Sample .travis.yml for R projects\n\nlanguage: r\nwarnings_are_errors: true\nsudo: setuid root\n\nenv:\n global:\n - CRAN: h"
},
{
"path": "CRAN-RELEASE",
"chars": 126,
"preview": "This package was submitted to CRAN on 2021-01-15.\nOnce it is accepted, delete this file and tag the release (commit b38a"
},
{
"path": "DESCRIPTION",
"chars": 1399,
"preview": "Package: pixiedust\nTitle: Tables so Beautifully Fine-Tuned You Will Believe It's Magic\nVersion: 0.9.4\nAuthors@R: c(perso"
},
{
"path": "NAMESPACE",
"chars": 4084,
"preview": "# Generated by roxygen2: do not edit by hand\n\nS3method(as.data.frame,dust)\nS3method(as.data.frame,dust_list)\nS3method(du"
},
{
"path": "NEWS",
"chars": 15578,
"preview": "### 0.9.0 (2020-05-10)\n\n* Package now carries fewer dependencies.\n* No new features. \n* Note: There is no plan for furth"
},
{
"path": "R/as.data.frame.dust.R",
"chars": 3558,
"preview": "#' @name as.data.frame.dust\n#' \n#' @title Convert \\code{dust} Object to Data Frame \n#' @description Sprinkles are applie"
},
{
"path": "R/chain.R",
"chars": 663,
"preview": "#' @name %>%\n#' @rdname chain\n#' @importFrom magrittr %>%\n#' @export %>%\n#' @usage lhs \\%>\\% rhs\n#' \n#' @title magrittr "
},
{
"path": "R/dust.R",
"chars": 19317,
"preview": "#' @name dust\n#' @export dust\n#' \n#' @title Dust Table Construction\n#' @description Dust tables consist of four primary "
},
{
"path": "R/fixed_header_css.R",
"chars": 9823,
"preview": "#' @name fixed_header_css\r\n#' @title Generate CSS Code for Fixed Header Tables\r\n#' \r\n#' @description Tables with a fixed"
},
{
"path": "R/gaze.R",
"chars": 5051,
"preview": "#' @name gaze\n#' @title Mimic Stargazer Output to Display Multiple Models\n#' \n#' @description Tidy multiple models and d"
},
{
"path": "R/get_dust_part.R",
"chars": 2344,
"preview": "#' @name get_dust_part\n#' @title Get a Portion of the Table Stored in a \\code{dust} Object\n# Documentation -------------"
},
{
"path": "R/glance_foot.R",
"chars": 6344,
"preview": "#' @name glance_foot\n#' \n#' @title Prepare Glance Statistics for \\code{pixiedust} Table Footer\n#' @description Retrieves"
},
{
"path": "R/index_to_sprinkle.R",
"chars": 8518,
"preview": "#' @name index_to_sprinkle\n#' @title Determine the Indices to Sprinkle\n#' \n#' @description The sprinkle methods accept t"
},
{
"path": "R/is_valid_color.R",
"chars": 1722,
"preview": "#' @name is_valid_color\n#' @title Test a Character String For Pixiedust Recognized Color Format\n#' \n#' @description \\cod"
},
{
"path": "R/knit_print.dust.R",
"chars": 944,
"preview": "#' @name knit_print.dust\n#' @title \\code{knitr} Printing Function \n#' \n#' @description Custom printing functions for dis"
},
{
"path": "R/medley.R",
"chars": 2288,
"preview": "#' @name medley\n#' \n#' @title Sprinkle Medleys\n#' @description \\code{pixiedust} can get to be pretty verbose if you are "
},
{
"path": "R/medley_all_borders.R",
"chars": 2422,
"preview": "#' @name medley_all_borders\n#' @title Apply Cell Borders to All Cells in a Region\n#' \n#' @description For most output, s"
},
{
"path": "R/perform_function.R",
"chars": 1509,
"preview": "#* perform_function\n#* An internal function for dustpan\n#* applies the requested function. \n#* Applying the function wa"
},
{
"path": "R/pixie_count.R",
"chars": 1729,
"preview": "#' @name pixie_count\n#' @title Access and manipulate table numbers counters\n#' \n#' @description While LaTeX provides the"
},
{
"path": "R/pixiedust-pkg.R",
"chars": 4930,
"preview": "#' Tables So Beautifully Fine-Tuned You Will Believe It's Magic.\n#' \n#' The \\code{pixiedust} mission is to provide a use"
},
{
"path": "R/pixiedust_print_method.R",
"chars": 1012,
"preview": "#' @name pixiedust_print_method\n#' @title Determine the Current Print Method\n#' \n#' @description The user has the option"
},
{
"path": "R/pixieply.R",
"chars": 2668,
"preview": "#' @name pixieply\n#' @title Apply Functions Over `dust_list` Objects\n#' \n#' @description The \\code{sprinkle} methods wor"
},
{
"path": "R/print.dust.R",
"chars": 3110,
"preview": "#' @name print.dust\n#' @export \n#' @method print dust\n#' \n#' @title Print A \\code{dust} Table\n#' @description Apply the "
},
{
"path": "R/print_dust_console.R",
"chars": 4142,
"preview": "print_dust_console <- function(x, ..., return_df = FALSE, asis=TRUE)\n{\n \n if (!is.null(x$caption) & x$caption_number) "
},
{
"path": "R/print_dust_html.R",
"chars": 10917,
"preview": "print_dust_html <- function(x, ..., asis=TRUE, \n linebreak_at_end = getOption(\"pixie_html_lin"
},
{
"path": "R/print_dust_latex.R",
"chars": 22206,
"preview": "\nprint_dust_latex <- function(x, ..., asis=TRUE)\n{\n \n if (!is.null(x$caption) & x$caption_number) increment_pixie_coun"
},
{
"path": "R/print_dust_latex_hhline.R",
"chars": 14296,
"preview": "#* This provides an alternative method for generating horizontal lines in \n#* LaTeX tables, using the hhline package. T"
},
{
"path": "R/print_dust_markdown.R",
"chars": 4897,
"preview": "print_dust_markdown <- function(x, ..., asis=TRUE,\n interactive = getOption(\"pixie_intera"
},
{
"path": "R/pval_string.R",
"chars": 4121,
"preview": "#' @name pval_string\n#' @export pval_string\n#' \n#' @title Format P-values for Reports\n#' @description Convert numeric p-"
},
{
"path": "R/rbind_internal.R",
"chars": 1355,
"preview": "#' @name rbind_internal\n#' @title Bind Rows in Base R\n#' \n#' @description Stack data frames on top of each other. Data f"
},
{
"path": "R/redust.R",
"chars": 2471,
"preview": "#' @rdname dust\n#' \n#' @param x A dust object\n#' @param table A data frame of similar dimensions of the part being repla"
},
{
"path": "R/reshape_data_internal.R",
"chars": 1305,
"preview": "#' @name reshape_data_internal\n#' \n#' @title Reshape data frames for Pixiedust\n#' @description Pixiedust reshapes data t"
},
{
"path": "R/sanitize_latex.R",
"chars": 10996,
"preview": "#' @name sanitize_latex\n#' @title Escape Characters for Printing in LaTeX Output\n#' \n#' @description \\code{sanitize_late"
},
{
"path": "R/sprinkle.R",
"chars": 40203,
"preview": "#' @name sprinkle\n#' @export sprinkle\n#' \n#' @title Define Customizations to a Table\n#' @description Customizations to a"
},
{
"path": "R/sprinkle_align.R",
"chars": 7550,
"preview": "#' @name sprinkle_align\n#' @title Sprinkle Alignment of Table Cells\n#' \n#' @description The alignment refers to the posi"
},
{
"path": "R/sprinkle_bg.R",
"chars": 7059,
"preview": "#' @name sprinkle_bg\n#' @title Sprinkle the Background Color of a Cell\n#' \n#' @description Background colors may be used"
},
{
"path": "R/sprinkle_bg_pattern.R",
"chars": 7267,
"preview": "#' @name sprinkle_bg_pattern\n#' @title Row and Column Background Striping\n#' \n#' @description Provides background color "
},
{
"path": "R/sprinkle_bookdown.R",
"chars": 3424,
"preview": "#' @name sprinkle_bookdown\r\n#' @title Change the Bookdown Property in a Dust Table\r\n#' \r\n#' @description Tables built fo"
},
{
"path": "R/sprinkle_border.R",
"chars": 12548,
"preview": "#' @name sprinkle_border\n#' @title Sprinkle Changes to Cell Borders\n#' \n#' @description Cell borders may be used to give"
},
{
"path": "R/sprinkle_border_collapse.R",
"chars": 3785,
"preview": "#' @name sprinkle_border_collapse\r\n#' @title Change the Border Collapse Property in a Dust Table\r\n#' \r\n#' @description T"
},
{
"path": "R/sprinkle_caption.R",
"chars": 2760,
"preview": "#' @name sprinkle_caption\r\n#' @title Change the Caption in a Dust Table\r\n#' \r\n#' @description The table caption is often"
},
{
"path": "R/sprinkle_caption_number.R",
"chars": 3383,
"preview": "#' @name sprinkle_caption_number\n#' @title Change the Caption in a Dust Table\n#' \n#' @description The table caption is o"
},
{
"path": "R/sprinkle_colnames.R",
"chars": 3541,
"preview": "#' @name sprinkle_colnames\n#' @export sprinkle_colnames\n#' \n#' @title Column Names for \\code{dust} Tables\n#' @descriptio"
},
{
"path": "R/sprinkle_discrete.R",
"chars": 10237,
"preview": "#' @name sprinkle_discrete\n#' @title Change Color Features by Discrete Values\n#' \n#' @description Distinct values within"
},
{
"path": "R/sprinkle_fixed_header.R",
"chars": 17646,
"preview": "#' @name sprinkle_fixed_header\r\n#' @title Assign a Fixed Header to an HTML Table\r\n#'\r\n#' @description Long tables to be "
},
{
"path": "R/sprinkle_float.R",
"chars": 3133,
"preview": "#' @name sprinkle_float\r\n#' @title Change the float Property in a Dust Table\r\n#' \r\n#' @description Alter the floating be"
},
{
"path": "R/sprinkle_fn.R",
"chars": 5804,
"preview": "#' @name sprinkle_fn\r\n#' @title Apply a function to a selection of cells\r\n#' \r\n#' @description The pre-defined sprinkles"
},
{
"path": "R/sprinkle_font.R",
"chars": 12422,
"preview": "#' @name sprinkle_font\n#' @title Sprinkle the Characteristics of Text in a Cell\n#' \n#' @description Text can be made to "
},
{
"path": "R/sprinkle_gradient.R",
"chars": 13616,
"preview": "#' @name sprinkle_gradient\n#' @title Change Color Features by Binning Numeric Values\n#' \n#' @description Numeric values "
},
{
"path": "R/sprinkle_height.R",
"chars": 7339,
"preview": "#' @name sprinkle_height\n#' @title Adjust Table Cell Height\n#' \n#' @description Customize the height of a cell in a tabl"
},
{
"path": "R/sprinkle_hhline.R",
"chars": 3290,
"preview": "#' @name sprinkle_hhline\r\n#' @title Change the hhline Property in a Dust Table\r\n#' \r\n#' @description The \\code{hhline} p"
},
{
"path": "R/sprinkle_html_preserve.R",
"chars": 3154,
"preview": "#' @name sprinkle_html_preserve\n#' @title Change the HTML Preserve Property in a Dust Table\n#' \n#' @description By defau"
},
{
"path": "R/sprinkle_justify.R",
"chars": 3593,
"preview": "#' @name sprinkle_justify\r\n#' @title Change the Caption in a Dust Table\r\n#' \r\n#' @description The justification of the t"
},
{
"path": "R/sprinkle_label.R",
"chars": 3070,
"preview": "#' @name sprinkle_label\r\n#' @title Change the Border Collapse Property in a Dust Table\r\n#' \r\n#' @description The \\code{l"
},
{
"path": "R/sprinkle_longtable.R",
"chars": 3691,
"preview": "#' @name sprinkle_longtable\r\n#' @title Change the Longtable Property in a Dust Table\r\n#' \r\n#' @description The LaTeX \\co"
},
{
"path": "R/sprinkle_merge.R",
"chars": 9457,
"preview": "#' @name sprinkle_merge\n#' @title Sprinkle Table Cells to Merge\n#' \n#' @description Merging cells creates more space for"
},
{
"path": "R/sprinkle_na_string.R",
"chars": 6615,
"preview": "#' @name sprinkle_na_string\n#' @title Sprinkle Appearance of NA's\n#' \n#' @description The appearance of \\code{NA} values"
},
{
"path": "R/sprinkle_pad.R",
"chars": 6547,
"preview": "#' @name sprinkle_pad\n#' @title Sprinkle the Padding of a Cell\n#' \n#' @description Padding for HTML tables indicates how"
},
{
"path": "R/sprinkle_print_method.R",
"chars": 1380,
"preview": "#' @rdname sprinkle\n#' @param print_method A character string giving the print method for the table. \n#' Note: \\code{\""
},
{
"path": "R/sprinkle_replace.R",
"chars": 6489,
"preview": "#' @name sprinkle_replace\n#' @title Replace Contents of Selected Cells\n#' \n#' @description At times it may be necessary "
},
{
"path": "R/sprinkle_rotate_degree.R",
"chars": 6513,
"preview": "#' @name sprinkle_rotate_degree\n#' @title Sprinkle Appearance of NA's\n#' \n#' @description The content of cells may be ro"
},
{
"path": "R/sprinkle_round.R",
"chars": 6366,
"preview": "#' @name sprinkle_round\n#' @title Sprinkle Appearance of NA's\n#' \n#' @description The appearance of \\code{NA} values in "
},
{
"path": "R/sprinkle_sanitize.R",
"chars": 7185,
"preview": "#' @name sprinkle_sanitize\r\n#' @title Sanitize Characters for LaTeX Outputs\r\n#' \r\n#' @description Certain characters in "
},
{
"path": "R/sprinkle_tabcolsep.R",
"chars": 3199,
"preview": "#' @name sprinkle_tabcolsep\r\n#' @title Change the tabcolsep Property in a Dust Table\r\n#' \r\n#' @description The \\code{tab"
},
{
"path": "R/sprinkle_table.R",
"chars": 1284,
"preview": "#' @rdname sprinkle\n#' @export\n\nsprinkle_table <- function(x, cols = NULL, ..., part = \"table\")\n{\n UseMethod(\"sprinkle_"
},
{
"path": "R/sprinkle_width.R",
"chars": 7322,
"preview": "#' @name sprinkle_width\n#' @title Adjust Table Cell Width\n#' \n#' @description Customize the width of a cell in a table. "
},
{
"path": "R/str_extract_base.R",
"chars": 932,
"preview": "#' @name str_extract_base\n#' @title Extract Patterns from Character Strings\n#' \n#' @description This is a utility functi"
},
{
"path": "R/tidy_levels_labels.R",
"chars": 10354,
"preview": "#' @name tidy_levels_labels \n#' \n#' @title Term and Level Descriptions for \\code{pixiedust} Tables\n#' \n#' @description D"
},
{
"path": "R/zzz.R",
"chars": 135,
"preview": ".onLoad <- function(libname,pkgname)\n{\n options(pixie_count = 0L)\n}\n\n.onUnload <- function(libPath)\n{\n options(pixie_c"
},
{
"path": "README.Rmd",
"chars": 5609,
"preview": "---\noutput:\n md_document:\n variant: markdown_github\n---\n\n<!-- README.md is generated from README.Rmd. Please edit th"
},
{
"path": "README.md",
"chars": 11481,
"preview": "<!-- README.md is generated from README.Rmd. Please edit that file -->\n\n# pixiedust\n\nAfter tidying up your analyses with"
},
{
"path": "cran-comments.md",
"chars": 678,
"preview": "## Test environments\n* local Windows install (R-4.3.1; Windows 10 build 19045)\n* win-builder (release R 4.3.1; 2023-06-1"
},
{
"path": "inst/save_sprinkles_rda.R",
"chars": 163,
"preview": "SprinkleRef <- \n read.csv(\"inst/sprinkle_reference.csv\",\n stringsAsFactors = FALSE,\n na = \"\")\n\nsave"
},
{
"path": "inst/sprinkle_documentation.csv",
"chars": 12979,
"preview": "sprinkle,action_format,description\nbg,,\n,action,Modifies the background color of a cell.\n,default,\n,accepts,\"dvips color"
},
{
"path": "inst/sprinkle_reference.csv",
"chars": 2805,
"preview": "sprinkle,group,assert_fn,class,arg_len,arg_classes,arg_choices,arg_several.ok,default\nbg,simple,assertCharacter,characte"
},
{
"path": "inst/sprinkles.csv",
"chars": 2680,
"preview": "sprinkle, implemented,console,markdown,html,latex\nbg, x, , , x, x\nbg_pat"
},
{
"path": "man/as.data.frame.dust.Rd",
"chars": 2264,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/as.data.frame.dust.R\n\\name{as.data.frame.d"
},
{
"path": "man/chain.Rd",
"chars": 319,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/chain.R\n\\name{\\%>\\%}\n\\alias{\\%>\\%}\n\\title{"
},
{
"path": "man/compoundAssignment.Rd",
"chars": 399,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/chain.R\n\\name{\\%<>\\%}\n\\alias{\\%<>\\%}\n\\titl"
},
{
"path": "man/dust.Rd",
"chars": 10782,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/dust.R, R/redust.R\n\\name{dust}\n\\alias{dust"
},
{
"path": "man/fixed_header_css.Rd",
"chars": 6145,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/fixed_header_css.R\n\\name{fixed_header_css}"
},
{
"path": "man/gaze.Rd",
"chars": 1764,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/gaze.R\n\\name{gaze}\n\\alias{gaze}\n\\title{Mim"
},
{
"path": "man/get_dust_part.Rd",
"chars": 1275,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/get_dust_part.R\n\\name{get_dust_part}\n\\alia"
},
{
"path": "man/glance_foot.Rd",
"chars": 3357,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/glance_foot.R\n\\name{glance_foot}\n\\alias{gl"
},
{
"path": "man/index_to_sprinkle.Rd",
"chars": 3643,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/index_to_sprinkle.R\n\\name{index_to_sprinkl"
},
{
"path": "man/is_valid_color.Rd",
"chars": 794,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/is_valid_color.R\n\\name{is_valid_color}\n\\al"
},
{
"path": "man/knit_print.dust.Rd",
"chars": 605,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/knit_print.dust.R\n\\name{knit_print.dust}\n\\"
},
{
"path": "man/medley.Rd",
"chars": 1444,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/medley.R\n\\name{medley}\n\\alias{medley}\n\\ali"
},
{
"path": "man/medley_all_borders.Rd",
"chars": 1205,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/medley_all_borders.R\n\\name{medley_all_bord"
},
{
"path": "man/pixie_count.Rd",
"chars": 1511,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/pixie_count.R\n\\name{pixie_count}\n\\alias{pi"
},
{
"path": "man/pixiedust.Rd",
"chars": 5124,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/pixiedust-pkg.R\n\\docType{package}\n\\name{pi"
},
{
"path": "man/pixiedust_print_method.Rd",
"chars": 838,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/pixiedust_print_method.R\n\\name{pixiedust_p"
},
{
"path": "man/pixieply.Rd",
"chars": 2215,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/pixieply.R\n\\name{pixieply}\n\\alias{pixieply"
},
{
"path": "man/print.dust.Rd",
"chars": 2223,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/print.dust.R\n\\name{print.dust}\n\\alias{prin"
},
{
"path": "man/pval_string.Rd",
"chars": 2644,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/pval_string.R\n\\name{pval_string}\n\\alias{pv"
},
{
"path": "man/rbind_internal.Rd",
"chars": 488,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/rbind_internal.R\n\\name{rbind_internal}\n\\al"
},
{
"path": "man/reshape_data_internal.Rd",
"chars": 866,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/reshape_data_internal.R\n\\name{reshape_data"
},
{
"path": "man/sanitize_latex.Rd",
"chars": 2233,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/sanitize_latex.R\n\\name{sanitize_latex}\n\\al"
},
{
"path": "man/sprinkle.Rd",
"chars": 32805,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/sprinkle.R, R/sprinkle_print_method.R,\n% "
},
{
"path": "man/sprinkle_align.Rd",
"chars": 4163,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/sprinkle_align.R\n\\name{sprinkle_align}\n\\al"
},
{
"path": "man/sprinkle_bg.Rd",
"chars": 4500,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/sprinkle_bg.R\n\\name{sprinkle_bg}\n\\alias{sp"
},
{
"path": "man/sprinkle_bg_pattern.Rd",
"chars": 3057,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/sprinkle_bg_pattern.R\n\\name{sprinkle_bg_pa"
},
{
"path": "man/sprinkle_bookdown.Rd",
"chars": 1805,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/sprinkle_bookdown.R\n\\name{sprinkle_bookdow"
},
{
"path": "man/sprinkle_border.Rd",
"chars": 6404,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/sprinkle_border.R\n\\name{sprinkle_border}\n\\"
},
{
"path": "man/sprinkle_border_collapse.Rd",
"chars": 1916,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/sprinkle_border_collapse.R\n\\name{sprinkle_"
},
{
"path": "man/sprinkle_caption.Rd",
"chars": 1426,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/sprinkle_caption.R\n\\name{sprinkle_caption}"
},
{
"path": "man/sprinkle_caption_number.Rd",
"chars": 1757,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/sprinkle_caption_number.R\n\\name{sprinkle_c"
},
{
"path": "man/sprinkle_colnames.Rd",
"chars": 1680,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/sprinkle_colnames.R\n\\name{sprinkle_colname"
},
{
"path": "man/sprinkle_discrete.Rd",
"chars": 4558,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/sprinkle_discrete.R\n\\name{sprinkle_discret"
},
{
"path": "man/sprinkle_fixed_header.Rd",
"chars": 7744,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/sprinkle_fixed_header.R\n\\name{sprinkle_fix"
},
{
"path": "man/sprinkle_float.Rd",
"chars": 1602,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/sprinkle_float.R\n\\name{sprinkle_float}\n\\al"
},
{
"path": "man/sprinkle_fn.Rd",
"chars": 3626,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/sprinkle_fn.R\n\\name{sprinkle_fn}\n\\alias{sp"
},
{
"path": "man/sprinkle_font.Rd",
"chars": 5967,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/sprinkle_font.R\n\\name{sprinkle_font}\n\\alia"
},
{
"path": "man/sprinkle_gradient.Rd",
"chars": 5452,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/sprinkle_gradient.R\n\\name{sprinkle_gradien"
},
{
"path": "man/sprinkle_height.Rd",
"chars": 4025,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/sprinkle_height.R\n\\name{sprinkle_height}\n\\"
},
{
"path": "man/sprinkle_hhline.Rd",
"chars": 1708,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/sprinkle_hhline.R\n\\name{sprinkle_hhline}\n\\"
},
{
"path": "man/sprinkle_html_preserve.Rd",
"chars": 1561,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/sprinkle_html_preserve.R\n\\name{sprinkle_ht"
},
{
"path": "man/sprinkle_justify.Rd",
"chars": 1968,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/sprinkle_justify.R\n\\name{sprinkle_justify}"
},
{
"path": "man/sprinkle_label.Rd",
"chars": 1543,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/sprinkle_label.R\n\\name{sprinkle_label}\n\\al"
},
{
"path": "man/sprinkle_longtable.Rd",
"chars": 1814,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/sprinkle_longtable.R\n\\name{sprinkle_longta"
},
{
"path": "man/sprinkle_merge.Rd",
"chars": 4074,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/sprinkle_merge.R\n\\name{sprinkle_merge}\n\\al"
},
{
"path": "man/sprinkle_na_string.Rd",
"chars": 3703,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/sprinkle_na_string.R\n\\name{sprinkle_na_str"
},
{
"path": "man/sprinkle_pad.Rd",
"chars": 4053,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/sprinkle_pad.R\n\\name{sprinkle_pad}\n\\alias{"
},
{
"path": "man/sprinkle_replace.Rd",
"chars": 3552,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/sprinkle_replace.R\n\\name{sprinkle_replace}"
},
{
"path": "man/sprinkle_rotate_degree.Rd",
"chars": 3596,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/sprinkle_rotate_degree.R\n\\name{sprinkle_ro"
},
{
"path": "man/sprinkle_round.Rd",
"chars": 3538,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/sprinkle_round.R\n\\name{sprinkle_round}\n\\al"
},
{
"path": "man/sprinkle_sanitize.Rd",
"chars": 3872,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/sprinkle_sanitize.R\n\\name{sprinkle_sanitiz"
},
{
"path": "man/sprinkle_tabcolsep.Rd",
"chars": 1516,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/sprinkle_tabcolsep.R\n\\name{sprinkle_tabcol"
},
{
"path": "man/sprinkle_width.Rd",
"chars": 4121,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/sprinkle_width.R\n\\name{sprinkle_width}\n\\al"
},
{
"path": "man/str_extract_base.Rd",
"chars": 732,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/str_extract_base.R\n\\name{str_extract_base}"
},
{
"path": "man/tidy_levels_labels.Rd",
"chars": 6873,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/tidy_levels_labels.R\n\\name{tidy_levels_lab"
},
{
"path": "pixiedust.Rproj",
"chars": 302,
"preview": "Version: 1.0\n\nRestoreWorkspace: Default\nSaveWorkspace: Default\nAlwaysSaveHistory: Default\n\nEnableCodeIndexing: Yes\nUseSp"
},
{
"path": "tests/testthat/test-as.data.frame.R",
"chars": 3532,
"preview": "context(\"as.data.frame.dust\")\n\n# Functional Requirement 1 ------------------------------------------\n\ntest_that(\n \"FR 1"
},
{
"path": "tests/testthat/test-colors.R",
"chars": 1182,
"preview": "context(\"Pixiedust Colors\")\n\nx <- dust(lm(mpg ~ qsec + factor(am) + wt + factor(gear), data = mtcars))\n\ntest_that(\n \"lo"
},
{
"path": "tests/testthat/test-dust.R",
"chars": 2835,
"preview": "context(\"Create a dust object\")\n\nfit <- lm(mpg ~ qsec + factor(am) + wt + factor(gear), data = mtcars)\n\ntest_that(\"Creat"
},
{
"path": "tests/testthat/test-dust.grouped_df.R",
"chars": 293,
"preview": "context(\"Dust a grouped_df\")\n\ntest_that(\"ungroup a grouped_df\",\n{\n expect_silent(\n dust(mtcars %>%\n "
},
{
"path": "tests/testthat/test-fixed_header_css.R",
"chars": 5187,
"preview": "context(\"fixed_header_css.R\")\n\n# Functional Requirement 1 ------------------------------------------\n\ntest_that(\n \"If p"
},
{
"path": "tests/testthat/test-gaze.R",
"chars": 1306,
"preview": "context(\"gaze.R\")\n\nfit1 <- lm(mpg ~ qsec + wt + factor(gear),\n data = mtcars)\n\nfit2 <- lm(mpg ~ disp + qsec + "
},
{
"path": "tests/testthat/test-get_dust_part.R",
"chars": 2325,
"preview": "context(\"get_dust_part\")\n\nfoot <- \n colMeans(mtcars) %>% \n matrix(nrow = 1) %>% \n as.data.frame(stringsAsFactors = FA"
},
{
"path": "tests/testthat/test-glance_foot.R",
"chars": 1675,
"preview": "context(\"glance_foot\")\n\nmtcars2 <- mtcars\nmtcars2 <- \n labelVector::set_label(\n mtcars2,\n mpg = \"Gas Mileage\",\n "
},
{
"path": "tests/testthat/test-index_to_sprinkle.R",
"chars": 1236,
"preview": "context(\"index_to_sprinkle.R\")\n\nx <- dust(head(mtcars))\n\n# Tests to cover aspects of index_to_sprinkle note picked up by"
},
{
"path": "tests/testthat/test-is_valid_color.R",
"chars": 4416,
"preview": "context(\"is_valid_color\")\n\n# Functional Requirement --------------------------------------------\n\ntest_that(\n \"Returns "
},
{
"path": "tests/testthat/test-medley.R",
"chars": 374,
"preview": "context(\"Medleys\")\n\nfit <- lm(mpg ~ qsec + factor(am) + wt * factor(gear), data = mtcars)\n\ntest_that(\"medley_bw\",\n{\n ex"
},
{
"path": "tests/testthat/test-medley_all_borders.R",
"chars": 896,
"preview": "context(\"medley_all_borders\")\n\nfit <- lm(mpg ~ qsec + factor(am) + wt * factor(gear), data = mtcars)\n\ntest_that(\"medley_"
},
{
"path": "tests/testthat/test-perform_function.R",
"chars": 727,
"preview": "context(\"perform_function\")\n\ntest_that(\"Apply a calculation\",\n{\n fit <- lm(mpg ~ qsec + factor(am) + wt + factor(gear),"
},
{
"path": "tests/testthat/test-pixie_count.R",
"chars": 458,
"preview": "context(\"pixie_count\")\n\ntest_that(\"get_pixie_count\",\n{\n expect_equal(get_pixie_count(), 0)\n})\n\ntest_that(\"set_pixie_cou"
},
{
"path": "tests/testthat/test-pixieply.R",
"chars": 493,
"preview": "context(\"pixieply\")\n\ntest_that(\"apply medley to dust_list\",\n{\n expect_silent(\n pixieply(\n dust(mtcars %>%\n "
},
{
"path": "tests/testthat/test-print.dust-explicit.R",
"chars": 997,
"preview": "context(\"print.dust-explicit\")\n\ntest_that(\"print.dust for console output\",\n{\n expect_output(\n print(dust(mtcars) %>%"
},
{
"path": "tests/testthat/test-print.dust.R",
"chars": 3207,
"preview": "context(\"print.dust\")\r\n\r\ntest_that(\"printing to console succeeds with defaults\",\r\n{\r\n fit <- lm(mpg ~ qsec + factor(am)"
},
{
"path": "tests/testthat/test-print_dust_html.R",
"chars": 695,
"preview": "context(\"print_dust_html\")\n\ntest_that(\n \"print_dust_html with fixed header\",\n {\n skip_on_cran()\n x <- dust(mtcar"
},
{
"path": "tests/testthat/test-print_dust_latex.R",
"chars": 4647,
"preview": "context(\"print_dust_latex\")\n\ntest_that(\n \"print_dust_latex\",\n {\n skip_on_cran()\n fit <- lm(mpg ~ qsec + factor(a"
},
{
"path": "tests/testthat/test-print_dust_latex_hhline.R",
"chars": 4472,
"preview": "context(\"print_dust_latex_hhline\")\n\ntest_that(\n \"print_dust_latex_hhline\",\n {\n skip_on_cran()\n fit <- lm(mpg ~ q"
},
{
"path": "tests/testthat/test-print_dust_methods.R",
"chars": 6334,
"preview": "context(\"print_dust_methods\")\n\ntest_that(\"print_dust_console\",\n{\n skip_on_cran()\n fit <- lm(mpg ~ qsec + factor(am) + "
},
{
"path": "tests/testthat/test-pvalString.R",
"chars": 2058,
"preview": "context(\"pval_string\")\n\n# Functional Requirement 1 ------------------------------------------\n\ntest_that(\n \"pval_string"
},
{
"path": "tests/testthat/test-redust.R",
"chars": 800,
"preview": "context(\"redust\")\n\ntest_that(\"redust: reject tables with dissimilar column dimension\",\n{\n x <- dust(mtcars[1:10, ])\n e"
},
{
"path": "tests/testthat/test-roundSafe.R",
"chars": 215,
"preview": "context(\"roundSafe\")\n\ntest_that(\"roundSafe: skip rounding for characters\",\n{\n x <- c(1.765, \"hello\", 8.3985, \"world\")\n "
},
{
"path": "tests/testthat/test-sanitize_latex.R",
"chars": 844,
"preview": "context(\"sanitize_latex.R\")\n\ntest_that(\n \"Sanitize basic characters.\",\n {\n expect_equal(\n sanitize_latex(c(\"|\""
},
{
"path": "tests/testthat/test-sprinkle_align.R",
"chars": 5324,
"preview": "context(\"sprinkle_align\")\n\nx <- dust(head(mtcars))\n\n# Functional Requirement 1 -----------------------------------------"
},
{
"path": "tests/testthat/test-sprinkle_bg.R",
"chars": 3069,
"preview": "context(\"sprinkle_bg\")\n\nx <- dust(head(mtcars))\n\n# Functional Requirement 1 ------------------------------------------\n\n"
},
{
"path": "tests/testthat/test-sprinkle_bg_pattern.R",
"chars": 2707,
"preview": "context(\"sprinkle_bg_pattern\")\n\nx <- dust(head(mtcars))\n\n# Functional Requirement 1 ------------------------------------"
},
{
"path": "tests/testthat/test-sprinkle_bookdown.R",
"chars": 1107,
"preview": "context(\"sprinkle_bookdown\")\n\nx <- dust(mtcars)\n\n# Functional Requirement 1 ------------------------------------------\n\n"
},
{
"path": "tests/testthat/test-sprinkle_border.R",
"chars": 7930,
"preview": "context(\"sprinkle_border\")\n\nx <- dust(head(mtcars))\n\n# Functional Requirement 1 ----------------------------------------"
},
{
"path": "tests/testthat/test-sprinkle_border_collapse.R",
"chars": 989,
"preview": "context(\"sprinkle_border_collapse\")\n\nx <- dust(mtcars)\n\n# Functional Requirement 1 -------------------------------------"
},
{
"path": "tests/testthat/test-sprinkle_caption.R",
"chars": 1113,
"preview": "context(\"sprinkle_caption\")\n\nx <- dust(mtcars)\n\n# Functional Requirement 1 ------------------------------------------\n\nt"
},
{
"path": "tests/testthat/test-sprinkle_caption_number.R",
"chars": 1170,
"preview": "context(\"sprinkle_caption_number\")\n\nx <- dust(mtcars)\n\n# Functional Requirement 1 --------------------------------------"
},
{
"path": "tests/testthat/test-sprinkle_colnames.R",
"chars": 1399,
"preview": "context(\"sprinkle_colnames\")\n\ntest_that(\"sprinkle_colnames produces output\",\n{\n x <- dust(lm(mpg ~ qsec + factor(am) + "
},
{
"path": "tests/testthat/test-sprinkle_discrete.R",
"chars": 4938,
"preview": "context(\"sprinkle_discrete\")\n\nx <- dust(mtcars)\n\n# Functional Requirement 1 ------------------------------------------\n\n"
},
{
"path": "tests/testthat/test-sprinkle_dust_list.R",
"chars": 752,
"preview": "context(\"sprinkling dust_list\")\n\ndlist <- dust(mtcars %>%\n dplyr::group_by(am, vs),\n ungroup"
},
{
"path": "tests/testthat/test-sprinkle_fixed_header.R",
"chars": 9382,
"preview": "context(\"sprinkle_fixed_header.R\")\n\nx <- dust(head(mtcars))\n\n# Functional Requirement 1 --------------------------------"
},
{
"path": "tests/testthat/test-sprinkle_float.R",
"chars": 1030,
"preview": "context(\"sprinkle_float\")\n\nx <- dust(mtcars)\n\n# Functional Requirement 1 ------------------------------------------\n\ntes"
},
{
"path": "tests/testthat/test-sprinkle_fn.R",
"chars": 2639,
"preview": "context(\"sprinkle_fn\")\r\n\r\nx <- dust(head(mtcars))\r\n\r\n# Functional Requirement 1 ----------------------------------------"
},
{
"path": "tests/testthat/test-sprinkle_font.R",
"chars": 8164,
"preview": "context(\"sprinkle_font\")\n\nx <- dust(head(mtcars))\n\n# Functional Requirement 1 ------------------------------------------"
},
{
"path": "tests/testthat/test-sprinkle_gradient.R",
"chars": 8614,
"preview": "context(\"sprinkle_gradient\")\n\nx <- dust(mtcars)\n\ncolor_range <- \n scales::gradient_n_pal(c(\"#132B43\", \"#56B1F7\"))(seq(0"
},
{
"path": "tests/testthat/test-sprinkle_height.R",
"chars": 3223,
"preview": "context(\"sprinkle_height\")\n\nx <- dust(head(mtcars))\n\n# Functional Requirement 1 ----------------------------------------"
},
{
"path": "tests/testthat/test-sprinkle_hhline.R",
"chars": 1031,
"preview": "context(\"sprinkle_hhline\")\n\nx <- dust(mtcars)\n\n# Functional Requirement 1 ------------------------------------------\n\nte"
},
{
"path": "tests/testthat/test-sprinkle_html_preserve.R",
"chars": 1262,
"preview": "context(\"sprinkle_html_preserve\")\n\nx <- dust(mtcars)\n\n# Functional Requirement 1 ---------------------------------------"
},
{
"path": "tests/testthat/test-sprinkle_justify.R",
"chars": 1735,
"preview": "context(\"sprinkle_justify\")\n\nx <- dust(mtcars)\n\n# Functional Requirement 1 ------------------------------------------\n\nt"
},
{
"path": "tests/testthat/test-sprinkle_label.R",
"chars": 1165,
"preview": "context(\"sprinkle_label\")\n\nx <- dust(mtcars)\n\n# Functional Requirement 1 ------------------------------------------\n\ntes"
},
{
"path": "tests/testthat/test-sprinkle_longtable.R",
"chars": 1635,
"preview": "context(\"sprinkle_longtable\")\n\nx <- dust(mtcars)\n\n# Functional Requirement 1 ------------------------------------------\n"
},
{
"path": "tests/testthat/test-sprinkle_merge.R",
"chars": 3538,
"preview": "context(\"sprinkle_merge\")\n\nx <- dust(head(mtcars))\n\n# Functional Requirement 1 -----------------------------------------"
},
{
"path": "tests/testthat/test-sprinkle_na_string.R",
"chars": 2999,
"preview": "context(\"sprinkle_na_string\")\n\nx <- dust(head(mtcars))\n\n# Functional Requirement 1 -------------------------------------"
},
{
"path": "tests/testthat/test-sprinkle_pad.R",
"chars": 2737,
"preview": "context(\"sprinkle_pad\")\n\nx <- dust(head(mtcars))\n\n# Functional Requirement 1 ------------------------------------------\n"
},
{
"path": "tests/testthat/test-sprinkle_replace.R",
"chars": 3132,
"preview": "context(\"sprinkle_replace\")\n\nx <- dust(head(mtcars))\n\n# Functional Requirement 1 ---------------------------------------"
},
{
"path": "tests/testthat/test-sprinkle_rotate_degree.R",
"chars": 2489,
"preview": "context(\"sprinkle_rotate_degree\")\n\nx <- dust(head(mtcars))\n\n# Functional Requirement 1 ---------------------------------"
},
{
"path": "tests/testthat/test-sprinkle_round.R",
"chars": 2272,
"preview": "context(\"sprinkle_round\")\n\nx <- dust(head(mtcars))\n\n# Functional Requirement 1 -----------------------------------------"
},
{
"path": "tests/testthat/test-sprinkle_sanitize.R",
"chars": 2568,
"preview": "context(\"sprinkle_sanitize\")\n\nx <- dust(head(mtcars))\n\n# Functional Requirement 1 --------------------------------------"
},
{
"path": "tests/testthat/test-sprinkle_tabcolsep.R",
"chars": 1046,
"preview": "context(\"sprinkle_tabcolsep\")\n\nx <- dust(mtcars)\n\n# Functional Requirement 1 ------------------------------------------\n"
},
{
"path": "tests/testthat/test-sprinkle_table.R",
"chars": 303,
"preview": "context(\"sprinkle_table\")\n\ntest_that(\"sprinkle_table: apply a sprinkle to all parts\",\n{\n x <- dust(mtcars)\n expect_sil"
},
{
"path": "tests/testthat/test-sprinkle_width.R",
"chars": 4025,
"preview": "context(\"sprinkle_width\")\n\nx <- dust(head(mtcars))\n\n# Functional Requirement 1 -----------------------------------------"
},
{
"path": "tests/testthat/test-sprinkles.R",
"chars": 15169,
"preview": "context(\"sprinkles\")\n\nx <- dust(lm(mpg ~ qsec + factor(am) + wt, data = mtcars))\n\ntest_that(\n \"Cast an error if no spri"
},
{
"path": "tests/testthat/test-tidy_label_level.R",
"chars": 3130,
"preview": "context(\"tidy_labels_levels\")\n\n\nmtcars2 <- mtcars\nmtcars2 <- \n labelVector::set_label(\n mtcars2,\n mpg = \"Gas Mile"
},
{
"path": "tests/testthat.R",
"chars": 65,
"preview": "library(\"testthat\")\nlibrary(\"pixiedust\")\n\ntest_check(\"pixiedust\")"
},
{
"path": "vignettes/advancedMagic.Rmd",
"chars": 24399,
"preview": "---\ntitle: \"Advanced Magic with `pixiedust`\"\nauthor: \"Benjamin Nutter\"\ndate: \"`r Sys.Date()`\"\noutput:\n rmarkdown::html_"
},
{
"path": "vignettes/no_css.css",
"chars": 3504,
"preview": "/* This is a copy of the html_vignette css file from \n https://github.com/rstudio/rmarkdown/blob/master/inst/rmarkdo"
},
{
"path": "vignettes/pixiedust.Rmd",
"chars": 16035,
"preview": "---\ntitle: \"Creating Magic with `pixiedust` \"\nauthor: \"Benjamin Nutter\"\ndate: \"`r Sys.Date()`\"\noutput:\n rmarkdown::html"
},
{
"path": "vignettes/sprinkles.Rmd",
"chars": 2425,
"preview": "---\ntitle: \"Sprinkles\"\nauthor: \"Benjamin Nutter\"\ndate: \"`r Sys.Date()`\"\noutput:\n rmarkdown::html_vignette:\n fig_capt"
},
{
"path": "xtable_vs_pixiedust.Rmd",
"chars": 3000,
"preview": "---\ntitle: \"`xtable` vs `pixiedust`: Speed Comparison\"\nauthor: \"Benjamin Nutter\"\ndate: \"`r Sys.Date()`\"\noutput:\n rmarkd"
}
]
// ... and 1 more files (download for full content)
About this extraction
This page contains the full source code of the nutterb/pixiedust GitHub repository, extracted and formatted as plain text for AI agents and large language models (LLMs). The extraction includes 200 files (852.6 KB), approximately 235.2k tokens. Use this with OpenClaw, Claude, ChatGPT, Cursor, Windsurf, or any other AI tool that accepts text input. You can copy the full output to your clipboard or download it as a .txt file.
Extracted by GitExtract — free GitHub repo to text converter for AI. Built by Nikandr Surkov.