htmlTable/ 0000755 0001762 0000144 00000000000 14517543722 012200 5 ustar ligges users htmlTable/NAMESPACE 0000644 0001762 0000144 00000003212 14517434555 013420 0 ustar ligges users # Generated by roxygen2: do not edit by hand
S3method(htmlTable,data.frame)
S3method(htmlTable,default)
S3method(htmlTable,matrix)
S3method(interactiveTable,default)
S3method(interactiveTable,htmlTable)
S3method(knit_print,htmlTable)
S3method(knit_print,interactiveTable)
S3method(print,htmlTable)
S3method(print,interactiveTable)
S3method(tidyHtmlTable,data.frame)
S3method(tidyHtmlTable,default)
S3method(txtRound,data.frame)
S3method(txtRound,default)
S3method(txtRound,matrix)
S3method(txtRound,table)
export(addHtmlTableStyle)
export(concatHtmlTables)
export(getHtmlTableStyle)
export(getHtmlTableTheme)
export(hasHtmlTableStyle)
export(htmlTable)
export(htmlTableWidget)
export(htmlTableWidgetOutput)
export(interactiveTable)
export(outputInt)
export(prepGroupCounts)
export(pvalueFormatter)
export(renderHtmlTableWidget)
export(setHtmlTableTheme)
export(splitLines4Table)
export(tblNoLast)
export(tblNoNext)
export(tidyHtmlTable)
export(txtInt)
export(txtMergeLines)
export(txtPval)
export(txtRound)
export(vector2string)
import(checkmate)
import(htmlwidgets)
import(magrittr)
importFrom(grDevices,col2rgb)
importFrom(grDevices,colorRampPalette)
importFrom(htmltools,htmlEscape)
importFrom(knitr,asis_output)
importFrom(knitr,knit_print)
importFrom(methods,formalArgs)
importFrom(methods,setClass)
importFrom(rstudioapi,getActiveDocumentContext)
importFrom(rstudioapi,isAvailable)
importFrom(stats,na.omit)
importFrom(stringr,str_interp)
importFrom(stringr,str_replace)
importFrom(stringr,str_replace_all)
importFrom(stringr,str_split)
importFrom(stringr,str_trim)
importFrom(utils,as.roman)
importFrom(utils,browseURL)
importFrom(utils,head)
importFrom(utils,tail)
htmlTable/README.md 0000644 0001762 0000144 00000151007 14517463044 013461 0 ustar ligges users [](https://cran.r-project.org/package=htmlTable)
# Basics
The **htmlTable** package is intended for generating tables using [HTML](https://en.wikipedia.org/wiki/HTML) formatting. This format is compatible with [Markdown](https://rmarkdown.rstudio.com/) when used for HTML-output. The most basic table can easily be created by just passing a `matrix` or a `data.frame` to the `htmlTable`-function:
```r
library(magrittr)
library(htmlTable)
# A simple output
output <- matrix(1:4,
ncol=2,
dimnames = list(list("Row 1", "Row 2"),
list("Column 1", "Column 2")))
htmlTable(output)
```
Column 1
Column 2
Row 1
1
3
Row 2
2
4
If you are using `dplyr` and `tidyverse` a convenient wrapper is the `tidyHtmlTable` function (check out `vignette("tidyHtmlTable")`). A simple example of the `tidyHtmlTable` would look something like this:
```r
library(tidyverse)
library(glue)
mtcars |>
as_tibble(rownames = "rnames") |>
filter(cyl == 6 & qsec < 18) |>
pivot_longer(names_to = "per_metric",
cols = c(hp, mpg, qsec)) |>
arrange(gear, rnames) |>
mutate(gear = glue("{gear} gears")) |>
addHtmlTableStyle(align = "r") |>
tidyHtmlTable(header = per_metric, rnames = rnames, rgroup = gear,
caption = "A simple tidyHtmlTable example using mtcars")
```
A simple tidyHtmlTable example using mtcars
hp
mpg
qsec
4 gears
Mazda RX4
110
21
16.46
Mazda RX4 Wag
110
21
17.02
5 gears
Ferrari Dino
175
19.7
15.5
# Advanced
While it may be sufficient for basic tables a more advanced layout is often needed in medical publications with elements such as:
- row groups
- column spanners
- table spanners
- caption
- table footer
- zebra coloring (also know as _banding_):
- rows
- columns
As many journals require that a MS Word-document is submitted it is furthermore also important that the table imports correctly to a word processor, i.e. that the table doesn't only look nice in a web browser but also in the final document. The `htmlTable`-function is written for all these purposes.
**Note:** Due to GitHub CSS-styles the rows get automatically zebra-striped (in a bad way), borders get overridden and I haven't been able to figure out how to change this. See the vignette for a correct example: `vignette("general", package = "htmlTable")`
For demonstration purposes we will setup a basic matrix:
```r
mx <-
matrix(ncol=6, nrow=8) |>
set_rownames(paste(c("1st", "2nd", "3rd",
paste0(4:8, "th")),
"row")) |>
set_colnames(paste(c("1st", "2nd", "3rd",
paste0(4:6, "th")),
"hdr"))
for (nr in 1:nrow(mx)){
for (nc in 1:ncol(mx)){
mx[nr, nc] <-
paste0(nr, ":", nc)
}
}
```
## Row groups
The purpose of the row groups is to group variables that belong to the same group, e.g. a factored variable with more than two levels often benefit from grouping variables together.
```r
htmlTable(mx,
rgroup = paste("Group", LETTERS[1:3]),
n.rgroup = c(2,4,nrow(mx) - 6))
```
1st hdr
2nd hdr
3rd hdr
4th hdr
5th hdr
6th hdr
Group A
1st row
1:1
1:2
1:3
1:4
1:5
1:6
2nd row
2:1
2:2
2:3
2:4
2:5
2:6
Group B
3rd row
3:1
3:2
3:3
3:4
3:5
3:6
4th row
4:1
4:2
4:3
4:4
4:5
4:6
5th row
5:1
5:2
5:3
5:4
5:5
5:6
6th row
6:1
6:2
6:3
6:4
6:5
6:6
Group C
7th row
7:1
7:2
7:3
7:4
7:5
7:6
8th row
8:1
8:2
8:3
8:4
8:5
8:6
We can easily mix row groups with regular variables by having an empty row group name `""`:
```r
htmlTable(mx,
rgroup = c(paste("Group", LETTERS[1:2]), ""),
n.rgroup = c(2,4,nrow(mx) - 6))
```
1st hdr
2nd hdr
3rd hdr
4th hdr
5th hdr
6th hdr
Group A
1st row
1:1
1:2
1:3
1:4
1:5
1:6
2nd row
2:1
2:2
2:3
2:4
2:5
2:6
Group B
3rd row
3:1
3:2
3:3
3:4
3:5
3:6
4th row
4:1
4:2
4:3
4:4
4:5
4:6
5th row
5:1
5:2
5:3
5:4
5:5
5:6
6th row
6:1
6:2
6:3
6:4
6:5
6:6
7th row
7:1
7:2
7:3
7:4
7:5
7:6
8th row
8:1
8:2
8:3
8:4
8:5
8:6
When mixing row groups with variables without row groups we may want to omit the bold formatting of the row group label. As of htmlTable version 2.0
you can separate the css styling using `addHtmlTableStyle`:
```r
mx |>
addHtmlTableStyle(css.rgroup = "") |>
htmlTable(rgroup = c(paste("Group", LETTERS[1:2]), ""),
n.rgroup = c(2,4,nrow(mx) - 6))
```
1st hdr
2nd hdr
3rd hdr
4th hdr
5th hdr
6th hdr
Group A
1st row
1:1
1:2
1:3
1:4
1:5
1:6
2nd row
2:1
2:2
2:3
2:4
2:5
2:6
Group B
3rd row
3:1
3:2
3:3
3:4
3:5
3:6
4th row
4:1
4:2
4:3
4:4
4:5
4:6
5th row
5:1
5:2
5:3
5:4
5:5
5:6
6th row
6:1
6:2
6:3
6:4
6:5
6:6
7th row
7:1
7:2
7:3
7:4
7:5
7:6
8th row
8:1
8:2
8:3
8:4
8:5
8:6
## Column spanners
A column spanner spans 2 or more columns:
```r
htmlTable(mx,
cgroup = c("Cgroup 1", "Cgroup 2"),
n.cgroup = c(2,4))
```
Cgroup 1
Cgroup 2
1st hdr
2nd hdr
3rd hdr
4th hdr
5th hdr
6th hdr
1st row
1:1
1:2
1:3
1:4
1:5
1:6
2nd row
2:1
2:2
2:3
2:4
2:5
2:6
3rd row
3:1
3:2
3:3
3:4
3:5
3:6
4th row
4:1
4:2
4:3
4:4
4:5
4:6
5th row
5:1
5:2
5:3
5:4
5:5
5:6
6th row
6:1
6:2
6:3
6:4
6:5
6:6
7th row
7:1
7:2
7:3
7:4
7:5
7:6
8th row
8:1
8:2
8:3
8:4
8:5
8:6
It can sometimes be convenient to have column spanners in multiple levels:
```r
htmlTable(mx,
cgroup = rbind(c("", "Column spanners", NA),
c("", "Cgroup 1", "Cgroup 2")),
n.cgroup = rbind(c(1,2,NA),
c(2,2,2)))
```
Column spanners
Cgroup 1
Cgroup 2
1st hdr
2nd hdr
3rd hdr
4th hdr
5th hdr
6th hdr
1st row
1:1
1:2
1:3
1:4
1:5
1:6
2nd row
2:1
2:2
2:3
2:4
2:5
2:6
3rd row
3:1
3:2
3:3
3:4
3:5
3:6
4th row
4:1
4:2
4:3
4:4
4:5
4:6
5th row
5:1
5:2
5:3
5:4
5:5
5:6
6th row
6:1
6:2
6:3
6:4
6:5
6:6
7th row
7:1
7:2
7:3
7:4
7:5
7:6
8th row
8:1
8:2
8:3
8:4
8:5
8:6
Above example allows the column spanner to be a sum of the underlying cgroups (see n.cgroup), this is not required by the function:
```r
htmlTable(mx,
cgroup = rbind(c("", "Column spanners", NA),
c("", "Cgroup 1", "Cgroup 2")),
n.cgroup = rbind(c(1,5,NA),
c(2,1,3)))
```
Column spanners
Cgroup 1
Cgroup 2
1st hdr
2nd hdr
3rd hdr
4th hdr
5th hdr
6th hdr
1st row
1:1
1:2
1:3
1:4
1:5
1:6
2nd row
2:1
2:2
2:3
2:4
2:5
2:6
3rd row
3:1
3:2
3:3
3:4
3:5
3:6
4th row
4:1
4:2
4:3
4:4
4:5
4:6
5th row
5:1
5:2
5:3
5:4
5:5
5:6
6th row
6:1
6:2
6:3
6:4
6:5
6:6
7th row
7:1
7:2
7:3
7:4
7:5
7:6
8th row
8:1
8:2
8:3
8:4
8:5
8:6
## Table spanners
A table spanner is similar to rgroup but has the primary purpose of combining 2 or more tables with the same columns into one:
```r
htmlTable(mx,
tspanner = paste("Spanner", LETTERS[1:3]),
n.tspanner = c(2,4,nrow(mx) - 6))
```
1st hdr
2nd hdr
3rd hdr
4th hdr
5th hdr
6th hdr
Spanner A
1st row
1:1
1:2
1:3
1:4
1:5
1:6
2nd row
2:1
2:2
2:3
2:4
2:5
2:6
Spanner B
3rd row
3:1
3:2
3:3
3:4
3:5
3:6
4th row
4:1
4:2
4:3
4:4
4:5
4:6
5th row
5:1
5:2
5:3
5:4
5:5
5:6
6th row
6:1
6:2
6:3
6:4
6:5
6:6
Spanner C
7th row
7:1
7:2
7:3
7:4
7:5
7:6
8th row
8:1
8:2
8:3
8:4
8:5
8:6
## Table caption
The table caption is simply the table description and can be either located above or below the table:
```r
htmlTable(mx[1:2,1:2],
caption="A table caption above")
```
A more interesting detail that the function allows for is table numbering, initialized by:
```r
options(table_counter = TRUE)
```
```r
htmlTable(mx[1:2,1:2],
caption="A table caption with a numbering")
```
Table 1: A table caption with a numbering
1st hdr
2nd hdr
1st row
1:1
1:2
2nd row
2:1
2:2
As we often want to reference the table number in the text there are two associated functions:
```r
tblNoLast()
```
```
## [1] 1
```
```r
tblNoNext()
```
```
## [1] 2
```
## Table footer
The footer usually contains specifics regarding variables and is always located at the foot of the table:
```r
htmlTable(mx[1:2,1:2],
tfoot="A table footer")
```
1st hdr
2nd hdr
1st row
1:1
1:2
2nd row
2:1
2:2
A table footer
## Putting it all together
Now if we want to do everything in one table it may look like this:
```r
mx |>
addHtmlTableStyle(col.columns = c(rep("none", 2), rep("#F5FBFF", 4)),
col.rgroup = c("none", "#F7F7F7"),
css.cell = "padding-left: .5em; padding-right: .2em;",
align="r") |>
htmlTable(rgroup = paste("Group", LETTERS[1:3]),
n.rgroup = c(2, 4),
cgroup = rbind(c("", "Column spanners", NA),
c("", "Cgroup 1", "Cgroup 2†")),
n.cgroup = rbind(c(1, 2, NA), c(2, 2, 2)),
caption="A table with column spanners, row groups, and zebra striping",
tfoot="† A table footer commment",
cspan.rgroup = 2)
```
Table 2: A table with column spanners, row groups, and zebra striping
Column spanners
Cgroup 1
Cgroup 2†
1st hdr
2nd hdr
3rd hdr
4th hdr
5th hdr
6th hdr
Group A
1st row
1:1
1:2
1:3
1:4
1:5
1:6
2nd row
2:1
2:2
2:3
2:4
2:5
2:6
Group B
3rd row
3:1
3:2
3:3
3:4
3:5
3:6
4th row
4:1
4:2
4:3
4:4
4:5
4:6
5th row
5:1
5:2
5:3
5:4
5:5
5:6
6th row
6:1
6:2
6:3
6:4
6:5
6:6
Group C
7th row
7:1
7:2
7:3
7:4
7:5
7:6
8th row
8:1
8:2
8:3
8:4
8:5
8:6
† A table footer comment
htmlTable/data/ 0000755 0001762 0000144 00000000000 13407215301 013073 5 ustar ligges users htmlTable/data/SCB.rda 0000644 0001762 0000144 00000001245 13407215301 014174 0 ustar ligges users VMn@8?"VlPV,8Jv {X!NZl;, p \}Ì=kTU)#|/3f/A~PgY\UVnR %Va[
=Uw[Ux[\Oɬ5YeMVZHfU-g ' (6¡*5X =^1S04k NhVrlrGyX,]ЬGa
bs ^-w htmlTable/man/ 0000755 0001762 0000144 00000000000 14517463044 012751 5 ustar ligges users htmlTable/man/txtRound.Rd 0000644 0001762 0000144 00000007255 14165130172 015070 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/txtFrmt_round.R, R/txtFrmt_round_data.frame.R
\name{txtRound}
\alias{txtRound}
\alias{txtRound.default}
\alias{txtRound.table}
\alias{txtRound.matrix}
\alias{txtRound.data.frame}
\title{A convenient rounding function}
\usage{
txtRound(x, ...)
\method{txtRound}{default}(
x,
digits = 0,
digits.nonzero = NA,
txt.NA = "",
dec = getOption("htmlTable.decimal_marker", default = "."),
scientific = NULL,
txtInt_args = getOption("htmlTable.round_int", default = NULL),
...
)
\method{txtRound}{table}(x, ...)
\method{txtRound}{matrix}(x, digits = 0, excl.cols = NULL, excl.rows = NULL, ...)
\method{txtRound}{data.frame}(x, ..., digits = 0L)
}
\arguments{
\item{x}{The value/vector/data.frame/matrix to be rounded}
\item{...}{Passed to next method}
\item{digits}{The number of digits to round each element to. For \code{matrix}
or \code{data.frame} input you can provide a \code{vector}/\code{list}. An unnamed \code{vector}/\code{list}
must equal the length of the columns to round. If you provide a named vector you
can provide specify per column the number of digits, and then use \code{.default}
for those columns that we don't need to have separate values for.}
\item{digits.nonzero}{The number of digits to keep if the result is close to
zero. Sometimes we have an entire table with large numbers only to have a
few but interesting observation that are really interesting}
\item{txt.NA}{The string to exchange \code{NA} with}
\item{dec}{The decimal marker. If the text is in non-English decimal
and string formatted you need to change this to the appropriate decimal
indicator. The option for this is \code{htmlTable.decimal_marker}.}
\item{scientific}{If the value should be in scientific format.}
\item{txtInt_args}{A list of arguments to pass to \code{\link[=txtInt]{txtInt()}} if that is to be
used for large values that may require a thousands separator. The option
for this is \code{htmlTable.round_int}. If \code{TRUE} it will activate the \code{txtInt}
functionality.}
\item{excl.cols}{Columns to exclude from the rounding procedure when provided a matrix.
This can be either a number or regular expression. Skipped if \code{x} is a vector.}
\item{excl.rows}{Rows to exclude from the rounding procedure when provided a matrix.
This can be either a number or regular expression.}
}
\value{
\code{matrix/data.frame}
}
\description{
Regular round often looses trailing 0:s as these are truncated, this function
converts everything to strings with all 0:s intact so that tables have the
correct representation, e.g. \code{txtRound(1.01, digits = 1)} turns into \code{1.0}.
}
\section{Tidy-select with \code{data.frame}}{
The \code{txtRound} can use \code{data.frame} for input. This allows us to use
\href{https://tidyselect.r-lib.org/articles/tidyselect.html}{tidyselect}
patterns as popularized by \strong{dplyr}.
}
\examples{
# Basic usage
txtRound(1.023, digits = 1)
# > "1.0"
txtRound(pi, digits = 2)
# > "3.14"
txtRound(12344, digits = 1, txtInt_args = TRUE)
# > "12,344.0"
# Using matrix
mx <- matrix(c(1, 1.11, 1.25,
2.50, 2.55, 2.45,
3.2313, 3, pi),
ncol = 3, byrow=TRUE)
txtRound(mx, digits = 1)
#> [,1] [,2] [,3]
#> [1,] "1.0" "1.1" "1.2"
#> [2,] "2.5" "2.5" "2.5"
#> [3,] "3.2" "3.0" "3.1"
# Using a data.frame directly
library(magrittr)
data("mtcars")
# If we want to round all the numerical values
mtcars \%>\%
txtRound(digits = 1)
# If we want only want to round some columns
mtcars \%>\%
txtRound(wt, qsec_txt = qsec, digits = 1)
}
\seealso{
Other text formatters:
\code{\link{txtInt}()},
\code{\link{txtMergeLines}()},
\code{\link{txtPval}()}
}
\concept{text formatters}
htmlTable/man/prAttr4RgroupAdd.Rd 0000644 0001762 0000144 00000001275 13701421460 016403 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/htmlTable_helpers_attr4RgroupAdd.R
\name{prAttr4RgroupAdd}
\alias{prAttr4RgroupAdd}
\title{Get the add attribute element}
\usage{
prAttr4RgroupAdd(rgroup, rgroup_iterator, no_cols)
}
\arguments{
\item{rgroup}{A vector of character strings containing headings for row groups.
\code{n.rgroup} must be present when \code{rgroup} is given. See
detailed description in section below.}
\item{rgroup_iterator}{The rgroup number of interest}
\item{no_cols}{The \code{ncol(x)} of the core htmlTable x argument}
}
\description{
Gets the add element attribute if it exists. If non-existant it will
return NULL.
}
\keyword{internal}
htmlTable/man/hasHtmlTableStyle.Rd 0000644 0001762 0000144 00000001552 13730316012 016620 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/htmlTable_style_handlers.R
\name{hasHtmlTableStyle}
\alias{hasHtmlTableStyle}
\title{Check if object has a style set to it}
\usage{
hasHtmlTableStyle(x, style_name)
}
\arguments{
\item{x}{The object intended for \code{\link[=htmlTable]{htmlTable()}}.}
\item{style_name}{A string that contains the style name.}
}
\value{
\code{logical} \code{TRUE} if the attribute and style is not \code{NULL}
}
\description{
If the attribute \code{htmlTable.style} is set it will check if
the \code{style_name} exists and return a \code{logical}.
}
\examples{
library(magrittr)
mx <- matrix(1:4, ncol = 2)
colnames(mx) <- LETTERS[1:2]
mx \%>\%
addHtmlTableStyle(align = "l|r") \%>\%
hasHtmlTableStyle("align")
}
\seealso{
Other htmlTableStyle:
\code{\link{addHtmlTableStyle}()}
}
\concept{htmlTableStyle}
htmlTable/man/txtPval.Rd 0000644 0001762 0000144 00000003406 13701421460 014673 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/txtFrmt.R
\name{txtPval}
\alias{txtPval}
\title{Formats the p-values}
\usage{
txtPval(pvalues, lim.2dec = 10^-2, lim.sig = 10^-4, html = TRUE, ...)
}
\arguments{
\item{pvalues}{The p-values}
\item{lim.2dec}{The limit for showing two decimals. E.g.
the p-value may be \code{0.056} and we may want to keep the two decimals in order
to emphasize the proximity to the all-mighty \code{0.05} p-value and set this to
\eqn{10^-2}. This allows that a value of \code{0.0056} is rounded to \code{0.006} and this
makes intuitive sense as the \code{0.0056} level as this is well below
the \code{0.05} value and thus not as interesting to know the exact proximity to
\code{0.05}. \emph{Disclaimer:} The \code{0.05}-limit is really silly and debated, unfortunately
it remains a standard and this package tries to adapt to the current standards in order
to limit publication associated issues.}
\item{lim.sig}{The significance limit for the less than sign, i.e. the '\code{<}'}
\item{html}{If the less than sign should be \code{<} or \verb{<} as needed for HTML output.}
\item{...}{Currently only used for generating warnings of deprecated call parameters.}
}
\value{
vector
}
\description{
Gets formatted p-values. For instance
you often want \code{0.1234} to be \code{0.12} while also
having two values up until a limit,
i.e. \code{0.01234} should be \code{0.012} while
\code{0.001234} should be \code{0.001}. Furthermore you
want to have \verb{< 0.001} as it becomes ridiculous
to report anything below that value.
}
\examples{
txtPval(c(0.10234,0.010234, 0.0010234, 0.000010234))
}
\seealso{
Other text formatters:
\code{\link{txtInt}()},
\code{\link{txtMergeLines}()},
\code{\link{txtRound}()}
}
\concept{text formatters}
htmlTable/man/htmlTable.Rd 0000644 0001762 0000144 00000047404 14517464161 015166 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/htmlTable.R, R/htmlTable_render_knit_print.R,
% R/htmlTable_render_print.R
\name{htmlTable}
\alias{htmlTable}
\alias{htmlTable.default}
\alias{knit_print.htmlTable}
\alias{print.htmlTable}
\title{Output an HTML table}
\usage{
htmlTable(
x,
header = NULL,
rnames = NULL,
rowlabel = NULL,
caption = NULL,
tfoot = NULL,
label = NULL,
rgroup = NULL,
n.rgroup = NULL,
cgroup = NULL,
n.cgroup = NULL,
tspanner = NULL,
n.tspanner = NULL,
total = NULL,
ctable = TRUE,
compatibility = getOption("htmlTableCompat", "LibreOffice"),
cspan.rgroup = "all",
escape.html = FALSE,
...
)
\method{htmlTable}{default}(
x,
header = NULL,
rnames = NULL,
rowlabel = NULL,
caption = NULL,
tfoot = NULL,
label = NULL,
rgroup = NULL,
n.rgroup = NULL,
cgroup = NULL,
n.cgroup = NULL,
tspanner = NULL,
n.tspanner = NULL,
total = NULL,
ctable = TRUE,
compatibility = getOption("htmlTableCompat", "LibreOffice"),
cspan.rgroup = "all",
escape.html = FALSE,
...
)
\method{knit_print}{htmlTable}(x, ...)
\method{print}{htmlTable}(x, useViewer, ...)
}
\arguments{
\item{x}{The matrix/data.frame with the data. For the \code{print} and \code{knit_print}
it takes a string of the class \code{htmlTable} as \code{x} argument.}
\item{header}{A vector of character strings specifying column
header, defaulting to \code{\link[base:colnames]{colnames(x)}}}
\item{rnames}{Default row names are generated from \code{\link[base:colnames]{rownames(x)}}. If you
provide \code{FALSE} then it will skip the row names. \emph{Note:} For \code{data.frames}
if you do \code{\link[base:colnames]{rownames(my_dataframe) <- NULL}} it still has
row names. Thus you need to use \code{FALSE} if you want to
supress row names for \code{data.frames}.}
\item{rowlabel}{If the table has row names or \code{rnames},
\code{rowlabel} is a character string containing the
column heading for the \code{rnames}.}
\item{caption}{Adds a table caption.}
\item{tfoot}{Adds a table footer (uses the \verb{} HTML element). The
output is run through \code{\link[=txtMergeLines]{txtMergeLines()}} simplifying the generation
of multiple lines.}
\item{label}{A text string representing a symbolic label for the
table for referencing as an anchor. All you need to do is to reference the
table, for instance \verb{see table 2}. This is
known as the element's id attribute, i.e. table id, in HTML linguo, and should
be unique id for an HTML element in contrast to the \code{css.class} element attribute.}
\item{rgroup}{A vector of character strings containing headings for row groups.
\code{n.rgroup} must be present when \code{rgroup} is given. See
detailed description in section below.}
\item{n.rgroup}{An integer vector giving the number of rows in each grouping. If \code{rgroup}
is not specified, \code{n.rgroup} is just used to divide off blocks of rows by horizontal
lines. If \code{rgroup} is given but \code{n.rgroup} is omitted, \code{n.rgroup} will
default so that each row group contains the same number of rows. If you want additional
rgroup column elements to the cells you can sett the "add" attribute to \code{rgroup} through
\code{attr(rgroup, "add")}, see below explaining section.}
\item{cgroup}{A vector, matrix or list of character strings defining major column header. The default
is to have none. These elements are also known as \emph{column spanners}. If you want a column \emph{not}
to have a spanner then put that column as "". If you pass cgroup and \code{n.crgroup} as
matrices you can have column spanners for several rows. See cgroup section below for details.}
\item{n.cgroup}{An integer vector, matrix or list containing the number of columns for which each element in
cgroup is a heading. For example, specify \code{cgroup=c("Major_1","Major_2")},
\code{n.cgroup=c(3,3)} if \code{"Major_1"} is to span columns 1-3 and
\code{"Major_2"} is to span columns 4-6.
\code{rowlabel} does not count in the column numbers. You can omit \code{n.cgroup}
if all groups have the same number of columns. If the \code{n.cgroup} is one less than
the number of columns in the matrix/data.frame then it automatically adds those.}
\item{tspanner}{The table spanner is somewhat of a table header that
you can use when you want to join different tables with the same columns.}
\item{n.tspanner}{An integer vector with the number of rows or \code{rgroup}s in the original
matrix that the table spanner should span. If you have provided one fewer n.tspanner elements
the last will be imputed from the number of \code{rgroup}s (if you have provided \code{rgroup} and
\code{sum(n.tspanner) < length(rgroup)}) or the number of rows in the table.}
\item{total}{The last row is sometimes a row total with a border on top and
bold fonts. Set this to \code{TRUE} if you are interested in such a row. If you
want a total row at the end of each table spanner you can set this to \code{"tspanner"}.}
\item{ctable}{If the table should have a double top border or a single a' la LaTeX ctable style}
\item{compatibility}{Is default set to \code{LibreOffice} as some
settings need to be in old HTML format as Libre Office can't
handle some commands such as the css caption-alignment. Note: this
option is not yet fully implemented for all details, in the future
I aim to generate a HTML-correct table and one that is aimed
at Libre Office compatibility. Word-compatibility is difficult as
Word ignores most settings and destroys all layout attempts
(at least that is how my 2010 version behaves). You can additinally use the
\code{options(htmlTableCompat = "html")} if you want a change to apply
to the entire document.
MS Excel sometimes misinterprets certain cell data when opening HTML-tables (eg. 1/2 becomes 1. February).
To avoid this please specify the correct Microsoft Office format for each cell in the table using the css.cell-argument.
To make MS Excel interpret everything as text use "mso-number-format:\"\\@\"".}
\item{cspan.rgroup}{The number of columns that an \code{rgroup} should span. It spans
by default all columns but you may want to limit this if you have column colors
that you want to retain.}
\item{escape.html}{logical: should HTML characters be escaped? Defaults to FALSE.}
\item{...}{Passed on to \code{print.htmlTable} function and any argument except the
\code{useViewer} will be passed on to the \code{\link[base:cat]{base::cat()}} functions arguments.
\emph{Note:} as of version 2.0.0 styling options are still allowed but it is recommended
to instead preprocess your object with \code{\link[=addHtmlTableStyle]{addHtmlTableStyle()}}.}
\item{useViewer}{If you are using RStudio there is a viewer thar can render
the table within that is envoced if in \code{\link[base:interactive]{base::interactive()}} mode.
Set this to \code{FALSE} if you want to remove that functionality. You can
also force the function to call a specific viewer by setting this to a
viewer function, e.g. \code{useViewer = utils::browseURL} if you want to
override the default RStudio viewer. Another option that does the same is to
set the \code{options(viewer=utils::browseURL)} and it will default to that
particular viewer (this is how RStudio decides on a viewer).
\emph{Note:} If you want to force all output to go through the
\code{\link[base:cat]{base::cat()}} the set \verb{[options][base::options](htmlTable.cat = TRUE)}.}
}
\value{
Returns a formatted string representing an HTML table of class \code{htmlTable}.
}
\description{
Generates advanced HTML tables with column and row groups
for a dense representation of complex data. Designed for
maximum compatibility with copy-paste into word processors.
For styling, see \code{\link[=addHtmlTableStyle]{addHtmlTableStyle()}} and \code{\link[=setHtmlTableTheme]{setHtmlTableTheme()}}.
\emph{Note:} If you are using \pkg{tidyverse} and \pkg{dplyr} you may
want to check out \code{\link[=tidyHtmlTable]{tidyHtmlTable()}} that automates many of the arguments
that \code{htmlTable} requires.
}
\section{Multiple rows of column spanners \code{cgroup}}{
If you want to have a column spanner in multiple levels (rows) you can
set the \code{cgroup} and \code{n.cgroup} arguments to a \code{matrix} or \code{list}.
For different level elements, set absent ones to NA in a matrix. For example,
\code{cgroup = rbind(c("first", "second", NA), c("a", "b", "c"))}.
And the corresponding \code{n.cgroup} would be \code{n.cgroup = rbind(c(1, 2, NA), c(2, 1, 2))}.
for a table consisting of 5 columns. The "first" spans the first two columns,
the "second" spans the last three columns, "a" spans the first two, "b"
the middle column, and "c" the last two columns.
Using a list is recommended to avoid handling \code{NA}s.
For an empty \code{cgroup}, use \code{""}.
}
\section{The \code{rgroup} argument}{
The \code{rgroup} groups rows seamlessly. Each row in a group is indented by two
spaces (unless the rgroup is \code{""}) and grouped by its rgroup element. The \code{sum(n.rgroup)}
should be zr3ywKOjLZACY4j7TuGXu4v6I8wVWuKy-\eqn{\leq} matrix rows. If fewer, remaining rows are padded with an empty rgroup (\code{""}). If \code{rgroup}
has one more element than \code{n.rgroup}, the last \code{n.rgroup} is computed as \code{nrow(x) - sum(n.rgroup)}
for a smoother table generation.
}
\section{The add attribute to \code{rgroup}}{
To add an extra element at the \code{rgroup} level/row, use \code{attr(rgroup, 'add')}.
The value can either be a \code{vector}, a \code{list},
or a \code{matrix}. See \code{vignette("general", package = "htmlTable")} for examples.
\itemize{
\item A \code{vector} of either equal number of \code{rgroup}s to the number
of \code{rgroup}s that aren't empty, i.e. \code{rgroup[rgroup != ""]}. Or a named vector where
the name must correspond to either an \code{rgroup} or to an \code{rgroup} number.
\item A \code{list} that has exactly the same requirements as the vector.
In addition to the previous we can also have a list with column numbers within
as names within the list.
\item A \code{matrix} with the dimension \verb{nrow(x) x ncol(x)} or
\verb{nrow(x) x 1} where the latter is equivalent to a named vector.
If you have \code{rownames} these will resolve similarly to the names to the
\code{list}/\code{vector} arguments. The same thing applies to \code{colnames}.
}
}
\section{Important \pkg{knitr}-note}{
This function will only work with \pkg{knitr} outputting \emph{HTML}, i.e.
markdown mode. As the function returns raw HTML-code
the compatibility with non-HTML formatting is limited,
even with \href{https://pandoc.org/}{pandoc}.
Thanks to the the \code{\link[knitr:knit_print]{knitr::knit_print()}} and the \code{\link[knitr:asis_output]{knitr::asis_output()}}
the \code{results='asis'} is \emph{no longer needed} except within for-loops.
If you have a knitr-chunk with a for loop and use \code{print()} to produce
raw HTML you must set the chunk option \code{results='asis'}. \emph{Note}:
the print-function relies on the \code{\link[base:interactive]{base::interactive()}} function
for determining if the output should be sent to a browser or to the terminal.
In vignettes and other directly knitted documents you may need to either set
\code{useViewer = FALSE} alternatively set \code{options(htmlTable.cat = TRUE)}.
}
\section{RStudio's notebook}{
RStudio has an interactive notebook that allows output directly into the document.
In order for the output to be properly formatted it needs to have the \code{class}
of \code{html}. The \code{htmlTable} tries to identify if the environment is a
notebook document (uses the \pkg{rstudioapi} and identifies if its a file with and \code{Rmd}
file ending or if there is an element with \code{html_notebook}). If you don't want this
behavior you can remove it using the \code{options(htmlTable.skip_notebook = TRUE)}.
}
\section{Table counter}{
If you set the option table_counter you will get a Table 1,2,3
etc before each table, just set \code{options(table_counter=TRUE)}. If
you set it to a number then that number will correspond to the start of
the table_counter. The \code{table_counter} option will also contain the number
of the last table, this can be useful when referencing it in text. By
setting the option \code{options(table_counter_str = "Table \%s: ")}
you can manipulate the counter table text that is added prior to the
actual caption. Note, you should use the \code{\link[=sprintf]{sprintf()}} \verb{\%s}
instead of \verb{\%d} as the software converts all numbers to characters
for compatibility reasons. If you set \code{options(table_counter_roman = TRUE)}
then the table counter will use Roman numerals instead of Arabic.
}
\section{Empty data frames}{
An empty data frame will result in a warning and output an empty table, provided that
\code{rgroup} and \code{n.rgroup} are not specified. All other row layout options will be ignored.
}
\section{Options}{
There are multiple options that can be set, here is a set of the perhaps most used
\itemize{
\item \code{table_counter} - logical - activates a counter for each table
\item \code{table_counter_roman} - logical - if true the counter is in Roman numbers, i.e. I, II, III, IV...
\item \code{table_counter_str} - string - the string used for generating the table counter text
\item \code{useViewer} - logical - if viewer should be used fro printing the table
\item \code{htmlTable.cat} - logical - if the output should be directly sent to \code{cat()}
\item \code{htmlTable.skip_notebook} - logical - skips the logic for detecting notebook
\item \code{htmlTable.pretty_indentation} - logical - there was some issues in previous Pandoc versions
where HTML indentation caused everything to be interpreted as code. This seems to be fixed
and if you want to look at the raw HTML code it is nice to have this set to \code{TRUE} so that
the tags and elements are properly indented.
\item \code{htmlTableCompat} - string - see parameter description
}
}
\section{Other}{
\emph{Copy-pasting:} As you copy-paste results into Word you need to keep
the original formatting. Either right click and choose that paste option or click
on the icon appearing after a paste. Currently the following compatibilities
have been tested with MS Word 2016:
\itemize{
\item \strong{Internet Explorer} (v. 11.20.10586.0) Works perfectly when copy-pasting into Word
\item \strong{RStudio} (v. 0.99.448) Works perfectly when copy-pasting into Word.
\emph{Note:} can have issues with multi-line \code{cgroup}s -
see \href{https://bugs.chromium.org/p/chromium/issues/detail?id=305130}{bug}
\item \strong{Chrome} (v. 47.0.2526.106) Works perfectly when copy-pasting into Word.
\emph{Note:} can have issues with multi-line \code{cgroup}s -
see \href{https://bugs.chromium.org/p/chromium/issues/detail?id=305130}{bug}
\item \strong{Firefox} (v. 43.0.3) Works poorly - looses font-styling, lines and general feel
\item \strong{Edge} (v. 25.10586.0.0) Works poorly - looses lines and general feel
}
\emph{Direct word processor opening:} Opening directly in Libre Office or Word is no longer
recommended. You get much prettier results using the cut-and-paste option.
\emph{Google docs}: Copy-paste directly into a Google docs document is handled rather well. This
seems to work especially well when the paste comes directly from a Chrome browser.
\emph{Note} that when using complex \code{cgroup} alignments with multiple levels
not every browser is able to handle this. For instance the RStudio
webkit browser seems to have issues with this and a
\href{https://bugs.chromium.org/p/chromium/issues/detail?id=305130}{bug has been filed}.
As the table uses HTML for rendering you need to be aware of that headers,
row names, and cell values should try respect this for optimal display. Browsers
try to compensate and frequently the tables still turn out fine but it is
not advised. Most importantly you should try to use
\verb{<} instead of \code{<} and
\verb{>} instead of \code{>}. You can find a complete list
of HTML characters \href{https://ascii.cl/htmlcodes.htm}{here}.
Lastly, I want to mention that function was inspired by the \code{\link[Hmisc:latex]{Hmisc::latex()}}
that can be an excellent alternative if you wish to switch to PDF-output.
For the sibling function \code{\link[=tidyHtmlTable]{tidyHtmlTable()}} you can directly switch between
the two using the \code{table_fn} argument.
}
\examples{
library(magrittr)
# Basic example
output <- matrix(1:4,
ncol = 2,
dimnames = list(list("Row 1", "Row 2"),
list("Column 1", "Column 2")))
htmlTable(output)
invisible(readline(prompt = "Press [enter] to continue"))
# An advanced output
output <- matrix(ncol = 6, nrow = 8)
for (nr in 1:nrow(output)) {
for (nc in 1:ncol(output)) {
output[nr, nc] <-
paste0(nr, ":", nc)
}
}
output \%>\% addHtmlTableStyle(align = "r",
col.columns = c(rep("none", 2),
rep("#F5FBFF", 4)),
col.rgroup = c("none", "#F7F7F7"),
css.cell = "padding-left: .5em; padding-right: .2em;") \%>\%
htmlTable(header = paste(c("1st", "2nd",
"3rd", "4th",
"5th", "6th"),
"hdr"),
rnames = paste(c("1st", "2nd",
"3rd",
paste0(4:8, "th")),
"row"),
rgroup = paste("Group", LETTERS[1:3]),
n.rgroup = c(2,4,nrow(output) - 6),
cgroup = rbind(c("", "Column spanners", NA),
c("", "Cgroup 1", "Cgroup 2†")),
n.cgroup = rbind(c(1,2,NA),
c(2,2,2)),
caption = "Basic table with both column spanners (groups) and row groups",
tfoot = "† A table footer commment",
cspan.rgroup = 2)
invisible(readline(prompt = "Press [enter] to continue"))
# An advanced empty table
suppressWarnings({
matrix(ncol = 6,
nrow = 0) \%>\%
addHtmlTableStyle(col.columns = c(rep("none", 2),
rep("#F5FBFF", 4)),
col.rgroup = c("none", "#F7F7F7"),
css.cell = "padding-left: .5em; padding-right: .2em;") \%>\%
htmlTable(align = "r",
header = paste(c("1st", "2nd",
"3rd", "4th",
"5th", "6th"),
"hdr"),
cgroup = rbind(c("", "Column spanners", NA),
c("", "Cgroup 1", "Cgroup 2†")),
n.cgroup = rbind(c(1,2,NA),
c(2,2,2)),
caption = "Basic empty table with column spanners (groups) and ignored row colors",
tfoot = "† A table footer commment",
cspan.rgroup = 2)
})
invisible(readline(prompt = "Press [enter] to continue"))
# An example of how to use the css.cell for header styling
simple_output <- matrix(1:4, ncol = 2)
simple_output \%>\%
addHtmlTableStyle(css.cell = rbind(rep("background: lightgrey; font-size: 2em;",
times = ncol(simple_output)),
matrix("",
ncol = ncol(simple_output),
nrow = nrow(simple_output)))) \%>\%
htmlTable(header = LETTERS[1:2])
invisible(readline(prompt = "Press [enter] to continue"))
# See vignette("tables", package = "htmlTable")
# for more examples, also check out tidyHtmlTable() that manages
# the group arguments for you through tidy-select syntax
}
\seealso{
\code{\link[=addHtmlTableStyle]{addHtmlTableStyle()}},
\code{\link[=setHtmlTableTheme]{setHtmlTableTheme()}},
\code{\link[=tidyHtmlTable]{tidyHtmlTable()}}.
\code{\link[=txtMergeLines]{txtMergeLines()}},
\code{\link[Hmisc:latex]{Hmisc::latex()}}
Other table functions:
\code{\link{tblNoLast}()},
\code{\link{tblNoNext}()}
}
\concept{table functions}
htmlTable/man/prGetRowlabelPos.Rd 0000644 0001762 0000144 00000002600 13730316012 016455 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/htmlTable_helpers_getRowlabelPos.R
\name{prGetRowlabelPos}
\alias{prGetRowlabelPos}
\title{Gets the rowlabel position}
\usage{
prGetRowlabelPos(cgroup = NULL, pos.rowlabel, header = NULL)
}
\arguments{
\item{cgroup}{A vector, matrix or list of character strings defining major column header. The default
is to have none. These elements are also known as \emph{column spanners}. If you want a column \emph{not}
to have a spanner then put that column as "". If you pass cgroup and \code{n.crgroup} as
matrices you can have column spanners for several rows. See cgroup section below for details.}
\item{header}{A vector of character strings specifying column
header, defaulting to \code{\link[base:colnames]{colnames(x)}}}
}
\value{
\code{integer} Returns the position within the header rows
to print the \code{rowlabel} argument
}
\description{
Gets the rowlabel position
}
\seealso{
Other hidden helper functions for htmlTable:
\code{\link{prAddCells}()},
\code{\link{prAddEmptySpacerCell}()},
\code{\link{prAddSemicolon2StrEnd}()},
\code{\link{prEscapeHtml}()},
\code{\link{prGetCgroupHeader}()},
\code{\link{prGetStyle}()},
\code{\link{prPrepInputMatrixDimensions}()},
\code{\link{prPrepareAlign}()},
\code{\link{prPrepareCgroup}()},
\code{\link{prTblNo}()}
}
\concept{hidden helper functions for htmlTable}
\keyword{internal}
htmlTable/man/pvalueFormatter.Rd 0000644 0001762 0000144 00000001013 13701421460 016401 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/deprecated.R
\name{pvalueFormatter}
\alias{pvalueFormatter}
\title{Deprecated use \code{\link[=txtPval]{txtPval()}} instead}
\usage{
pvalueFormatter(...)
}
\arguments{
\item{...}{Currently only used for generating warnings of deprecated call}
}
\description{
Deprecated use \code{\link[=txtPval]{txtPval()}} instead
}
\examples{
\dontrun{
# Deprecated function
pvalueFormatter(c(0.10234,0.010234, 0.0010234, 0.000010234))
}
}
\keyword{internal}
htmlTable/man/innerJoinByCommonCols.Rd 0000644 0001762 0000144 00000000744 13701421460 017453 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/tidyHtmlTable_helpers_innerJoinByCommonCols.r
\name{innerJoinByCommonCols}
\alias{innerJoinByCommonCols}
\title{A simple function for joining two tables by their
intersected columns}
\usage{
innerJoinByCommonCols(x, y)
}
\arguments{
\item{x}{\code{data.frame}}
\item{y}{\code{data.frame}}
}
\value{
\code{data.frame}
}
\description{
A simple function for joining two tables by their
intersected columns
}
htmlTable/man/getHtmlTableTheme.Rd 0000644 0001762 0000144 00000000754 13701421460 016573 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/htmlTable_theme.R
\name{getHtmlTableTheme}
\alias{getHtmlTableTheme}
\title{Retrieve the \code{\link[=htmlTable]{htmlTable()}} theme list}
\usage{
getHtmlTableTheme()
}
\value{
\code{list} with the styles to be applied to the table
}
\description{
A wrapper for a \code{\link[base:options]{getOption("htmlTable.theme")()}} call that
returns the standard theme unless one is set.
}
\examples{
getHtmlTableTheme()
}
htmlTable/man/SCB.Rd 0000644 0001762 0000144 00000002744 14517434555 013663 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/data-SCB.R
\docType{data}
\name{SCB}
\alias{SCB}
\title{Average age in Sweden}
\description{
For the vignettes there is a dataset downloaded by using the
\code{get_pxweb_data()} call. The data is from
SCB (\href{https://www.scb.se//}{Statistics Sweden}) and downloaded
using the \href{https://github.com/rOpenGov/pxweb}{pxweb package}:
}
\examples{
\dontrun{
# The data was generated through downloading via the API
library(pxweb)
# Get the last 15 years of data (the data always lags 1 year)
current_year <- as.integer(format(Sys.Date(), "\%Y")) -1
SCB <- get_pxweb_data(
url = "http://api.scb.se/OV0104/v1/doris/en/ssd/BE/BE0101/BE0101B/BefolkningMedelAlder",
dims = list(Region = c('00', '01', '03', '25'),
Kon = c('1', '2'),
ContentsCode = c('BE0101G9'),
Tid = (current_year-14):current_year),
clean = TRUE)
# Some cleaning was needed before use
SCB$region <- factor(substring(as.character(SCB$region), 4))
Swe_ltrs <- c("å" = "å",
"Å" = "Å",
"ä" = "ä",
"Ä" = "Ä",
"ö" = "ö",
"Ö" = "Ö")
for (i in 1:length(Swe_ltrs)){
levels(SCB$region) <- gsub(names(Swe_ltrs)[i],
Swe_ltrs[i],
levels(SCB$region))
}
save(SCB, file = "data/SCB.rda")
}
}
\references{
\url{https://www.scb.se/}
}
\author{
Max Gordon \email{max@gforge.se}
}
\keyword{data}
htmlTable/man/prConvertDfFactors.Rd 0000644 0001762 0000144 00000001104 13701421460 017000 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/htmlTable_helpers_convertDfFactors.R
\name{prConvertDfFactors}
\alias{prConvertDfFactors}
\title{Convert all factors to characters to print them as they expected}
\usage{
prConvertDfFactors(x)
}
\arguments{
\item{x}{The matrix/data.frame with the data. For the \code{print} and \code{knit_print}
it takes a string of the class \code{htmlTable} as \code{x} argument.}
}
\value{
The data frame with factors as characters
}
\description{
Convert all factors to characters to print them as they expected
}
htmlTable/man/prExtractElementsAndConvertToTbl.Rd 0000644 0001762 0000144 00000001047 13701421460 021632 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in
% R/tidyHtmlTable_helpers_extractElementsAndConvertToTbl.R
\name{prExtractElementsAndConvertToTbl}
\alias{prExtractElementsAndConvertToTbl}
\title{Extract the elements and generate a table with unique elements}
\usage{
prExtractElementsAndConvertToTbl(x, elements)
}
\arguments{
\item{x}{\code{list} with columns to be joined}
\item{elements}{\code{char} vector with the elements to select}
}
\description{
Extract the elements and generate a table with unique elements
}
htmlTable/man/prAddEmptySpacerCell.Rd 0000644 0001762 0000144 00000002553 13730316012 017240 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/htmlTable_render_prAddEmptySpacerCell.R
\name{prAddEmptySpacerCell}
\alias{prAddEmptySpacerCell}
\title{Add an empty cell}
\usage{
prAddEmptySpacerCell(
x,
style_list,
cell_style,
align_style,
cell_tag = c("td", "th"),
colspan = 1
)
}
\arguments{
\item{x}{The matrix/data.frame with the data. For the \code{print} and \code{knit_print}
it takes a string of the class \code{htmlTable} as \code{x} argument.}
\item{cell_style}{The style of the current cell that should be applied to all cells}
\item{align_style}{The style from \code{\link[=prGetAlign]{prGetAlign()}}}
\item{cell_tag}{What HTML tag to use}
\item{colspan}{The number of rows each tag should span}
}
\value{
\code{string}
}
\description{
Depending on the \code{spacer.celltype} set in \code{\link[=addHtmlTableStyle]{addHtmlTableStyle()}} we
will use different spacer cells.
}
\seealso{
Other hidden helper functions for htmlTable:
\code{\link{prAddCells}()},
\code{\link{prAddSemicolon2StrEnd}()},
\code{\link{prEscapeHtml}()},
\code{\link{prGetCgroupHeader}()},
\code{\link{prGetRowlabelPos}()},
\code{\link{prGetStyle}()},
\code{\link{prPrepInputMatrixDimensions}()},
\code{\link{prPrepareAlign}()},
\code{\link{prPrepareCgroup}()},
\code{\link{prTblNo}()}
}
\concept{hidden helper functions for htmlTable}
\keyword{internal}
htmlTable/man/prPrepInputMatrixDimensions.Rd 0000644 0001762 0000144 00000002213 13730316012 020730 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/htmlTable_helpers_prepInputMatrixDimensions.R
\name{prPrepInputMatrixDimensions}
\alias{prPrepInputMatrixDimensions}
\title{Makes sure the input is correct}
\usage{
prPrepInputMatrixDimensions(x, header = NULL)
}
\arguments{
\item{x}{The matrix/data.frame with the data. For the \code{print} and \code{knit_print}
it takes a string of the class \code{htmlTable} as \code{x} argument.}
\item{header}{A vector of character strings specifying column
header, defaulting to \code{\link[base:colnames]{colnames(x)}}}
}
\description{
Checks and converts dimensions into something the
\code{\link[=htmlTable]{htmlTable()}} is comfortable with.
}
\seealso{
Other hidden helper functions for htmlTable:
\code{\link{prAddCells}()},
\code{\link{prAddEmptySpacerCell}()},
\code{\link{prAddSemicolon2StrEnd}()},
\code{\link{prEscapeHtml}()},
\code{\link{prGetCgroupHeader}()},
\code{\link{prGetRowlabelPos}()},
\code{\link{prGetStyle}()},
\code{\link{prPrepareAlign}()},
\code{\link{prPrepareCgroup}()},
\code{\link{prTblNo}()}
}
\concept{hidden helper functions for htmlTable}
\keyword{internal}
htmlTable/man/vector2string.Rd 0000644 0001762 0000144 00000001320 13701421460 016035 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/vector2string.R
\name{vector2string}
\alias{vector2string}
\title{Collapse vector to string}
\usage{
vector2string(
x,
quotation_mark = "'",
collapse = sprintf("\%s, \%s", quotation_mark, quotation_mark)
)
}
\arguments{
\item{x}{The vector to collapse}
\item{quotation_mark}{The type of quote to use}
\item{collapse}{The string that separates each element}
}
\value{
A string with \code{', '} separation
}
\description{
Merges all the values and outputs a string
formatted as '1st element', '2nd element', ...
}
\examples{
vector2string(1:4)
vector2string(c("a", "b'b", "c"))
vector2string(c("a", "b'b", "c"), quotation_mark = '"')
}
htmlTable/man/prGetStyle.Rd 0000644 0001762 0000144 00000002152 14517434555 015347 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/htmlTable_helpers_getStyle.R
\name{prGetStyle}
\alias{prGetStyle}
\title{Gets the CSS style element}
\usage{
prGetStyle(...)
}
\arguments{
\item{...}{Styles can be provided as \code{vector}, \verb{named vector}, or \code{string}.
If you provide a name, e.g. \code{background: blue}, \code{align="center"},
the function will convert the \code{align} into proper \code{align: center}.}
}
\value{
\code{string} Returns the codes merged into one string with
correct CSS ; and : structure.
}
\description{
A function for checking, merging, and more
with a variety of different style formats.
}
\seealso{
Other hidden helper functions for htmlTable:
\code{\link{prAddCells}()},
\code{\link{prAddEmptySpacerCell}()},
\code{\link{prAddSemicolon2StrEnd}()},
\code{\link{prEscapeHtml}()},
\code{\link{prGetCgroupHeader}()},
\code{\link{prGetRowlabelPos}()},
\code{\link{prPrepInputMatrixDimensions}()},
\code{\link{prPrepareAlign}()},
\code{\link{prPrepareCgroup}()},
\code{\link{prTblNo}()}
}
\concept{hidden helper functions for htmlTable}
\keyword{internal}
htmlTable/man/outputInt.Rd 0000644 0001762 0000144 00000000670 13701421460 015244 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/deprecated.R
\name{outputInt}
\alias{outputInt}
\title{Deprecated use \code{\link[=txtInt]{txtInt()}} instead.}
\usage{
outputInt(...)
}
\arguments{
\item{...}{Passed to \code{\link[=txtInt]{txtInt()}}}
}
\description{
Deprecated use \code{\link[=txtInt]{txtInt()}} instead.
}
\examples{
\dontrun{
# Deprecated function
outputInt(123456)
}
}
\keyword{internal}
htmlTable/man/setHtmlTableTheme.Rd 0000644 0001762 0000144 00000015315 13730316012 016604 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/htmlTable_theme.R
\name{setHtmlTableTheme}
\alias{setHtmlTableTheme}
\title{Set or update theme for \code{\link[=htmlTable]{htmlTable()}}}
\usage{
setHtmlTableTheme(
theme = NULL,
align = NULL,
align.header = NULL,
align.cgroup = NULL,
css.rgroup = NULL,
css.rgroup.sep = NULL,
css.tspanner = NULL,
css.tspanner.sep = NULL,
css.total = NULL,
css.cell = NULL,
css.cgroup = NULL,
css.header = NULL,
css.header.border_bottom = NULL,
css.class = NULL,
css.table = NULL,
pos.rowlabel = NULL,
pos.caption = NULL,
col.rgroup = NULL,
col.columns = NULL,
padding.rgroup = NULL,
padding.tspanner = NULL,
spacer.celltype = NULL,
spacer.css.cgroup.bottom.border = NULL,
spacer.css = NULL,
spacer.content = NULL
)
}
\arguments{
\item{theme}{A \code{list} containing all the styles or a \code{string} that is matched to some of the preset style (See details
below in the \emph{Theme options} section). \emph{Note}: the full name of the theme is not required as they are matched
using \code{\link[base:match.arg]{base::match.arg()}}.}
\item{align}{A character strings specifying column alignments, defaulting to \code{'c'}
to center. Valid chars for alignments are l = left, c = center and r = right. You can also specify
\code{align='c|c'} and other LaTeX tabular formatting. If you want to set the alignment of the
rownames this string needst to be \code{ncol(x) + 1}, otherwise it automatically
pads the string with a left alignment for the rownames.}
\item{align.header}{A character strings specifying alignment for column header,
defaulting to centered, i.e. \verb{[paste][base::paste](rep('c',ncol(x)),collapse='')}.}
\item{align.cgroup}{The justification of the \code{cgroups}}
\item{css.rgroup}{CSS style for the rgroup, if different styles are wanted for each of the
rgroups you can just specify a vector with the number of elements.}
\item{css.rgroup.sep}{The line between different rgroups. The line is set to the TR element
of the lower rgroup, i.e. you have to set the border-top/padding-top etc to a line with
the expected function. This is only used for rgroups that are printed. You can specify
different separators if you give a vector of rgroup - 1 length (this is since the first
rgroup doesn't have a separator).}
\item{css.tspanner}{The CSS style for the table spanner.}
\item{css.tspanner.sep}{The line between different spanners.}
\item{css.total}{The css of the total row if such is activated.}
\item{css.cell}{The css.cell element allows you to add any possible CSS style to your
table cells. See section below for details.}
\item{css.cgroup}{The same as \code{css.class} but for cgroup formatting.}
\item{css.header}{The header style, not including the cgroup style}
\item{css.header.border_bottom}{The header bottom-border style, e.g. \verb{border-bottom: 1px solid grey}}
\item{css.class}{The html CSS class for the table. This allows directing html
formatting through \href{https://www.w3schools.com/Css/}{CSS}
directly at all instances of that class. \emph{Note:} unfortunately the
CSS is frequently ignored by word processors. This option
is mostly inteded for web-presentations.}
\item{css.table}{You can specify the the style of the table-element using this parameter}
\item{pos.rowlabel}{Where the rowlabel should be positioned. This value can be \code{"top"},
\code{"bottom"}, \code{"header"}, or a integer between \code{1} and \code{nrow(cgroup) + 1}. The options
\code{"bottom"} and \code{"header"} are the same, where the row label is presented at the same level as
the header.}
\item{pos.caption}{Set to \code{"bottom"} to position a caption below the table
instead of the default of \code{"top"}.}
\item{col.rgroup}{Alternating colors (zebra striping/banded rows) for each \code{rgroup}; one or two colors
is recommended and will be recycled.}
\item{col.columns}{Alternating colors for each column.}
\item{padding.rgroup}{Generally two non-breakings spaces, i.e. \verb{ }, but some
journals only have a bold face for the rgroup and leaves the subelements unindented.}
\item{padding.tspanner}{The table spanner is usually without padding but you may specify padding
similar to \code{padding.rgroup} and it will be added to all elements, including the rgroup elements.
This allows for a 3-level hierarchy if needed.}
\item{spacer.celltype}{When using cgroup the table headers are separated through a empty
HTML cell that is by default filled with \verb{ } (no-breaking-space) that prevents the cell
from collapsing. The purpose of this is to prevent the headers underline to bleed into one
as the underline is for the entire cell. You can alter this behavior by changing this option,
valid options are \code{single_empty}, \code{skip}, \code{double_cell}. The \code{single_empty} is the default,
the \code{skip} lets the header bleed into one and skips entirely, \code{double_cell} is for having
two cells so that a vertical border ends up centered (specified using the \code{align} option).
The arguments are matched internally using \link[base:match.arg]{base::match.arg} so you can specify only a part
of the name, e.g. \code{"sk"} will match \code{"skip"}.}
\item{spacer.css.cgroup.bottom.border}{Defaults to \code{none} and used for separating cgroup headers.
Due to a browser bug this is sometimes ignored and you may therefore need to set this
to \verb{1px solid white} to enforce a white border.}
\item{spacer.css}{If you want the spacer cells to share settings you can set it here}
\item{spacer.content}{Defaults to \verb{ } as this guarantees that the cell is not collapsed
and is highly compatible when copy-pasting to word processors.}
}
\value{
An invisible \code{list} with the new theme
}
\description{
The theme guides many of the non-data objects visual appearance. The
theme can be over-ridden by settings for each table. Too get a more complete
understanding of the options, see \code{\link[=addHtmlTableStyle]{addHtmlTableStyle()}}.
}
\section{Theme options}{
The styles available are:
\itemize{
\item \code{standard}: The traditional standard style used in \code{\link[=htmlTable]{htmlTable()}} since the early days
\item \verb{Google docs}: A style that is optimized for copy-pasting into documents on Google drive. This
is geared towards minimal padding and margins so that the table is as dense as possible.
\item \code{blank}: Just as the name suggests the style is completly empty in terms of CSS. Positions
for rowlabel and caption are set to \code{bottom} as these cannot be blank.
}
You can also provide your own style. Each style should be a names vector, e.g. \code{c(width = "100px", color = "red")}
or just a real css string, \verb{width: 100px; color: red;}.
}
\examples{
\dontrun{
setHtmlTableTheme("Google", align = "r")
}
}
htmlTable/man/prepGroupCounts.Rd 0000644 0001762 0000144 00000001030 13701421460 016377 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/prepGroupCounts.R
\name{prepGroupCounts}
\alias{prepGroupCounts}
\title{Retrieves counts for rgroup, cgroup, & tspanner arguments}
\usage{
prepGroupCounts(x)
}
\arguments{
\item{x}{The vector to process}
}
\value{
\code{list(n = rle$lengths, names = rle$values)}
}
\description{
This function is a wrapper to \code{\link[base:rle]{base::rle()}} that
does exactly this but is a little too picky about input values.
}
\examples{
prepGroupCounts(c(1:3, 3:1))
}
htmlTable/man/prGetRgroupLine.Rd 0000644 0001762 0000144 00000003423 13701421460 016320 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/htmlTable_render_getRgroupLine.R
\name{prGetRgroupLine}
\alias{prGetRgroupLine}
\title{Gets the number of \code{rgroup} HTML line}
\usage{
prGetRgroupLine(
x,
total_columns = NULL,
rgroup = NULL,
rgroup_iterator = NULL,
cspan = NULL,
rnames = NULL,
style = NULL,
cgroup_spacer_cells = NULL,
style_list = NULL,
prepped_row_css = NULL
)
}
\arguments{
\item{x}{The matrix/data.frame with the data. For the \code{print} and \code{knit_print}
it takes a string of the class \code{htmlTable} as \code{x} argument.}
\item{total_columns}{The total number of columns including the \code{rowlabel} and the
spacer cells}
\item{rgroup}{A vector of character strings containing headings for row groups.
\code{n.rgroup} must be present when \code{rgroup} is given. See
detailed description in section below.}
\item{rgroup_iterator}{An integer indicating the \code{rgroup}}
\item{cspan}{The column span of the current \code{rgroup}}
\item{rnames}{Default row names are generated from \code{\link[base:colnames]{rownames(x)}}. If you
provide \code{FALSE} then it will skip the row names. \emph{Note:} For \code{data.frames}
if you do \code{\link[base:colnames]{rownames(my_dataframe) <- NULL}} it still has
row names. Thus you need to use \code{FALSE} if you want to
supress row names for \code{data.frames}.}
\item{style}{The css style corresponding to the \code{rgroup} css style that includes
the color specific for the \code{rgroup}, i.e. \code{col.rgroup}.}
\item{cgroup_spacer_cells}{The vector indicating the position of the \code{cgroup}
spacer cells}
\item{prepped_row_css}{The \code{css.cell} information for this particular row.}
}
\description{
Gets the number of \code{rgroup} HTML line
}
\keyword{internal}
htmlTable/man/splitLines4Table.Rd 0000644 0001762 0000144 00000000741 13701421460 016412 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/deprecated.R
\name{splitLines4Table}
\alias{splitLines4Table}
\title{See \code{\link[=txtMergeLines]{txtMergeLines()}}}
\usage{
splitLines4Table(...)
}
\arguments{
\item{...}{passed onto \code{\link[=txtMergeLines]{txtMergeLines()}}}
}
\description{
See \code{\link[=txtMergeLines]{txtMergeLines()}}
}
\examples{
\dontrun{
# Deprecated function
splitLines4Table("hello", "world")
}
}
\keyword{internal}
htmlTable/man/concatHtmlTables.Rd 0000644 0001762 0000144 00000004372 14165130172 016465 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/concatHtmlTables.R
\name{concatHtmlTables}
\alias{concatHtmlTables}
\title{Function for concatenating \code{\link[=htmlTable]{htmlTable()}}s}
\usage{
concatHtmlTables(tables, headers = NULL)
}
\arguments{
\item{tables}{A list of \code{\link[=htmlTable]{htmlTable()}}s to be concatenated}
\item{headers}{Either a string or a vector of strings that function as
a header for each table. If none is provided it will use the names of
the table list or a numeric number.}
}
\value{
\code{\link[=htmlTable]{htmlTable()}} class object
}
\description{
Function for concatenating \code{\link[=htmlTable]{htmlTable()}}s
}
\examples{
library(magrittr)
# Basic example
tables <- list()
output <- matrix(1:4,
ncol = 2,
dimnames = list(list("Row 1", "Row 2"),
list("Column 1", "Column 2")))
tables[["Simple table"]] <- htmlTable(output)
# An advanced output
output <- matrix(ncol = 6, nrow = 8)
for (nr in 1:nrow(output)) {
for (nc in 1:ncol(output)) {
output[nr, nc] <-
paste0(nr, ":", nc)
}
}
tables[["Fancy table"]] <- output \%>\%
addHtmlTableStyle(align = "r",
col.columns = c(rep("none", 2),
rep("#F5FBFF", 4)),
col.rgroup = c("none", "#F7F7F7"),
css.cell = "padding-left: .5em; padding-right: .2em;") \%>\%
htmlTable(header = paste(c("1st", "2nd",
"3rd", "4th",
"5th", "6th"),
"hdr"),
rnames = paste(c("1st", "2nd",
"3rd",
paste0(4:8, "th")),
"row"),
rgroup = paste("Group", LETTERS[1:3]),
n.rgroup = c(2,4,nrow(output) - 6),
cgroup = rbind(c("", "Column spanners", NA),
c("", "Cgroup 1", "Cgroup 2†")),
n.cgroup = rbind(c(1,2,NA),
c(2,2,2)),
caption = "Basic table with both column spanners (groups) and row groups",
tfoot = "† A table footer commment",
cspan.rgroup = 2)
concatHtmlTables(tables)
}
htmlTable/man/tidyHtmlTable.Rd 0000644 0001762 0000144 00000014206 14517463044 016011 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/tidyHtmlTable.R
\name{tidyHtmlTable}
\alias{tidyHtmlTable}
\title{Generate an htmlTable using tidy data as input}
\usage{
tidyHtmlTable(
x,
value,
header,
rnames,
rgroup,
hidden_rgroup,
cgroup,
tspanner,
hidden_tspanner,
skip_removal_warning = getOption("htmlTable.skip_removal_warning", FALSE),
rnames_unique,
table_fn = htmlTable,
...
)
}
\arguments{
\item{x}{Tidy data used to build the \code{htmlTable}}
\item{value}{Column containing values for individual table cells. Defaults to "value" (same as \link[tidyr:pivot_wider]{tidyr::pivot_wider}).}
\item{header}{Column in \code{x} specifying column headings}
\item{rnames}{Column in \code{x} specifying row names. Defaults to "name" (same as \code{\link[tidyr:pivot_wider]{tidyr::pivot_wider()}}).}
\item{rgroup}{Column in \code{x} specifying row groups.}
\item{hidden_rgroup}{Strings indicating \code{rgroup} values to be hidden.}
\item{cgroup}{Columns in \code{x} specifying the column groups.}
\item{tspanner}{Column in \code{x} specifying \code{tspanner} groups.}
\item{hidden_tspanner}{Strings indicating \code{tspanner} values to be hidden.}
\item{skip_removal_warning}{Boolean to suppress warnings when removing \code{NA} columns.}
\item{rnames_unique}{Designates unique row names when regular names lack uniqueness.}
\item{table_fn}{Function to format the table, defaults to \code{\link[=htmlTable]{htmlTable()}}.}
\item{...}{Additional arguments passed to \code{\link[=htmlTable]{htmlTable()}}.}
}
\value{
Returns the HTML code that, when rendered, displays a formatted table.
}
\description{
This function maps columns from the input data, \code{x}, to \code{\link[=htmlTable]{htmlTable()}} parameters.
It's designed to provide a fluent interface for those familiar with the \code{tidyverse} ecosystem.
}
\section{Column-mapping}{
Columns from \code{x} are mapped (transformed) to specific parameters of the \code{\link[=htmlTable]{htmlTable()}}
The following columns are converted to match the intended input structure:
\itemize{
\item \code{value}
\item \code{header}
\item \code{rnames}
\item \code{rgroup}
\item \code{cgroup}
\item \code{tspanner}
}
Each combination of the variables in \code{x} should be unique to map correctly to the output table.
}
\section{Row uniqueness}{
Usually each row should have a unique combination of the mappers.
Sometimes though rows come in a distinct order and the order identifies
the row more than the name. E.g. if we are identifying bone fractures using the
AO-classification we will have classes ranging in the form of:
\itemize{
\item A
\item A1
\item A1.1
\item A2
\item A2.1
\item A2.2
\item B
\item ...
}
we can simplify the names while retaining the key knowledge to:
\itemize{
\item A
\item .1
\item ...1
\item .2
\item ...1
\item ...2
\item B
\item ...
}
This will though result in non-unique rows and thus we need to provide the original
names in addition to the \code{rnames} argument. To do this we have \code{rnames_unique} as a parameter,
without this \code{tidyHtmlTable} we risk unintended merging of cells, generating > 1 value per cell.
\emph{Note} it is recommended that you verify with the full names just to make sure that
any unexpected row order change has happened in the underlying pivot functions.
}
\section{Sorting}{
Rows can be pre-sorted using \code{\link[dplyr:arrange]{dplyr::arrange()}} before passing to \code{tidyHtmlTable}.
Column sorting is based on \code{arrange(cgroup, header)}. If you want to sort in non-alphabetic
order you can provide a factor variable and that information will be retained.
}
\section{Hidden values}{
\code{htmlTable} Allows for some values within \code{rgroup},
\code{cgroup}, etc. to be specified as \code{""}. The following parameters
allow for specific values to be treated as if they were a string of length
zero in the \code{htmlTable} function.
\itemize{
\item \code{hidden_rgroup}
\item \code{hidden_tspanner}
}
}
\section{Simple tibble output}{
The tibble discourages the use of row names. There is therefore a convenience
option for \code{tidyHtmlTable} where you can use the function just as you
would with \code{\link[=htmlTable]{htmlTable()}} where \code{rnames} is populated with
the \code{rnames} argument provided using \code{tidyselect} syntax (defaults to
the "names" column if present int the input data).
}
\section{Additional dependencies}{
In order to run this function you also must have \pkg{dplyr},
\pkg{tidyr}, \pkg{tidyselect} and \pkg{purrr}
packages installed. These have been removed due to
the additional 20 Mb that these dependencies added (issue #47).
\emph{Note:} if you use \pkg{tidyverse} it will already have
all of these and you do not need to worry.
}
\examples{
library(tibble)
library(dplyr)
library(tidyr)
# Prep and select basic data
data("mtcars")
base_data <- mtcars \%>\%
rownames_to_column() \%>\%
mutate(gear = paste(gear, "Gears"),
cyl = paste(cyl, "Cylinders")) \%>\%
select(rowname, cyl, gear, wt, mpg, qsec)
base_data \%>\%
pivot_longer(names_to = "per_metric",
cols = c(wt, mpg, qsec)) \%>\%
group_by(cyl, gear, per_metric) \%>\%
summarise(value_Mean = round(mean(value), 1),
value_Min = round(min(value), 1),
value_Max = round(max(value), 1),
.groups = "drop") \%>\%
pivot_wider(names_from = per_metric,
values_from = starts_with("value_")) \%>\%
# Round the values into a nicer format where we want the weights to have two decimals
txtRound(ends_with("_wt"), digits = 2) \%>\%
txtRound(starts_with("value") & !ends_with("_wt"), digits = 1) \%>\%
# Convert into long format
pivot_longer(cols = starts_with("value_"), names_prefix = "value_") \%>\%
separate(name, into = c("summary_stat", "per_metric")) \%>\%
# Without sorting the row groups wont appear right
# If the columns end up in the wrong order you may want to change the columns
# into factors
arrange(per_metric) \%>\%
addHtmlTableStyle(align = "r") \%>\%
tidyHtmlTable(
header = gear,
cgroup = cyl,
rnames = summary_stat,
rgroup = per_metric,
skip_removal_warning = TRUE)
}
\seealso{
\code{\link[=htmlTable]{htmlTable()}}
}
htmlTable/man/prGetScriptString.Rd 0000644 0001762 0000144 00000000671 13407215301 016665 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/interactiveTable.R
\name{prGetScriptString}
\alias{prGetScriptString}
\title{Gets a string with all the scripts merged into one script tag}
\usage{
prGetScriptString(x)
}
\arguments{
\item{x}{An interactiveTable}
}
\value{
string
}
\description{
Each element has it's own script tags in otherwise an error will cause
all the scripts to fail.
}
\keyword{internal}
htmlTable/man/interactiveTable.Rd 0000644 0001762 0000144 00000006176 14517434555 016544 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/interactiveTable.R
\name{interactiveTable}
\alias{interactiveTable}
\alias{interactiveTable.htmlTable}
\alias{knit_print.interactiveTable}
\alias{print.interactiveTable}
\title{An interactive table that allows you to limit the size of boxes}
\usage{
interactiveTable(
x,
...,
txt.maxlen = 20,
button = getOption("htmlTable.interactiveTable.button", default = FALSE),
minimized.columns = NULL,
js.scripts = c()
)
\method{interactiveTable}{htmlTable}(
x,
...,
txt.maxlen = 20,
button = getOption("htmlTable.interactiveTable.button", default = FALSE),
minimized.columns = NULL,
js.scripts = c()
)
\method{knit_print}{interactiveTable}(x, ...)
\method{print}{interactiveTable}(x, useViewer, ...)
}
\arguments{
\item{x}{The table to be printed}
\item{...}{The exact same parameters as \code{\link[=htmlTable]{htmlTable()}} uses}
\item{txt.maxlen}{The maximum length of a text}
\item{button}{Indicator if the cell should be clickable or if a button should appear with a plus/minus}
\item{minimized.columns}{Notifies if any particular columns should be collapsed from start}
\item{js.scripts}{If you want to add your own JavaScript code you can just add it here.
All code is merged into one string where each section is wrapped in it's own
\verb{} element.}
\item{useViewer}{If you are using RStudio there is a viewer thar can render
the table within that is envoced if in \code{\link[base:interactive]{base::interactive()}} mode.
Set this to \code{FALSE} if you want to remove that functionality. You can
also force the function to call a specific viewer by setting this to a
viewer function, e.g. \code{useViewer = utils::browseURL} if you want to
override the default RStudio viewer. Another option that does the same is to
set the \code{options(viewer=utils::browseURL)} and it will default to that
particular viewer (this is how RStudio decides on a viewer).
\emph{Note:} If you want to force all output to go through the
\code{\link[base:cat]{base::cat()}} the set \verb{[options][base::options](htmlTable.cat = TRUE)}.}
}
\value{
An htmlTable with a javascript attribute containing the code that is then printed
}
\description{
This function wraps the htmlTable and adds JavaScript code for toggling the amount
of text shown in any particular cell.
}
\examples{
library(magrittr)
# A simple output
long_txt <- "Lorem ipsum dolor sit amet, consectetur adipiscing elit,
sed do eiusmod tempor incididunt ut labore et dolore magna aliqua.
Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi
ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit
in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur
sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt
mollit anim id est laborum"
short_txt <- gsub("(^[^.]+).*", "\\\\1", long_txt)
cbind(rep(short_txt, 2),
rep(long_txt, 2)) \%>\%
addHtmlTableStyle(col.rgroup = c("#FFF", "#EEF")) \%>\%
interactiveTable(minimized.columns = ncol(.),
header = c("Short", "Long"),
rnames = c("First", "Second"))
}
htmlTable/man/prSkipRownames.Rd 0000644 0001762 0000144 00000001336 13701421460 016215 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/htmlTable_helpers_skipRownames.R
\name{prSkipRownames}
\alias{prSkipRownames}
\title{Returns if rownames should be printed for the htmlTable}
\usage{
prSkipRownames(rnames)
}
\arguments{
\item{rnames}{Default row names are generated from \code{\link[base:colnames]{rownames(x)}}. If you
provide \code{FALSE} then it will skip the row names. \emph{Note:} For \code{data.frames}
if you do \code{\link[base:colnames]{rownames(my_dataframe) <- NULL}} it still has
row names. Thus you need to use \code{FALSE} if you want to
supress row names for \code{data.frames}.}
}
\description{
Returns if rownames should be printed for the htmlTable
}
\keyword{internal}
htmlTable/man/prAddCells.Rd 0000644 0001762 0000144 00000003036 13730316012 015243 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/htmlTable_render_addCells.R
\name{prAddCells}
\alias{prAddCells}
\title{Add a cell}
\usage{
prAddCells(
rowcells,
cellcode,
style_list,
style,
prepped_cell_css,
cgroup_spacer_cells,
has_rn_col,
offset = 1,
style_list_align_key = "align"
)
}
\arguments{
\item{rowcells}{The cells with the values that are to be added}
\item{cellcode}{Type of cell, can either be \code{th} or \code{td}}
\item{style_list}{The style_list}
\item{style}{The cell style}
\item{cgroup_spacer_cells}{The number of cells that occur between
columns due to the cgroup arguments.}
\item{has_rn_col}{Due to the alignment issue we need to keep track
of if there has already been printed a rowname column or not and therefore
we have this has_rn_col that is either 0 or 1.}
\item{offset}{For rgroup rows there may be an offset != 1}
}
\value{
\code{string} Returns the string with the new cell elements
}
\description{
Adds a row of cells \verb{
val
...
} to a table string for
\code{\link[=htmlTable]{htmlTable()}}
}
\seealso{
Other hidden helper functions for htmlTable:
\code{\link{prAddEmptySpacerCell}()},
\code{\link{prAddSemicolon2StrEnd}()},
\code{\link{prEscapeHtml}()},
\code{\link{prGetCgroupHeader}()},
\code{\link{prGetRowlabelPos}()},
\code{\link{prGetStyle}()},
\code{\link{prPrepInputMatrixDimensions}()},
\code{\link{prPrepareAlign}()},
\code{\link{prPrepareCgroup}()},
\code{\link{prTblNo}()}
}
\concept{hidden helper functions for htmlTable}
\keyword{internal}
htmlTable/man/prPrepareCss.Rd 0000644 0001762 0000144 00000002244 13701421460 015641 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/htmlTable_helpers_prepareCss.R
\name{prPrepareCss}
\alias{prPrepareCss}
\title{Prepares the cell style}
\usage{
prPrepareCss(
x,
css,
rnames,
header = NULL,
name = deparse(substitute(css)),
style_list = NULL
)
}
\arguments{
\item{x}{The matrix/data.frame with the data. For the \code{print} and \code{knit_print}
it takes a string of the class \code{htmlTable} as \code{x} argument.}
\item{css}{The CSS styles that are to be converted into
a matrix.}
\item{rnames}{Default row names are generated from \code{\link[base:colnames]{rownames(x)}}. If you
provide \code{FALSE} then it will skip the row names. \emph{Note:} For \code{data.frames}
if you do \code{\link[base:colnames]{rownames(my_dataframe) <- NULL}} it still has
row names. Thus you need to use \code{FALSE} if you want to
supress row names for \code{data.frames}.}
\item{header}{A vector of character strings specifying column
header, defaulting to \code{\link[base:colnames]{colnames(x)}}}
\item{name}{The name of the CSS style that is prepared}
}
\value{
\code{matrix}
}
\description{
Prepares the cell style
}
\keyword{internal}
htmlTable/man/txtInt.Rd 0000644 0001762 0000144 00000002261 14165130172 014523 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/txtFrmt.R
\name{txtInt}
\alias{txtInt}
\title{SI or English formatting of an integer}
\usage{
txtInt(
x,
language = getOption("htmlTable.language", default = "en"),
html = getOption("htmlTable.html", default = TRUE),
...
)
}
\arguments{
\item{x}{The integer variable}
\item{language}{The ISO-639-1 two-letter code for the language of
interest. Currently only English is distinguished from the ISO
format using a ',' as the separator.}
\item{html}{If the format is used in HTML context
then the space should be a non-breaking space, \verb{ }}
\item{...}{Passed to \code{\link[base:format]{base::format()}}}
}
\value{
\code{string}
}
\description{
English uses ',' between every 3 numbers while the
SI format recommends a ' ' if x > 10^4. The scientific
form 10e+? is furthermore avoided.
}
\examples{
txtInt(123)
# Supplying a matrix
txtInt(matrix(c(1234, 12345, 123456, 1234567), ncol = 2))
# Missing are returned as empty strings, i.e. ""
txtInt(c(NA, 1e7))
}
\seealso{
Other text formatters:
\code{\link{txtMergeLines}()},
\code{\link{txtPval}()},
\code{\link{txtRound}()}
}
\concept{text formatters}
htmlTable/man/prGetThead.Rd 0000644 0001762 0000144 00000007472 13701421460 015267 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/htmlTable_render_getThead.R
\name{prGetThead}
\alias{prGetThead}
\title{Renders the table head (thead)}
\usage{
prGetThead(
x,
header = NULL,
cgroup = NULL,
n.cgroup = NULL,
caption = NULL,
compatibility,
total_columns,
css.cgroup,
top_row_style,
rnames,
rowlabel = NULL,
cgroup_spacer_cells,
prepped_cell_css,
style_list,
cell_style
)
}
\arguments{
\item{x}{The matrix/data.frame with the data. For the \code{print} and \code{knit_print}
it takes a string of the class \code{htmlTable} as \code{x} argument.}
\item{header}{A vector of character strings specifying column
header, defaulting to \code{\link[base:colnames]{colnames(x)}}}
\item{cgroup}{A vector, matrix or list of character strings defining major column header. The default
is to have none. These elements are also known as \emph{column spanners}. If you want a column \emph{not}
to have a spanner then put that column as "". If you pass cgroup and \code{n.crgroup} as
matrices you can have column spanners for several rows. See cgroup section below for details.}
\item{n.cgroup}{An integer vector, matrix or list containing the number of columns for which each element in
cgroup is a heading. For example, specify \code{cgroup=c("Major_1","Major_2")},
\code{n.cgroup=c(3,3)} if \code{"Major_1"} is to span columns 1-3 and
\code{"Major_2"} is to span columns 4-6.
\code{rowlabel} does not count in the column numbers. You can omit \code{n.cgroup}
if all groups have the same number of columns. If the \code{n.cgroup} is one less than
the number of columns in the matrix/data.frame then it automatically adds those.}
\item{caption}{Adds a table caption.}
\item{compatibility}{Is default set to \code{LibreOffice} as some
settings need to be in old HTML format as Libre Office can't
handle some commands such as the css caption-alignment. Note: this
option is not yet fully implemented for all details, in the future
I aim to generate a HTML-correct table and one that is aimed
at Libre Office compatibility. Word-compatibility is difficult as
Word ignores most settings and destroys all layout attempts
(at least that is how my 2010 version behaves). You can additinally use the
\code{options(htmlTableCompat = "html")} if you want a change to apply
to the entire document.
MS Excel sometimes misinterprets certain cell data when opening HTML-tables (eg. 1/2 becomes 1. February).
To avoid this please specify the correct Microsoft Office format for each cell in the table using the css.cell-argument.
To make MS Excel interpret everything as text use "mso-number-format:\"\\@\"".}
\item{total_columns}{The total number of columns including the rowlabel and the
specer cells}
\item{top_row_style}{The top row has a special style depending on
the \code{ctable} option in the \code{htmlTable} call.}
\item{rnames}{Default row names are generated from \code{\link[base:colnames]{rownames(x)}}. If you
provide \code{FALSE} then it will skip the row names. \emph{Note:} For \code{data.frames}
if you do \code{\link[base:colnames]{rownames(my_dataframe) <- NULL}} it still has
row names. Thus you need to use \code{FALSE} if you want to
supress row names for \code{data.frames}.}
\item{rowlabel}{If the table has row names or \code{rnames},
\code{rowlabel} is a character string containing the
column heading for the \code{rnames}.}
\item{cgroup_spacer_cells}{The spacer cells due to the multiple cgroup levels.
With multiple rows in cgroup we need to keep track of how many spacer cells
occur between the columns. This variable contains is of the size \code{ncol(x)-1}
and 0 if there is no cgroup element between.}
\item{style_list}{The list with all the styles}
}
\value{
\code{string} Returns the html string for the \verb{...} element
}
\description{
Renders the table head (thead)
}
\keyword{internal}
htmlTable/man/txtMergeLines.Rd 0000644 0001762 0000144 00000002337 14165130172 016027 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/txtFrmt.R
\name{txtMergeLines}
\alias{txtMergeLines}
\title{A merges lines while preserving the line break for HTML/LaTeX}
\usage{
txtMergeLines(..., html = 5)
}
\arguments{
\item{...}{The lines that you want to be joined}
\item{html}{If HTML compatible output should be used. If \code{FALSE}
it outputs LaTeX formatting. Note if you set this to 5
then the HTML5 version of \emph{br} will be used: \verb{ }
otherwise it uses the \verb{ } that is compatible
with the XHTML-formatting.}
}
\value{
\code{string} with \code{asis_output} wrapping if html output is activated
}
\description{
This function helps you to do a table header with multiple lines
in both HTML and in LaTeX. In HTML this isn't that tricky, you just use
the \verb{ } command but in LaTeX I often find
myself writing \code{vbox}/\code{hbox} stuff and therefore
I've created this simple helper function
}
\examples{
txtMergeLines("hello", "world")
txtMergeLines("hello", "world", html=FALSE)
txtMergeLines("hello", "world", list("A list", "is OK"))
}
\seealso{
Other text formatters:
\code{\link{txtInt}()},
\code{\link{txtPval}()},
\code{\link{txtRound}()}
}
\concept{text formatters}
htmlTable/man/prPrepareCgroup.Rd 0000644 0001762 0000144 00000004004 13730316012 016342 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/htmlTable_helpers_prepareCgroup.R
\name{prPrepareCgroup}
\alias{prPrepareCgroup}
\title{Prepares the cgroup argument}
\usage{
prPrepareCgroup(x, cgroup = NULL, n.cgroup = NULL, style_list)
}
\arguments{
\item{x}{The matrix/data.frame with the data. For the \code{print} and \code{knit_print}
it takes a string of the class \code{htmlTable} as \code{x} argument.}
\item{cgroup}{A vector, matrix or list of character strings defining major column header. The default
is to have none. These elements are also known as \emph{column spanners}. If you want a column \emph{not}
to have a spanner then put that column as "". If you pass cgroup and \code{n.crgroup} as
matrices you can have column spanners for several rows. See cgroup section below for details.}
\item{n.cgroup}{An integer vector, matrix or list containing the number of columns for which each element in
cgroup is a heading. For example, specify \code{cgroup=c("Major_1","Major_2")},
\code{n.cgroup=c(3,3)} if \code{"Major_1"} is to span columns 1-3 and
\code{"Major_2"} is to span columns 4-6.
\code{rowlabel} does not count in the column numbers. You can omit \code{n.cgroup}
if all groups have the same number of columns. If the \code{n.cgroup} is one less than
the number of columns in the matrix/data.frame then it automatically adds those.}
}
\value{
\code{list(cgroup, n.cgroup, align.cgroup, cgroup_spacer_cells)}
}
\description{
Due to the complicated structure of multilevel cgroups there
some preparation for the cgroup options is required.
}
\seealso{
Other hidden helper functions for htmlTable:
\code{\link{prAddCells}()},
\code{\link{prAddEmptySpacerCell}()},
\code{\link{prAddSemicolon2StrEnd}()},
\code{\link{prEscapeHtml}()},
\code{\link{prGetCgroupHeader}()},
\code{\link{prGetRowlabelPos}()},
\code{\link{prGetStyle}()},
\code{\link{prPrepInputMatrixDimensions}()},
\code{\link{prPrepareAlign}()},
\code{\link{prTblNo}()}
}
\concept{hidden helper functions for htmlTable}
\keyword{internal}
htmlTable/man/htmlTableWidget-shiny.Rd 0000644 0001762 0000144 00000002264 13701421460 017442 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/htmlTableWidget.R
\name{htmlTableWidget-shiny}
\alias{htmlTableWidget-shiny}
\alias{htmlTableWidgetOutput}
\alias{renderHtmlTableWidget}
\title{Shiny bindings for htmlTableWidget}
\usage{
htmlTableWidgetOutput(outputId, width = "100\%", height = "400px")
renderHtmlTableWidget(expr, env = parent.frame(), quoted = FALSE)
}
\arguments{
\item{outputId}{output variable to read from}
\item{width, height}{Must be a valid CSS unit (like \code{'100\%'}, \code{'400px'}, \code{'auto'}) or a number,
which will be coerced to a string and have \code{'px'} appended.}
\item{expr}{An expression that generates a \code{\link[=htmlTableWidget]{htmlTableWidget()}}}
\item{env}{The environment in which to evaluate \code{expr}.}
\item{quoted}{Is \code{expr} a quoted expression (with \code{quote()})? This
is useful if you want to save an expression in a variable.}
}
\description{
Output and render functions for using htmlTableWidget within Shiny
applications and interactive Rmd documents.
}
\examples{
\dontrun{
# In the UI:
htmlTableWidgetOutput("mywidget")
# In the server:
renderHtmlTableWidget({
htmlTableWidget(iris)
})
}
}
htmlTable/man/prEscapeHtml.Rd 0000644 0001762 0000144 00000001770 13730316012 015620 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/htmlTable_helpers_escapeHtml.R
\name{prEscapeHtml}
\alias{prEscapeHtml}
\title{Remove html entities from table}
\usage{
prEscapeHtml(x)
}
\arguments{
\item{x}{The matrix/data.frame with the data. For the \code{print} and \code{knit_print}
it takes a string of the class \code{htmlTable} as \code{x} argument.}
}
\value{
\code{x} without the html entities
}
\description{
Removes the htmlEntities from table input data. Note that
this also replaces $ signs in order to remove the MathJax
issue.
}
\seealso{
Other hidden helper functions for htmlTable:
\code{\link{prAddCells}()},
\code{\link{prAddEmptySpacerCell}()},
\code{\link{prAddSemicolon2StrEnd}()},
\code{\link{prGetCgroupHeader}()},
\code{\link{prGetRowlabelPos}()},
\code{\link{prGetStyle}()},
\code{\link{prPrepInputMatrixDimensions}()},
\code{\link{prPrepareAlign}()},
\code{\link{prPrepareCgroup}()},
\code{\link{prTblNo}()}
}
\concept{hidden helper functions for htmlTable}
htmlTable/man/prTblNo.Rd 0000644 0001762 0000144 00000002200 13730316012 014576 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/htmlTable_helpers_tblNo.R
\name{prTblNo}
\alias{prTblNo}
\title{Gets the table counter string}
\usage{
prTblNo(caption = NULL)
}
\arguments{
\item{caption}{The caption if any}
}
\value{
\code{string} Returns a string formatted according to
the table_counter_str and table_counter_roman. The number is
decided by the table_counter variable
}
\description{
Returns the string used for htmlTable to number the different tables.
Uses options \code{table_counter}, \code{table_counter_str},
and \code{table_counter_roman} to produce the final string. You
can set each option by simply calling \code{options()}.
}
\seealso{
Other hidden helper functions for htmlTable:
\code{\link{prAddCells}()},
\code{\link{prAddEmptySpacerCell}()},
\code{\link{prAddSemicolon2StrEnd}()},
\code{\link{prEscapeHtml}()},
\code{\link{prGetCgroupHeader}()},
\code{\link{prGetRowlabelPos}()},
\code{\link{prGetStyle}()},
\code{\link{prPrepInputMatrixDimensions}()},
\code{\link{prPrepareAlign}()},
\code{\link{prPrepareCgroup}()}
}
\concept{hidden helper functions for htmlTable}
\keyword{internal}
htmlTable/man/prPrepareColors.Rd 0000644 0001762 0000144 00000001110 13701421460 016341 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/htmlTable_helpers_prepareColors.R
\name{prPrepareColors}
\alias{prPrepareColors}
\title{Prepares the alternating colors}
\usage{
prPrepareColors(clr, n = NULL, ng = NULL, gtxt)
}
\arguments{
\item{clr}{The colors}
\item{n}{The number of rows/columns applicable to the color}
\item{ng}{The n.rgroup/n.cgroup argument if applicable}
\item{gtxt}{The rgroup/cgroup texts}
}
\value{
\code{character} A vector containing hexadecimal colors
}
\description{
Prepares the alternating colors
}
\keyword{internal}
htmlTable/man/addStyles.Rd 0000644 0001762 0000144 00000020074 13730316012 015163 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/htmlTable_style_handlers.R
\name{addHtmlTableStyle}
\alias{addHtmlTableStyle}
\alias{appendHtmlTableStyle}
\title{Add/set css and other style options}
\usage{
addHtmlTableStyle(
x,
align = NULL,
align.header = NULL,
align.cgroup = NULL,
css.rgroup = NULL,
css.rgroup.sep = NULL,
css.tspanner = NULL,
css.tspanner.sep = NULL,
css.total = NULL,
css.cell = NULL,
css.cgroup = NULL,
css.header = NULL,
css.header.border_bottom = NULL,
css.class = NULL,
css.table = NULL,
pos.rowlabel = NULL,
pos.caption = NULL,
col.rgroup = NULL,
col.columns = NULL,
padding.rgroup = NULL,
padding.tspanner = NULL,
spacer.celltype = NULL,
spacer.css.cgroup.bottom.border = NULL,
spacer.css = NULL,
spacer.content = NULL
)
appendHtmlTableStyle(
x,
align = NULL,
align.header = NULL,
align.cgroup = NULL,
css.rgroup = NULL,
css.rgroup.sep = NULL,
css.tspanner = NULL,
css.tspanner.sep = NULL,
css.total = NULL,
css.cell = NULL,
css.cgroup = NULL,
css.header = NULL,
css.header.border_bottom = NULL,
css.class = NULL,
css.table = NULL,
pos.rowlabel = NULL,
pos.caption = NULL,
col.rgroup = NULL,
col.columns = NULL,
padding.rgroup = NULL,
padding.tspanner = NULL,
spacer.celltype = NULL,
spacer.css.cgroup.bottom.border = NULL,
spacer.css = NULL,
spacer.content = NULL
)
}
\arguments{
\item{x}{The object that you later want to pass into \code{\link[=htmlTable]{htmlTable()}}.}
\item{align}{A character strings specifying column alignments, defaulting to \code{'c'}
to center. Valid chars for alignments are l = left, c = center and r = right. You can also specify
\code{align='c|c'} and other LaTeX tabular formatting. If you want to set the alignment of the
rownames this string needst to be \code{ncol(x) + 1}, otherwise it automatically
pads the string with a left alignment for the rownames.}
\item{align.header}{A character strings specifying alignment for column header,
defaulting to centered, i.e. \verb{[paste][base::paste](rep('c',ncol(x)),collapse='')}.}
\item{align.cgroup}{The justification of the \code{cgroups}}
\item{css.rgroup}{CSS style for the rgroup, if different styles are wanted for each of the
rgroups you can just specify a vector with the number of elements.}
\item{css.rgroup.sep}{The line between different rgroups. The line is set to the TR element
of the lower rgroup, i.e. you have to set the border-top/padding-top etc to a line with
the expected function. This is only used for rgroups that are printed. You can specify
different separators if you give a vector of rgroup - 1 length (this is since the first
rgroup doesn't have a separator).}
\item{css.tspanner}{The CSS style for the table spanner.}
\item{css.tspanner.sep}{The line between different spanners.}
\item{css.total}{The css of the total row if such is activated.}
\item{css.cell}{The css.cell element allows you to add any possible CSS style to your
table cells. See section below for details.}
\item{css.cgroup}{The same as \code{css.class} but for cgroup formatting.}
\item{css.header}{The header style, not including the cgroup style}
\item{css.header.border_bottom}{The header bottom-border style, e.g. \verb{border-bottom: 1px solid grey}}
\item{css.class}{The html CSS class for the table. This allows directing html
formatting through \href{https://www.w3schools.com/Css/}{CSS}
directly at all instances of that class. \emph{Note:} unfortunately the
CSS is frequently ignored by word processors. This option
is mostly inteded for web-presentations.}
\item{css.table}{You can specify the the style of the table-element using this parameter}
\item{pos.rowlabel}{Where the rowlabel should be positioned. This value can be \code{"top"},
\code{"bottom"}, \code{"header"}, or a integer between \code{1} and \code{nrow(cgroup) + 1}. The options
\code{"bottom"} and \code{"header"} are the same, where the row label is presented at the same level as
the header.}
\item{pos.caption}{Set to \code{"bottom"} to position a caption below the table
instead of the default of \code{"top"}.}
\item{col.rgroup}{Alternating colors (zebra striping/banded rows) for each \code{rgroup}; one or two colors
is recommended and will be recycled.}
\item{col.columns}{Alternating colors for each column.}
\item{padding.rgroup}{Generally two non-breakings spaces, i.e. \verb{ }, but some
journals only have a bold face for the rgroup and leaves the subelements unindented.}
\item{padding.tspanner}{The table spanner is usually without padding but you may specify padding
similar to \code{padding.rgroup} and it will be added to all elements, including the rgroup elements.
This allows for a 3-level hierarchy if needed.}
\item{spacer.celltype}{When using cgroup the table headers are separated through a empty
HTML cell that is by default filled with \verb{ } (no-breaking-space) that prevents the cell
from collapsing. The purpose of this is to prevent the headers underline to bleed into one
as the underline is for the entire cell. You can alter this behavior by changing this option,
valid options are \code{single_empty}, \code{skip}, \code{double_cell}. The \code{single_empty} is the default,
the \code{skip} lets the header bleed into one and skips entirely, \code{double_cell} is for having
two cells so that a vertical border ends up centered (specified using the \code{align} option).
The arguments are matched internally using \link[base:match.arg]{base::match.arg} so you can specify only a part
of the name, e.g. \code{"sk"} will match \code{"skip"}.}
\item{spacer.css.cgroup.bottom.border}{Defaults to \code{none} and used for separating cgroup headers.
Due to a browser bug this is sometimes ignored and you may therefore need to set this
to \verb{1px solid white} to enforce a white border.}
\item{spacer.css}{If you want the spacer cells to share settings you can set it here}
\item{spacer.content}{Defaults to \verb{ } as this guarantees that the cell is not collapsed
and is highly compatible when copy-pasting to word processors.}
}
\value{
\code{x} with the style added as an attribute that the htmlTable then can use for formatting.
}
\description{
This function is a preprocessing step before applying the \code{\link[=htmlTable]{htmlTable()}} function.
You use this to style your tables with HTML cascading style sheet features.
}
\details{
The function stores the current theme (see \code{\link[=setHtmlTableTheme]{setHtmlTableTheme()}}) + custom styles
to the provided object as an \code{\link[base:attributes]{base::attributes()}}. It is stored under the element
\code{htmlTable.style} in the form of a list object.
}
\section{The \code{css.cell} argument}{
The \code{css.cell} parameter allows you to add any possible CSS style
to your table cells. \code{css.cell} can be either a vector or a matrix.
If \code{css.cell} is a \emph{vector}, it's assumed that the styles should be repeated
throughout the rows (that is, each element in css.cell specifies the style
for a whole column of 'x').
In the case of \code{css.cell} being a \emph{matrix} of the same size of the \code{x} argument,
each element of \code{x} gets the style from the corresponding element in css.cell. Additionally,
the number of rows of \code{css.cell} can be \code{nrow(x) + 1} so the first row of of \code{css.cell}
specifies the style for the header of \code{x}; also the number of columns of \code{css.cell}
can be \code{ncol(x) + 1} to include the specification of style for row names of \code{x}.
Note that the \code{text-align} CSS field in the \code{css.cell} argument will be overriden
by the \code{align} argument.
Excel has a specific css-style, \code{mso-number-format} that can be used for improving the
copy-paste functionality. E.g. the style could be written as: \verb{css_matrix <- matrix( data = "mso-number-format:\\"\\\\@\\"", nrow = nrow(df), ncol = ncol(df))}
}
\examples{
library(magrittr)
matrix(1:4, ncol = 2) \%>\%
addHtmlTableStyle(align = "c", css.cell = "background-color: orange;") \%>\%
htmlTable(caption = "A simple style example")
}
\seealso{
Other htmlTableStyle:
\code{\link{hasHtmlTableStyle}()}
}
\concept{htmlTableStyle}
htmlTable/man/prGetAlign.Rd 0000644 0001762 0000144 00000001610 13730316012 015256 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/htmlTable_helpers_getAlign.R
\name{prGetAlign}
\alias{prGetAlign}
\title{Gets alignment}
\usage{
prGetAlign(
align,
index,
style_list = NULL,
spacerCell = FALSE,
followed_by_spacer_cell = FALSE,
previous_was_spacer_cell = FALSE
)
}
\arguments{
\item{align}{A character strings specifying column alignments, defaulting to \code{'c'}
to center. Valid chars for alignments are l = left, c = center and r = right. You can also specify
\code{align='c|c'} and other LaTeX tabular formatting. If you want to set the alignment of the
rownames this string needst to be \code{ncol(x) + 1}, otherwise it automatically
pads the string with a left alignment for the rownames.}
\item{index}{The index of the align parameter of interest}
}
\description{
Gets alignment
}
\concept{hidden helper functions for}
\keyword{internal}
htmlTable/man/tblNoLast.Rd 0000644 0001762 0000144 00000001255 13701421460 015133 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/tblNo.R
\name{tblNoLast}
\alias{tblNoLast}
\title{Gets the last table number}
\usage{
tblNoLast(roman = getOption("table_counter_roman", FALSE))
}
\arguments{
\item{roman}{Whether or not to use roman numbers instead
of arabic. Can also be set through \code{options(table_caption_no_roman = TRUE)}}
}
\description{
The function relies on \code{options("table_counter")}
in order to keep track of the last number.
}
\examples{
org_opts <- options(table_counter=1)
tblNoLast()
options(org_opts)
}
\seealso{
Other table functions:
\code{\link{htmlTable}},
\code{\link{tblNoNext}()}
}
\concept{table functions}
htmlTable/man/tblNoNext.Rd 0000644 0001762 0000144 00000001255 13701421460 015146 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/tblNo.R
\name{tblNoNext}
\alias{tblNoNext}
\title{Gets the next table number}
\usage{
tblNoNext(roman = getOption("table_counter_roman", FALSE))
}
\arguments{
\item{roman}{Whether or not to use roman numbers instead
of arabic. Can also be set through \code{options(table_caption_no_roman = TRUE)}}
}
\description{
The function relies on \code{options("table_counter")}
in order to keep track of the last number.
}
\examples{
org_opts <- options(table_counter=1)
tblNoNext()
options(org_opts)
}
\seealso{
Other table functions:
\code{\link{htmlTable}},
\code{\link{tblNoLast}()}
}
\concept{table functions}
htmlTable/man/prMergeClr.Rd 0000644 0001762 0000144 00000001220 13701421460 015263 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/htmlTable_helpers_mergeClr.R
\name{prMergeClr}
\alias{prMergeClr}
\title{Merges multiple colors}
\usage{
prMergeClr(clrs)
}
\arguments{
\item{clrs}{The colors}
}
\value{
\code{character} A hexadecimal color
}
\description{
Uses the \code{\link[grDevices:colorRamp]{colorRampPalette()}} for merging colors.
\emph{Note:} When merging more than 2 colors the order in the color
presentation matters. Each color is merged with its neigbors before
merging with next. If there is an uneven number of colors the middle
color is mixed with both left and right side.
}
\keyword{internal}
htmlTable/man/getHtmlTableStyle.Rd 0000644 0001762 0000144 00000001322 13730316012 016617 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/htmlTable_style_handlers.R
\name{getHtmlTableStyle}
\alias{getHtmlTableStyle}
\title{Get style options for object}
\usage{
getHtmlTableStyle(x)
}
\arguments{
\item{x}{The object intended for \code{\link[=htmlTable]{htmlTable()}}.}
}
\value{
A \code{list} if the attribute exists, otherwise \code{NULL}
}
\description{
A wrap around the \code{\link[base:attr]{base::attr()}} that retrieves the style
attribute used by \code{\link[=htmlTable]{htmlTable()}} (\code{htmlTable.style}).
}
\examples{
library(magrittr)
mx <- matrix(1:4, ncol = 2)
colnames(mx) <- LETTERS[1:2]
mx \%>\%
addHtmlTableStyle(align = "l|r") \%>\%
getHtmlTableStyle()
}
htmlTable/man/prGetCgroupHeader.Rd 0000644 0001762 0000144 00000005065 13730316012 016604 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/htmlTable_render_getCgroupHeader.R
\name{prGetCgroupHeader}
\alias{prGetCgroupHeader}
\title{Retrieve a header row}
\usage{
prGetCgroupHeader(
x,
cgroup_vec,
n.cgroup_vec,
cgroup_vec.just,
row_no,
top_row_style,
rnames,
rowlabel = NULL,
cgroup_spacer_cells,
style_list,
prepped_cell_css,
css_4_cgroup_vec
)
}
\arguments{
\item{x}{The matrix/data.frame with the data. For the \code{print} and \code{knit_print}
it takes a string of the class \code{htmlTable} as \code{x} argument.}
\item{cgroup_vec}{The \code{cgroup} may be a \code{matrix}, this is
just one row of that \code{matrix}}
\item{n.cgroup_vec}{The same as above but for the counter}
\item{cgroup_vec.just}{The same as above bot for the justification}
\item{row_no}{The row number within the header group. Useful for multi-row
headers when we need to output the \code{rowlabel} at the \code{pos.rowlabel}
level.}
\item{top_row_style}{The top row has a special style depending on
the \code{ctable} option in the \code{htmlTable} call.}
\item{rnames}{Default row names are generated from \code{\link[base:colnames]{rownames(x)}}. If you
provide \code{FALSE} then it will skip the row names. \emph{Note:} For \code{data.frames}
if you do \code{\link[base:colnames]{rownames(my_dataframe) <- NULL}} it still has
row names. Thus you need to use \code{FALSE} if you want to
supress row names for \code{data.frames}.}
\item{rowlabel}{If the table has row names or \code{rnames},
\code{rowlabel} is a character string containing the
column heading for the \code{rnames}.}
\item{cgroup_spacer_cells}{The spacer cells due to the multiple cgroup levels.
With multiple rows in cgroup we need to keep track of how many spacer cells
occur between the columns. This variable contains is of the size \code{ncol(x)-1}
and 0 if there is no cgroup element between.}
\item{style_list}{The list with all the styles}
}
\value{
\code{string}
}
\description{
This function retrieves a header row, i.e. a row
within the \verb{
} elements on top of the table. Used by
\code{\link[=htmlTable]{htmlTable()}}.
}
\seealso{
Other hidden helper functions for htmlTable:
\code{\link{prAddCells}()},
\code{\link{prAddEmptySpacerCell}()},
\code{\link{prAddSemicolon2StrEnd}()},
\code{\link{prEscapeHtml}()},
\code{\link{prGetRowlabelPos}()},
\code{\link{prGetStyle}()},
\code{\link{prPrepInputMatrixDimensions}()},
\code{\link{prPrepareAlign}()},
\code{\link{prPrepareCgroup}()},
\code{\link{prTblNo}()}
}
\concept{hidden helper functions for htmlTable}
\keyword{internal}
htmlTable/man/prAddSemicolon2StrEnd.Rd 0000644 0001762 0000144 00000001672 13730316012 017337 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/htmlTable_helpers_addSemicolon2StrEnd.R
\name{prAddSemicolon2StrEnd}
\alias{prAddSemicolon2StrEnd}
\title{Add a ; at the end}
\usage{
prAddSemicolon2StrEnd(my_str)
}
\arguments{
\item{my_str}{The string that is to be processed}
}
\value{
\code{string}
}
\description{
The CSS expects a semicolon at the end of each argument
this function just adds a semicolong if none is given
and remove multiple semicolon if such exist
}
\seealso{
Other hidden helper functions for htmlTable:
\code{\link{prAddCells}()},
\code{\link{prAddEmptySpacerCell}()},
\code{\link{prEscapeHtml}()},
\code{\link{prGetCgroupHeader}()},
\code{\link{prGetRowlabelPos}()},
\code{\link{prGetStyle}()},
\code{\link{prPrepInputMatrixDimensions}()},
\code{\link{prPrepareAlign}()},
\code{\link{prPrepareCgroup}()},
\code{\link{prTblNo}()}
}
\concept{hidden helper functions for htmlTable}
\keyword{internal}
htmlTable/man/htmlTableWidget.Rd 0000644 0001762 0000144 00000002425 13572272225 016322 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/htmlTableWidget.R
\name{htmlTableWidget}
\alias{htmlTableWidget}
\title{htmlTable with pagination widget}
\usage{
htmlTableWidget(
x,
number_of_entries = c(10, 25, 100),
width = NULL,
height = NULL,
elementId = NULL,
...
)
}
\arguments{
\item{x}{A data frame to be rendered}
\item{number_of_entries}{a numeric vector with the number of entries per page to show.
If there is more than one number given, the user will be able to show the number
of rows per page in the table.}
\item{width}{Fixed width for widget (in css units). The default is
\code{NULL}, which results in intelligent automatic sizing based on the
widget's container.}
\item{height}{Fixed height for widget (in css units). The default is
\code{NULL}, which results in intelligent automatic sizing based on the
widget's container.}
\item{elementId}{Use an explicit element ID for the widget (rather than an
automatically generated one). Useful if you have other JavaScript that
needs to explicitly discover and interact with a specific widget instance.}
\item{...}{Additional parameters passed to htmlTable}
}
\value{
an htmlwidget showing the paginated table
}
\description{
This widget renders a table with pagination into an htmlwidget
}
htmlTable/man/prBindDataListIntoColumns.Rd 0000644 0001762 0000144 00000001055 13701421460 020266 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/tidyHtmlTable_helpers_bindDataListIntoColumns.r
\name{prBindDataListIntoColumns}
\alias{prBindDataListIntoColumns}
\title{Merge columns into a tibble}
\usage{
prBindDataListIntoColumns(dataList)
}
\arguments{
\item{dataList}{\code{list} with the columns/data.frames}
}
\value{
\code{data.frame} object
}
\description{
Almost the same as \code{\link[tibble:tibble]{tibble::tibble()}} but it solves the issue
with some of the arguments being columns and some just being vectors.
}
htmlTable/man/prIsNotebook.Rd 0000644 0001762 0000144 00000000654 13701421460 015651 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/htmlTable_helpers_isNotebook.R
\name{prIsNotebook}
\alias{prIsNotebook}
\title{Detects if the call is made from within an RStudio Rmd file or a file
with the html_notebook output set.}
\usage{
prIsNotebook()
}
\description{
Detects if the call is made from within an RStudio Rmd file or a file
with the html_notebook output set.
}
\keyword{internal}
htmlTable/man/prPrepareAlign.Rd 0000644 0001762 0000144 00000003135 13730316012 016141 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/htmlTable_helpers_prepareAlign.R
\name{prPrepareAlign}
\alias{prPrepareAlign}
\title{Prepares the align to match the columns}
\usage{
prPrepareAlign(align, x, rnames, default_rn = "l")
}
\arguments{
\item{x}{The matrix/data.frame with the data. For the \code{print} and \code{knit_print}
it takes a string of the class \code{htmlTable} as \code{x} argument.}
\item{rnames}{Default row names are generated from \code{\link[base:colnames]{rownames(x)}}. If you
provide \code{FALSE} then it will skip the row names. \emph{Note:} For \code{data.frames}
if you do \code{\link[base:colnames]{rownames(my_dataframe) <- NULL}} it still has
row names. Thus you need to use \code{FALSE} if you want to
supress row names for \code{data.frames}.}
\item{default_rn}{The default rowname alignment. This is an option
as the header uses the same function and there may be differences in
how the alignments should be implemented.}
}
\description{
The alignment may be tricky and this function therefore simplifies
this process by extending/shortening the alignment to match the
correct number of columns.
}
\seealso{
Other hidden helper functions for htmlTable:
\code{\link{prAddCells}()},
\code{\link{prAddEmptySpacerCell}()},
\code{\link{prAddSemicolon2StrEnd}()},
\code{\link{prEscapeHtml}()},
\code{\link{prGetCgroupHeader}()},
\code{\link{prGetRowlabelPos}()},
\code{\link{prGetStyle}()},
\code{\link{prPrepInputMatrixDimensions}()},
\code{\link{prPrepareCgroup}()},
\code{\link{prTblNo}()}
}
\concept{hidden helper functions for htmlTable}
\keyword{internal}
htmlTable/DESCRIPTION 0000644 0001762 0000144 00000002545 14517543722 013714 0 ustar ligges users Package: htmlTable
Version: 2.4.2
Title: Advanced Tables for Markdown/HTML
Authors@R: c(
person("Max", "Gordon", email = "max@gforge.se",
role = c("aut", "cre")),
person("Stephen", "Gragg", role=c("aut")),
person("Peter", "Konings", role=c("aut")))
Maintainer: Max Gordon
Description: Tables with state-of-the-art layout elements such as row spanners,
column spanners, table spanners, zebra striping, and more. While allowing
advanced layout, the underlying css-structure is simple in order to maximize
compatibility with common word processors. The package also contains a few
text formatting functions that help outputting text compatible with HTML/LaTeX.
License: GPL (>= 3)
URL: https://gforge.se/packages/
BugReports: https://github.com/gforge/htmlTable/issues
Biarch: yes
Depends: R (>= 4.1)
Imports: stringr, knitr (>= 1.6), magrittr (>= 1.5), methods,
checkmate, htmlwidgets, htmltools, rstudioapi (>= 0.6)
Suggests: testthat, XML, xml2, Hmisc, rmarkdown, chron, lubridate,
tibble, purrr, tidyselect, glue, rlang, tidyr (>= 0.7.2), dplyr
(>= 0.7.4)
Encoding: UTF-8
NeedsCompilation: no
VignetteBuilder: knitr
RoxygenNote: 7.2.2
Packaged: 2023-10-29 14:13:52 UTC; max
Author: Max Gordon [aut, cre],
Stephen Gragg [aut],
Peter Konings [aut]
Repository: CRAN
Date/Publication: 2023-10-29 21:00:02 UTC
htmlTable/build/ 0000755 0001762 0000144 00000000000 14517464237 013302 5 ustar ligges users htmlTable/build/vignette.rds 0000644 0001762 0000144 00000000470 14517464237 015642 0 ustar ligges users N0 ӏ
:@uyh&qAHܦzRLin7 Q.)mUqbSloBO#~ F35>ۈbVCQvPd z+dٿ}ROuV 9rG5L2>_A z~%
addHtmlTableStyle(align = "r|r") %>%
hasHtmlTableStyle("align"))
style <- mx %>%
addHtmlTableStyle(align = "r|r",
# Check partial match.arg for "bottom"
pos.caption = "bot") %>%
getHtmlTableStyle()
expect_list(style)
expect_equal(style$align, "r|r")
expect_equal(style$pos.caption, "bottom")
expect_error(mx %>% addHtmlTableStyle(pos.caption = "invalid option"), regexp = "pos.caption")
})
test_that("Wrap addHtmlTable should work", {
firstWrapper <- function(x, css = c("large", "small")) {
css.table <- match.arg(css)
addHtmlTableStyle(x, css.table = css.table)
}
v <- firstWrapper(x = mtcars, css = "large")
expect_equal(getHtmlTableStyle(v)$css.table, "large")
secondWrapper <- function(x) {
value <- "small"
firstWrapper(x, css = value)
}
v <- secondWrapper(x = mtcars)
expect_equal(getHtmlTableStyle(v)$css.table, "small")
})
htmlTable/tests/testthat/ters-htmlTable_cell_styles_via_prPrepareCSS.R 0000644 0001762 0000144 00000002134 13701421460 026032 0 ustar ligges users library(testthat)
test_that("Test cell styles", {
mx <- matrix(1:3, nrow = 2, ncol = 3, byrow = TRUE)
mx_head <- LETTERS[1:ncol(mx)]
mx_rnames <- LETTERS[1:nrow(mx)]
expect_equal(
dim(prPrepareCss(mx, "")),
dim(mx)
)
expect_equal(
dim(prPrepareCss(mx, "", header = mx_head, rnames = mx_rnames)),
dim(mx)
)
expect_equal(
dim(prPrepareCss(mx, "", header = mx_head, rnames = mx_rnames)),
dim(mx)
)
expect_equal(
dim(prPrepareCss(mx, rep("", times = ncol(mx)))),
dim(mx)
)
expect_error(prPrepareCss(mx, rep("", times = nrow(mx))))
mx_cell.style <- matrix(c("a", "b", "c", "d"), nrow = 2, ncol = 4, byrow = TRUE)
expect_equal(
prPrepareCss(mx, mx_cell.style, rnames = mx_rnames)[2, 1],
"b"
)
expect_error(prPrepareCss(mx, mx_cell.style))
mx_cell.style <- matrix(c("a", "b", "c", "d"), nrow = 3, ncol = 4, byrow = TRUE)
expect_equal(
prPrepareCss(mx, mx_cell.style,
header = mx_head,
rnames = mx_rnames
)[2, 1],
"b"
)
expect_error(prPrepareCss(mx, mx_cell.style, rnames = mx_rnames))
})
htmlTable/tests/testthat/test-htmlTable_total.R 0000644 0001762 0000144 00000005707 13407215301 021414 0 ustar ligges users library(testthat)
context("htmlTable - the total argument")
test_that("Throws errors",{
mx <- matrix(1, ncol=3, nrow=6)
expect_error(htmlTable(mx, total = c(TRUE, TRUE)))
expect_error(htmlTable(mx, total = c(TRUE, TRUE),
tspanner = letters[1:3], n.tspanner = rep(2, times = 3)))
expect_error(htmlTable(mx, total = -1))
expect_error(htmlTable(mx, total = nrow(mx) + 1))
expect_error(htmlTable(mx, total = "asdasd"))
})
test_that("Correct rows",{
mx <- matrix(1:6, ncol=3, nrow=6)
table_str <- htmlTable(mx,
css.total = "color: red",
total=TRUE)
expect_match(table_str, "]*>[^>]+color: red[^>]+>6")
table_str <- htmlTable(mx,
css.total = "color: red",
total=4)
expect_match(table_str, "]*>[^>]+color: red[^>]+>4")
table_str <- htmlTable(mx,
css.total = "color: red",
total=c(4, 2))
expect_false(grepl("]*>[^>]+color: red[^>]+>[1356789]+", table_str))
expect_match(table_str, "]*>[^>]+color: red[^>]+>2")
expect_match(table_str, "]*>[^>]+color: red[^>]+>4")
table_str <- htmlTable(mx,
css.total = "color: red",
total=c(4, 2))
expect_false(grepl("]*>[^>]+color: red[^>]+>[1356789]+", table_str))
expect_match(table_str, "]*>[^>]+color: red[^>]+>2")
expect_match(table_str, "]*>[^>]+color: red[^>]+>4")
})
test_that("Check tspanner", {
mx <- matrix(1:6, ncol=3, nrow=6)
table_str <- htmlTable(mx, tspanner = letters[1:2], n.tspanner = c(3, 3),
css.total = "color: red",
total="tspanner")
expect_false(grepl("]*>[^>]+color: red[^>]+>[1245789]+", table_str))
expect_match(table_str, "]*>[^>]+color: red[^>]+>3")
expect_match(table_str, "]*>[^>]+color: red[^>]+>6")
})
test_that("Check choosing css.style", {
mx <- matrix(1:6, ncol=3, nrow=6)
table_str <- htmlTable(mx, tspanner = letters[1:2], n.tspanner = c(3, 3),
css.total = c("color: red", "color: green"),
total="tspanner")
expect_false(grepl("]*>[^>]+color: red[^>]+>[1245789]+", table_str))
expect_match(table_str, "]*>[^>]+color: red[^>]+>3")
expect_match(table_str, "]*>[^>]+color: green[^>]+>6")
})
test_that("The total should be added to the output if used with addmargins", {
var1 <- LETTERS[1:3]
var2 <- LETTERS[c(4:5, 5)]
total_out <-
table(var1, var2) %>%
addmargins %>%
htmlTable(css.total = "background: purple")
expect_match(total_out, "]+background: purple[^>]+>[^>]*Sum",
info = "Expect the variable name to appear as a cgroup")
expect_match(total_out, "
[^>]+>NA", table_str))
})
test_that("Empty cell names should be replaced with ''",
{
mx <- matrix(1:6, ncol = 3)
mx[1,1] <- NA
table_str <- interactiveTable(mx)
expect_false(grepl("
[^>]+>NA", table_str))
})
test_that("The variable name should not be in the tables first row if no rownames(mx)",
{
mx <- matrix(1:6, ncol = 3)
colnames(mx) <- sprintf("Col %s", LETTERS[1:NCOL(mx)])
table_str <- interactiveTable(mx)
expect_false(grepl("[^<]*
",
info = "Expect the variable name to appear as an rgroup")
expect_match(basic_label, "]+> A",
info = "Expect the variable name to appear as an rgroup")
expect_match(basic_label, "]+> B",
info = "Expect the variable name to appear as an rgroup")
expect_match(basic_label, "]+> C",
info = "Expect the variable name to appear as an rgroup")
tspanner_label <-
table(var1, var2) %>%
htmlTable(rgroup=c("alt"),
n.rgroup=c(3),
css.tspanner = "background: red",
css.rgroup = "background: blue")
expect_match(tspanner_label, "
]+background: red[^>]+>var1
",
info = "Expect the variable name to appear as an tspanner")
expect_match(tspanner_label, "
]+background: blue[^>]+>alt
",
info = "Expect the rgroup name to appear as usual")
expect_match(tspanner_label, "]+> A")
expect_match(tspanner_label, "]+> B")
expect_match(tspanner_label, "]+> C")
rowlabel_label <-
table(var1, var2) %>%
htmlTable(rgroup=c("alt"),
n.rgroup=c(3),
tspanner=c("alt2"),
n.tspanner = c(3),
css.tspanner = "background: red",
css.rgroup = "background: blue")
expect_match(rowlabel_label, "
]+background: red[^>]+>alt2
",
info = "Expect the variable name to appear as an tspanner")
expect_match(rowlabel_label, "
[^>]+>NA", table_str))
})
test_that("Empty cell names should be replaced with ''", {
mx <- matrix(1:6, ncol = 3)
mx[1, 1] <- NA
table_str <- htmlTable(mx)
expect_false(grepl("
[^>]+>NA", table_str))
})
test_that("The variable name should not be in the tables first row if no rownames(mx)", {
mx <- matrix(1:6, ncol = 3)
colnames(mx) <- sprintf("Col %s", LETTERS[1:NCOL(mx)])
table_str <- htmlTable(mx)
expect_false(grepl("[^<]*
Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum.
1
3
5
2
4
6
Sed ut perspiciatis unde omnis iste natus error sit voluptatem accusantium doloremque laudantium, totam rem aperiam, eaque ipsa quae ab illo inventore veritatis et quasi architecto beatae vitae dicta sunt explicabo. Nemo enim ipsam voluptatem quia voluptas sit aspernatur aut odit aut fugit, sed quia consequuntur magni dolores eos qui ratione voluptatem sequi nesciunt. Neque porro quisquam est, qui dolorem ipsum quia dolor sit amet, consectetur, adipisci velit, sed quia non numquam eius modi tempora incidunt ut labore et dolore magnam aliquam quaerat voluptatem. Ut enim ad minima veniam, quis nostrum exercitationem ullam corporis suscipit laboriosam, nisi ut aliquid ex ea commodi consequatur? Quis autem vel eum iure reprehenderit qui in ea voluptate velit esse quam nihil molestiae consequatur, vel illum qui dolorem eum fugiat quo voluptas nulla pariatur?
Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum.
A
B
C
A
2.655
2.060
9.347
B
3.721
1.766
2.121
C
5.729
6.870
6.517
D
9.082
3.841
1.256
E
2.017
7.698
2.672
F
8.984
4.977
3.861
G
9.447
7.176
0.134
H
6.608
9.919
3.824
I
6.291
3.800
8.697
J
0.618
7.774
3.403
Sed ut perspiciatis unde omnis iste natus error sit voluptatem accusantium doloremque laudantium, totam rem aperiam, eaque ipsa quae ab illo inventore veritatis et quasi architecto beatae vitae dicta sunt explicabo. Nemo enim ipsam voluptatem quia voluptas sit aspernatur aut odit aut fugit, sed quia consequuntur magni dolores eos qui ratione voluptatem sequi nesciunt. † Neque porro quisquam est, qui dolorem ipsum quia dolor sit amet, consectetur, adipisci velit, sed quia non numquam eius modi tempora incidunt ut labore et dolore magnam aliquam quaerat voluptatem. Ut enim ad minima veniam, quis nostrum exercitationem ullam corporis suscipit laboriosam, nisi ut aliquid ex ea commodi consequatur? ‡ Quis autem vel eum iure reprehenderit qui in ea voluptate velit esse quam nihil molestiae consequatur, vel illum qui dolorem eum fugiat quo voluptas nulla pariatur?
Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua.
"
htmlTable(mx)
mx <- matrix(1:9, ncol = 3)
colnames(mx) <- LETTERS[1:3]
rownames(mx) <- letters[1:3]
mx_3_times <- rbind(mx,
mx,
mx)
htmlTable(mx_3_times,
css.tspanner.sep = "border-top: 2px solid red;",
rgroup = rep(c("Group a", "Group b and c"), times = 3),
n.rgroup = rep(c(1,2), times = 3),
tspanner = c("First", "Second", "Third"),
n.tspanner = rep(nrow(mx), times = 3),
rowlabel = '',
col.rgroup = c('white','lightblue1'),
tfoot = "Some footer text",
caption = "Caption text")
htmlTable(mx_3_times,
css.tspanner.sep = c("border-top: 2px solid red;",
"border-top: 2px solid blue;"),
rgroup = rep(c("Group a", "Group b and c"), times = 3),
n.rgroup = rep(c(1,2), times = 3),
tspanner = c("First", "Second", "Third"),
n.tspanner = rep(nrow(mx), times = 3),
rowlabel = '',
col.rgroup = c('white','lightblue1'),
tfoot = "Some footer text",
caption = "Caption text")
htmlTable(mx_3_times,
css.tspanner.sep = c("border-top: 2px solid red;",
"border-top: 2px solid blue;"),
rgroup = rep(c("Group a", "Group b and c"), times = 3),
n.rgroup = rep(c(1,2), times = 3),
tspanner = c("First", "Second", "Third"),
n.tspanner = rep(nrow(mx), times = 3),
rowlabel = '',
col.rgroup = c('white','lightblue1'),
col.columns = c('none','#CCCCCC'),
tfoot = "Some footer text",
caption = "Caption text")
htmlTable(mx_3_times,
css.tspanner.sep = c("border-top: 2px solid red;",
"border-top: 12px solid blue;"),
rgroup = rep(c("Group a", "Group b and c"), times = 3),
n.rgroup = rep(c(1,2), times = 3),
tspanner = c("First", "Second", "Third"),
n.tspanner = rep(nrow(mx), times = 3),
rowlabel = '',
tfoot = "Some footer text",
caption = "Caption text")
htmlTable(mx_3_times,
css.tspanner = "color: purple; font-weight: bold;",
css.tspanner.sep = "border-top: 2px solid red;",
rgroup = rep(c("Group a", "Group b and c"), times = 3),
n.rgroup = rep(c(1,2), times = 3),
tspanner = c("First", "Second", "Third"),
n.tspanner = rep(nrow(mx), times = 3),
rowlabel = '',
tfoot = "Some footer text",
caption = "Caption text")
htmlTable(mx_3_times,
padding.tspanner = "+",
padding.rgroup = "-",
css.tspanner = "color: purple; font-weight: bold;",
css.tspanner.sep = "border-top: 2px solid red;",
rgroup = rep(c("Group a", "Group b and c"), times = 3),
n.rgroup = rep(c(1,2), times = 3),
tspanner = c("First", "Second", "Third"),
n.tspanner = rep(nrow(mx), times = 3),
rowlabel = '',
tfoot = "† Some footnote
‡ Another footnote",
caption = "Caption text")
rbind(
`Group A` = c(20, 380),
`Group B` = c(110, 1230),
`Group C` = c(2, 56),
`Group D` = c(17, 33),
`Group A` = c(40, 360),
`Group B` = c(230, 1100),
`Group C` = c(8, 50),
`Group D` = c(10, 40)
) %>%
apply(1, function(x) {
sapply(x, function(count) c(
txtInt(count),
sprintf("(%s)", txtRound(count/sum(x) * 100, 1)))) %>%
c(txtInt(sum(x)), .)
}) %>%
t %>%
htmlTable(header = c("Total", rep(c("No", "(%)"), times = 2)),
n.cgroup = list(c(1, 2, 2)),
cgroup = list(c("", "Cases", "Controls")),
rgroup = rep(c("Aspirin", "Intermittent compression"), times = 2),
n.rgroup = rep(2, times = 4),
tspanner = c("First experiment", "Second experiment"),
n.tspanner = c(2),
align = "r",
caption = "Extremely fake data")
library(tidyverse)
mtcars %>%
as_tibble(rownames = "rnames") %>%
pivot_longer(names_to = "per_metric",
cols = c(hp, mpg, qsec)) %>%
group_by(cyl, gear, per_metric) %>%
summarise(Mean = round(mean(value), 1),
SD = round(sd(value), 1),
Min = round(min(value), 1),
Max = round(max(value), 1),
.groups = 'drop') %>%
pivot_longer(names_to = "summary_stat",
cols = c(Mean, SD, Min, Max)) %>%
ungroup() %>%
mutate(gear = paste(gear, "Gears"),
cyl = paste(cyl, "Cylinders")) %>%
arrange(per_metric, summary_stat) %>%
addHtmlTableStyle(align = "r") %>%
tidyHtmlTable(header = gear,
cgroup = cyl,
rnames = summary_stat,
rgroup = per_metric,
skip_removal_warning = TRUE,
caption = "A full example of how to apply the tidyverse workflow to generate a table")
htmlTable/tests/visual_tests/word_test.Rmd 0000644 0001762 0000144 00000006656 13701421460 020546 0 ustar ligges users ---
title: "Pandoc test"
output:
html_document
editor_options:
chunk_output_type: inline
---
```{r echo=FALSE}
knitr::opts_chunk$set(echo = FALSE, message=FALSE, warning=FALSE)
```
```{r}
library(htmlTable)
library(magrittr)
mx <- matrix(1:6, ncol=3)
htmlTable(mx,
caption = "Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum.",
tfoot = "Sed ut perspiciatis unde omnis iste natus error sit voluptatem accusantium doloremque laudantium, totam rem aperiam, eaque ipsa quae ab illo inventore veritatis et quasi architecto beatae vitae dicta sunt explicabo. Nemo enim ipsam voluptatem quia voluptas sit aspernatur aut odit aut fugit, sed quia consequuntur magni dolores eos qui ratione voluptatem sequi nesciunt. Neque porro quisquam est, qui dolorem ipsum quia dolor sit amet, consectetur, adipisci velit, sed quia non numquam eius modi tempora incidunt ut labore et dolore magnam aliquam quaerat voluptatem. Ut enim ad minima veniam, quis nostrum exercitationem ullam corporis suscipit laboriosam, nisi ut aliquid ex ea commodi consequatur? Quis autem vel eum iure reprehenderit qui in ea voluptate velit esse quam nihil molestiae consequatur, vel illum qui dolorem eum fugiat quo voluptas nulla pariatur?")
set.seed(1)
mx <- matrix(runif(3*10)*10, ncol=3) %>%
set_colnames(LETTERS[1:3]) %>%
set_rownames(LETTERS[1:10])
txtRound(mx, 3) %>%
htmlTable(
align = "clr",
caption = "Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum.",
tfoot = "Sed ut perspiciatis unde omnis iste natus error sit voluptatem accusantium doloremque laudantium, totam rem aperiam, eaque ipsa quae ab illo inventore veritatis et quasi architecto beatae vitae dicta sunt explicabo. Nemo enim ipsam voluptatem quia voluptas sit aspernatur aut odit aut fugit, sed quia consequuntur magni dolores eos qui ratione voluptatem sequi nesciunt.
† Neque porro quisquam est, qui dolorem ipsum quia dolor sit amet, consectetur, adipisci velit, sed quia non numquam eius modi tempora incidunt ut labore et dolore magnam aliquam quaerat voluptatem. Ut enim ad minima veniam, quis nostrum exercitationem ullam corporis suscipit laboriosam, nisi ut aliquid ex ea commodi consequatur?
‡ Quis autem vel eum iure reprehenderit qui in ea voluptate velit esse quam nihil molestiae consequatur, vel illum qui dolorem eum fugiat quo voluptas nulla pariatur?")
htmlTable(mx,
rgroup = c("Lorem", "ipsum", "dolor"),
n.rgroup = c(2, 3),
cgroup = c("", "Test"),
n.cgroup = 1,
align = "llr",
caption = "Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua.")
```
htmlTable/tests/visual_tests/pandoc_test.Rmd 0000644 0001762 0000144 00000001734 13701421460 021027 0 ustar ligges users ---
title: "Pandoc test"
output:
html_document
editor_options:
chunk_output_type: inline
---
```{r}
library(htmlTable)
library(magrittr)
mx <- matrix(1:4, ncol = 2) %>%
set_colnames(c("A åäö¨", "B")) %>%
set_rownames(letters[1:2])
mx %>%
addHtmlTableStyle(align = "r|r") %>%
htmlTable(cgroup = c("Some c-group", ""),
n.cgroup = 1)
```
```{r}
mx[1] <- "Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum"
colnames(mx)[1] <- c("A")
rownames(mx)[1] <- letters[1]
interactiveTable(mx)
```
```{r}
mx <- matrix(rep(mx[1], 6), ncol = 2)
interactiveTable(mx)
```
htmlTable/tests/testthat.R 0000644 0001762 0000144 00000000053 13701421460 015307 0 ustar ligges users library(testthat)
test_check('htmlTable')
htmlTable/vignettes/ 0000755 0001762 0000144 00000000000 14517464237 014213 5 ustar ligges users htmlTable/vignettes/tidyHtmlTable.Rmd 0000644 0001762 0000144 00000004702 13701421460 017411 0 ustar ligges users ---
title: "Using tidyHtmlTable"
author: "Stephen Gragg"
date: "`r Sys.Date()`"
output: rmarkdown::html_vignette
vignette: >
%\VignetteIndexEntry{Using tidyHtmlTable}
%\VignetteEncoding{UTF-8}
%\VignetteEngine{knitr::rmarkdown}
editor_options:
chunk_output_type: console
---
# Introduction
`tidyHtmlTable` acts as a wrapper function for the `htmlTable`
function allowing columns to be mapped from the input data to specific htmlTable
parameters in a manner similar to ggplot2.
# Some Examples
## Prepare Data
We'll begin by turning the `mtcars` data into a tidy dataset. The
`pivot_longer` function is called to collect 3 performance metrics into a pair
of key and value columns.
```{r, message=FALSE}
library(magrittr)
library(tidyr)
library(dplyr)
library(htmlTable)
library(tibble)
td <- mtcars %>%
as_tibble(rownames = "rnames") %>%
pivot_longer(names_to = "per_metric",
cols = c(hp, mpg, qsec))
```
Now we will compute 4 summary statistics for each of the 3 performance metrics.
This will be further grouped by number of cylinders and gears.
```{r}
tidy_summary <- td %>%
group_by(cyl, gear, per_metric) %>%
summarise(Mean = round(mean(value), 1),
SD = round(sd(value), 1),
Min = round(min(value), 1),
Max = round(max(value), 1),
.groups = 'drop') %>%
pivot_longer(names_to = "summary_stat",
cols = c(Mean, SD, Min, Max)) %>%
ungroup() %>%
mutate(gear = paste(gear, "Gears"),
cyl = paste(cyl, "Cylinders"))
```
At this point, we are ready to implement the `htmlTable` function.
Essentially, this constructs an html table using arguments similar to the
`htmlTable` function. However, whereas `htmlTable` required the user to manually
arrange the data and specify the column groups, headers, row names, row-groups,
etc., each of these components of the table is mapped to a column within the
input data.
## Output html table
### Example 1
```{r, warning=FALSE}
tidy_summary %>%
arrange(per_metric, summary_stat) %>%
addHtmlTableStyle(align = "r") %>%
tidyHtmlTable(header = gear,
cgroup = cyl,
rnames = summary_stat,
rgroup = per_metric)
```
### Example 2
```{r, warning=FALSE}
tidy_summary %>%
arrange(cyl, gear) %>%
addHtmlTableStyle(align = "r") %>%
tidyHtmlTable(header = summary_stat,
cgroup = per_metric,
rnames = gear,
rgroup = cyl)
```
htmlTable/vignettes/general.Rmd 0000644 0001762 0000144 00000026133 13730477224 016275 0 ustar ligges users ---
title: "How-to use htmlTable"
author: "Max Gordon"
date: "`r Sys.Date()`"
output:
rmarkdown::html_vignette:
css: custom.css
keep_md: true
toc: true
vignette: >
%\VignetteIndexEntry{How-to use htmlTable}
%\VignetteEngine{knitr::rmarkdown}
%\usepackage[utf8]{inputenc}
---
Basics
======
The **htmlTable** package is intended for generating tables using [HTML](https://en.wikipedia.org/wiki/HTML) formatting. This format is compatible with [Markdown](https://rmarkdown.rstudio.com/) when used for HTML-output. The most basic table can easily be created by just passing a `matrix` or a `data.frame` to the `htmlTable`-function:
```{r}
library(htmlTable)
library(magrittr)
# A simple output
matrix(1:4,
ncol = 2,
dimnames = list(c("Row 1", "Row 2"),
c("Column 1", "Column 2"))) %>%
htmlTable
```
The function is also aware of the dimnames:
```{r}
# A simple output
matrix(1:4,
ncol = 2,
dimnames = list(rows = c("Row 1", "Row 2"),
cols = c("Column 1", "Column 2"))) %>%
htmlTable
```
This can be convenient when working with the `base::table` function:
```{r}
data("mtcars")
with(mtcars,
table(cyl, gear)) %>%
addmargins %>%
htmlTable
```
As of version 1.1 you **no longer need** to specify `results='asis'` for each `knitr` chunk.
**Tip**: If you are working a lot with `dplyr` and the `tidyverse` approach to exploring data you can make your life much easier using the `tidyHtmlTable()` function included in this package that automatically calculates the `rgroup`, `cgroup` and other parameters that make `htmlTable` so useful.
Table caption
-------------
The table caption is simply the table description and can be either located above or below:
```{r ctable_example}
output <- matrix(1:4,
ncol = 2,
dimnames = list(c("Row 1", "Row 2"),
c("Column 1", "Column 2")))
htmlTable(output,
ctable = c("solid", "double"),
caption = "A table caption above and ctable borders")
```
The caption defaults to above but by setting the `pos.caption` argument to "bottom" it appears below the table.
```{r table_with_caption_below}
output %>%
addHtmlTableStyle(pos.caption = "bottom") %>%
htmlTable(caption = "A table caption below")
```
Cell alignment
--------------
Cell alignment is specified through the `align`, `align.header`, `align.cgroup` arguments. For aligning the cell values just use `align`. The argument can accept either a vector or a string, although supplying it with a string is the simplest option as in the example below:
```{r}
1:3 %>%
addHtmlTableStyle(align = "lcr") %>%
htmlTable(rnames = "Row 1",
header = c("'l' = left", "'c' = center", "'r' = right"),
caption = "The alignment is set through the align options. Available alternatives are l, r, c as designated by the below table.")
```
Note that you can specify a string shorter than the number of columns. This can be useful if you have plenty of columns and you simply want all remaining columns to keep the alignment of the last column. To align the row name you can just add another letter to the string while the header is aligned through the `align.header` argument:
```{r}
1:3 %>%
addHtmlTableStyle(align = "clcr",
align.header = "lcr") %>%
htmlTable(rnames = "Row 1",
header = c("'l' = left", "'c' = center", "'r' = right"),
caption = "The alignment is set through the align options. Available alternatives are l, r, c as designated by the below table.")
```
Advanced
========
While it may be sufficient for basic tables a more advanced layout is often needed in medical articles with elements such as:
* row groups
* column spanners
* table spanners
* total row
* table footer
* zebra coloring (also known as *banding*):
+ rows
+ columns
As many journals require that a MS Word-document is submitted it is furthermore also important that the table imports correctly to a word processor, i.e. that the table also looks nice in the final document not only in the browser. The `htmlTable`-function is written for all these purposes.
For demonstration purposes we will setup a basic matrix:
```{r}
mx <- matrix(ncol = 6, nrow = 8)
rownames(mx) <- paste(c("1st", "2nd",
"3rd",
paste0(4:8, "th")),
"row")
colnames(mx) <- paste(c("1st", "2nd",
"3rd",
paste0(4:6, "th")),
"hdr")
for (nr in 1:nrow(mx)) {
for (nc in 1:ncol(mx)) {
mx[nr, nc] <-
paste0(nr, ":", nc)
}
}
```
Row groups
----------
The purpose of the row groups is to group variables that belong to the same group, e.g. a factored variable with more than two levels often benefit from grouping variables together.
```{r}
htmlTable(mx,
rgroup = paste("Group", LETTERS[1:3]),
n.rgroup = c(2,4,nrow(mx) - 6))
```
We can easily mix row groups with regular variables by having an empty row group name `""`:
```{r}
htmlTable(mx,
rgroup = c(paste("Group", LETTERS[1:2]), ""),
n.rgroup = c(2,4,nrow(mx) - 6))
```
When mixing row groups with variables without row groups we may want to omit the bold formatting of the row group label:
```{r}
mx %>%
addHtmlTableStyle(css.rgroup = "") %>%
htmlTable(rgroup = c(paste("Group", LETTERS[1:2]), ""),
n.rgroup = c(2,4,nrow(mx) - 6))
```
The `rgroup` is most commonly a single row without any additional cells but sometimes you may want to have a p-value or similar at the end of the row. This can be achieved by setting the 'add' attribute to the `rgroup`:
```{r}
rgroup <- c(paste("Group", LETTERS[1:2]), "")
attr(rgroup, "add") <- list(`2` = "More")
htmlTable(mx,
rgroup = rgroup,
n.rgroup = c(2,4,nrow(mx) - 6))
```
Column spanners
---------------
A column spanner spans 2 or more columns:
```{r}
htmlTable(mx,
cgroup = c("Cgroup 1", "Cgroup 2"),
n.cgroup = c(2,4))
```
It can sometimes be convenient to have column spanners in multiple levels:
```{r}
htmlTable(mx,
cgroup = rbind(c("", "Column spanners", NA),
c("", "Cgroup 1", "Cgroup 2")),
n.cgroup = rbind(c(1,2,NA),
c(2,2,2)))
```
Above example allows the column spanner to be a sum of the underlying cgroups (see n.cgroup), this is not required by the function and you can also provide a `list` with elements that allows you to skip the `NA` at the end of the matrix:
```{r}
htmlTable(mx,
cgroup = list(c("Super column spanner", ""),
c("", "Another cgroup"),
c("", "Cgroup 1", "Cgroup 2")),
n.cgroup = list(c(5,1),
c(1,2),
c(2,2,2)))
```
Table spanners
--------------
A table spanner is similar to rgroup but has the primary purpose of combining 2 or more tables with the same columns into one:
```{r}
htmlTable(mx,
tspanner = paste("Spanner", LETTERS[1:3]),
n.tspanner = c(2,4,nrow(mx) - 6))
```
Note that you actually don't need the last `n.tspanner`, i.e. you can simplify the above to:
```{r}
htmlTable(mx,
tspanner = paste("Spanner", LETTERS[1:3]),
n.tspanner = c(2,4))
```
Similarly you can use the number rgroups included in each tspanner instead of actual rows. This is convenient as the tspannners must align with underlying rgroups.
Total row
---------
Many financial tables use the concept of a total row at the end that sums the above elements:
```{r}
htmlTable(mx[1:3,], total = TRUE)
```
This can also be combined with table spanners:
```{r}
mx %>%
addHtmlTableStyle(css.total = c("border-top: 1px dashed grey;",
"border-top: 1px dashed grey;",
"border-top: 1px solid grey; font-weight: 900")) %>%
htmlTable(total = "tspanner",
tspanner = paste("Spanner", LETTERS[1:3]),
n.tspanner = c(2,4,nrow(mx) - 6))
```
Table numbering
---------------
The htmlTable has built-in numbering, initialized by:
```{r}
options(table_counter = TRUE)
```
```{r}
htmlTable(mx[1:2,1:2],
caption = "A table caption with a numbering")
```
As we often want to reference the table number in the text there are two associated functions:
```{r}
tblNoLast()
tblNoNext()
```
```{r}
htmlTable(mx[1:2,1:2],
caption = "Another table with numbering")
```
If you want to start the counter at 2 you can instead of setting table_counter to `TRUE` set it to 1. Note that you need to set the value to one less as each time the table is called the counter is incremented by one. You can also turn off the feature by:
```{r}
options(table_counter = FALSE)
```
Table footer
------------
The footer usually contains specifics regarding variables and is always located at the foot of the table:
```{r}
htmlTable(mx[1:2,1:2],
tfoot = "A table footer")
```
Zebra coloring (or banded colors)
------------------------------------
Zebra coloring is also know as an alternating color pattern or row shading. It is most commonly applied to rows:
```{r}
mx %>%
addHtmlTableStyle(col.rgroup = c("none", "#F7F7F7")) %>%
htmlTable
```
The zebra coloring in `htmlTable` is unique in that it follows the rgroups. The zebra striping is centered around the rgroup although rows with no set rgroup, i.e. "" will have alternating colors event though they programatically are within the same group:
```{r}
mx %>%
addHtmlTableStyle(col.rgroup = c("none", "#F7F7F7")) %>%
htmlTable(rgroup = c(paste("Group", LETTERS[1:2]), ""),
n.rgroup = c(2,2,nrow(mx) - 4))
```
We can also color the columns:
```{r}
mx %>%
addHtmlTableStyle(col.columns = c("none", "#F7F7F7")) %>%
htmlTable
```
Or do both (note that the colors blend at the intersections):
```{r}
mx %>%
addHtmlTableStyle(col.rgroup = c("none", "#F9FAF0"),
col.columns = c("none", "#F1F0FA")) %>%
htmlTable
```
Putting it all together
-----------------------
Now if we want to do everything in one table it may look like this:
```{r}
rgroup = paste("Group", LETTERS[1:3])
attr(rgroup, "add") <- list(`3` = "Group p-value < 0.001")
mx %>%
addHtmlTableStyle(align = "rr|r",
align.header = "cc|c",
spacer.celltype = "double_cell",
col.columns = c(rep("none", 2),
rep("#F5FBFF", 4)),
col.rgroup = c("none", "#F7F7F7"),
css.cell = "padding-left: .5em; padding-right: .2em;",
css.header = "font-weight: normal") %>%
htmlTable(rgroup = rgroup,
n.rgroup = c(2,4),
tspanner = paste("Spanner", LETTERS[1:2]),
n.tspanner = c(1),
cgroup = list(c("", "Column spanners"),
c("", "Cgroup 1", "Cgroup 2†")),
n.cgroup = list(c(1,5),
c(2,2,2)),
caption = "A table with column spanners, row groups, and zebra striping",
tfoot = "† A table footer commment",
cspan.rgroup = 2)
```
htmlTable/vignettes/custom.css 0000644 0001762 0000144 00000005634 13730477224 016243 0 ustar ligges users body {
background-color: #fff;
margin: 1em auto;
max-width: 700px;
overflow: visible;
padding-left: 2em;
padding-right: 2em;
font-family: "Open Sans", "Helvetica Neue", Helvetica, Arial, sans-serif;
font-size: 14px;
line-height: 1.35;
}
#header {
text-align: center;
}
#TOC {
clear: both;
margin: 0 0 10px 10px;
padding: 4px;
width: 400px;
border: 1px solid #CCCCCC;
border-radius: 5px;
background-color: #f6f6f6;
font-size: 13px;
line-height: 1.3;
}
#TOC .toctitle {
font-weight: bold;
font-size: 15px;
margin-left: 5px;
}
#TOC ul {
padding-left: 40px;
margin-left: -1.5em;
margin-top: 5px;
margin-bottom: 5px;
}
#TOC ul ul {
margin-left: -2em;
}
#TOC li {
line-height: 16px;
}
table {
margin: 1em auto;
}
p {
margin: 0.5em 0;
}
blockquote {
background-color: #f6f6f6;
padding: 0.25em 0.75em;
}
hr {
border-style: solid;
border: none;
border-top: 1px solid #777;
margin: 28px 0;
}
dl {
margin-left: 0;
}
dl dd {
margin-bottom: 13px;
margin-left: 13px;
}
dl dt {
font-weight: bold;
}
ul {
margin-top: 0;
}
ul li {
list-style: circle outside;
}
ul ul {
margin-bottom: 0;
}
pre, code {
background-color: #f7f7f7;
border-radius: 3px;
color: #333;
}
pre {
white-space: pre-wrap; /* Wrap long lines */
border-radius: 3px;
margin: 5px 0px 10px 0px;
padding: 10px;
}
pre:not([class]) {
background-color: #f7f7f7;
}
code {
font-family: Consolas, Monaco, 'Courier New', monospace;
font-size: 85%;
}
p > code, li > code {
padding: 2px 0px;
}
div.figure {
text-align: center;
}
img {
background-color: #FFFFFF;
padding: 2px;
border: 1px solid #DDDDDD;
border-radius: 3px;
border: 1px solid #CCCCCC;
margin: 0 5px;
}
h1 {
margin-top: 0;
font-size: 35px;
line-height: 40px;
}
h2 {
border-bottom: 4px solid #f7f7f7;
padding-top: 10px;
padding-bottom: 2px;
font-size: 145%;
}
h3 {
border-bottom: 2px solid #f7f7f7;
padding-top: 10px;
font-size: 120%;
}
h4 {
border-bottom: 1px solid #f7f7f7;
margin-left: 8px;
font-size: 105%;
}
h5, h6 {
border-bottom: 1px solid #ccc;
font-size: 105%;
}
a {
color: #0033dd;
text-decoration: none;
}
a:hover {
color: #6666ff; }
a:visited {
color: #800080; }
a:visited:hover {
color: #BB00BB; }
a[href^="http:"] {
text-decoration: underline; }
a[href^="https:"] {
text-decoration: underline; }
/* Colours from https://gist.github.com/robsimmons/1172277 */
code > span.kw { color: #555; font-weight: bold; } /* Keyword */
code > span.dt { color: #902000; } /* DataType */
code > span.dv { color: #40a070; } /* DecVal (decimal values) */
code > span.bn { color: #d14; } /* BaseN */
code > span.fl { color: #d14; } /* Float */
code > span.ch { color: #d14; } /* Char */
code > span.st { color: #d14; } /* String */
code > span.co { color: #888888; font-style: italic; } /* Comment */
code > span.ot { color: #007020; } /* OtherToken */
code > span.al { color: #ff0000; font-weight: bold; } /* AlertToken */
code > span.fu { color: #900; font-weight: bold; } /* Function calls */
code > span.er { color: #a61717; background-color: #e3d2d2; } /* ErrorTok */ htmlTable/vignettes/complex_tables.Rmd 0000644 0001762 0000144 00000027611 14517434555 017667 0 ustar ligges users ---
title: "Building a complex table"
author: "Max Gordon"
date: "`r Sys.Date()`"
output:
rmarkdown::html_vignette:
toc: true
css: custom.css
vignette: >
%\VignetteIndexEntry{Building a complex table}
%\VignetteEngine{knitr::rmarkdown}
%\usepackage[utf8]{inputenc}
---
# Introduction
Tables are an essential part of publishing, well... anything. I therefore want to explore the options available for generating these in knitr. It is important to remember that there are two ways of generating tables in markdown:
1. Markdown tables
2. HTML tables
As the `htmlTable`-package is all about [HTML](https://en.wikipedia.org/wiki/HTML) tables we will work only with that output option. The core idea is that HTML is ubiquitous and that most word-processors will have to support copy-pasting tables and by providing simple simple CSS-formatting we are able to maximize this compatibility. _Note_ CSS is today an extremely complex topic and it is no surprise that word-processors may have difficulty importing tables that have lots of advanced syntax, htmlTable tries to avoid all of that by putting the style close to each element, often at the cell-level.
# Basics
I developed the `htmlTable` in order to get tables matching those available in top medical journals. After finding no HTML-alternative to the `Hmisc::latex` function on [Stack Overflow](https://stackoverflow.com/questions/11950703/html-with-multicolumn-table-in-markdown-using-knitr) I wrote a basic function allowing column spanners and row groups. Below is a basic example on these two:
```{r}
library(htmlTable)
setHtmlTableTheme(theme = "Google docs")
output <-
matrix(paste("Content", LETTERS[1:16]),
ncol = 4, byrow = TRUE)
output |>
htmlTable(header = paste(c("1st", "2nd", "3rd", "4th"), "header"),
rnames = paste(c("1st", "2nd", "3rd", "4th"), "row"),
rgroup = c("Group A", "Group B"),
n.rgroup = c(2, 2),
cgroup = c("Cgroup 1", "Cgroup 2†"),
n.cgroup = c(2, 2),
caption = "Basic table with both column spanners (groups) and row groups",
tfoot = "† A table footer commment")
```
We can modify all our tables by using the `setHtmlTableTemplate()` and we also don't have to set the exact span of each group as it can be assumed from the data.
```{r}
setHtmlTableTheme(pos.caption = "bottom")
output |>
addHtmlTableStyle(css.rgroup = "font-style: italic") |>
htmlTable(header = paste(c("1st", "2nd", "3rd", "4th"), "header"),
rnames = paste(c("1st", "2nd", "3rd", "4th"), "row"),
rgroup = c("Group A", "Group B", ""),
n.rgroup = c(1, 2),
cgroup = c("Cgroup 1", "Cgroup 2†"),
n.cgroup = 3,
caption = "A slightly differnt table with a bottom caption",
tfoot = "† A table footer commment")
```
The basic principles are:
- use the `|>` pipe as much as possible
- build complexity stepwise through passing `addHtmlTableStyle()` function
- keep arguments to a minimum through templating and autocalculation
# Example based upon Swedish statistics
In order to make a more interesting example we will try to look at how the average age changes between Swedish counties the last 15 years. **Goal: visualize migration patterns**.
The dataset has been downloaded from Statistics Sweden and is attached to the htmlTable-package. We will start by reshaping our tidy dataset into a more table adapted format.
```{r, results='markup', message=FALSE, warning=FALSE}
data(SCB)
# The SCB has three other columns and one value column
prepped_scb <- SCB |>
dplyr::mutate(region = relevel(SCB$region, "Sweden")) |>
dplyr::select(year, region, sex, values) |>
tidyr::pivot_wider(names_from = c(region, sex), values_from = values)
# Set rownames to be year
rownames(prepped_scb) <- prepped_scb$year
prepped_scb$year <- NULL
# The dataset now has the rows
names(prepped_scb)
# and the dimensions
dim(prepped_scb)
```
The next step is to calculate two new columns:
- Δint = The change within each group since the start of the observation.
- Δstd = The change in relation to the overall age change in Sweden.
To convey all these layers of information will create a table with multiple levels of column spanners:
County
Men
Women
Age
Δint.
Δext.
Age
Δint.
Δext.
```{r}
mx <- NULL
for (n in names(prepped_scb)) {
tmp <- paste0("Sweden_", strsplit(n, "_")[[1]][2])
mx <- cbind(mx,
cbind(prepped_scb[[n]],
prepped_scb[[n]] - prepped_scb[[n]][1],
prepped_scb[[n]] - prepped_scb[[tmp]]))
}
rownames(mx) <- rownames(prepped_scb)
colnames(mx) <- rep(c("Age",
"Δint",
"Δstd"),
times = ncol(prepped_scb))
mx <- mx[,c(-3, -6)]
# This automated generation of cgroup elements is
# somewhat of an overkill
cgroup <-
unique(sapply(names(prepped_scb),
function(x) strsplit(x, "_")[[1]][1],
USE.NAMES = FALSE))
n.cgroup <-
sapply(cgroup,
function(x) sum(grepl(paste0("^", x), names(prepped_scb))),
USE.NAMES = FALSE)*3
n.cgroup[cgroup == "Sweden"] <-
n.cgroup[cgroup == "Sweden"] - 2
cgroup <-
rbind(c(cgroup, rep(NA, ncol(prepped_scb) - length(cgroup))),
Hmisc::capitalize(
sapply(names(prepped_scb),
function(x) strsplit(x, "_")[[1]][2],
USE.NAMES = FALSE)))
n.cgroup <-
rbind(c(n.cgroup, rep(NA, ncol(prepped_scb) - length(n.cgroup))),
c(2,2, rep(3, ncol(cgroup) - 2)))
print(cgroup)
print(n.cgroup)
```
Next step is to output the table after rounding to the correct number of decimals. The `txtRound` function helps with this, as it uses the `sprintf` function instead of the `round` the resulting strings have the correct number of decimals, i.e. 1.02 will by round become 1 while we want it to retain the last decimal, i.e. be shown as 1.0.
```{r}
htmlTable(txtRound(mx, 1),
cgroup = cgroup,
n.cgroup = n.cgroup,
rgroup = c("First period",
"Second period",
"Third period"),
n.rgroup = rep(5, 3),
tfoot = txtMergeLines("Δint correspnds to the change since start",
"Δstd corresponds to the change compared to national average"))
```
In order to increase the readability we may want to separate the Sweden columns from the county columns, one way is to use the align option with a |. Note that in 1.0 the function continues with the same alignment until the end, i.e. you no longer need count to have the exact right number of columns in your alignment argument.
```{r}
mx |>
txtRound(digits = 1) |>
addHtmlTableStyle(align = "rrrr|r",
spacer.celltype = "double_cell") |>
htmlTable(cgroup = cgroup,
n.cgroup = n.cgroup,
rgroup = c("First period",
"Second period",
"Third period"),
n.rgroup = rep(5, 3),
tfoot = txtMergeLines("Δint correspnds to the change since start",
"Δstd corresponds to the change compared to national average"))
```
If we still feel that we want more separation it is always possible to add colors.
```{r}
mx |>
txtRound(digits = 1) |>
addHtmlTableStyle(align = "rrrr|r",
align.header = "c",
col.columns = c(rep("#E6E6F0", 4),
rep("none", ncol(mx) - 4))) |>
htmlTable(cgroup = cgroup,
n.cgroup = n.cgroup,
rgroup = c("First period",
"Second period",
"Third period"),
n.rgroup = rep(5, 3),
tfoot = txtMergeLines("Δint correspnds to the change since start",
"Δstd corresponds to the change compared to national average"))
```
If we add a color to the row group and restrict the rgroup spanner we may even have a more visual aid.
```{r}
mx |>
txtRound(digits = 1) |>
addHtmlTableStyle(align = "rrrr|r",
align.header = "c",
col.columns = c(rep("#E6E6F0", 4),
rep("none", ncol(mx) - 4)),
col.rgroup = c("none", "#FFFFCC")) |>
htmlTable(cgroup = cgroup,
n.cgroup = n.cgroup,
# I use the - the no breaking space as I don't want to have a
# row break in the row group. This adds a little space in the table
# when used together with the cspan.rgroup=1.
rgroup = c("1st period",
"2nd period",
"3rd period"),
n.rgroup = rep(5, 3),
tfoot = txtMergeLines("Δint correspnds to the change since start",
"Δstd corresponds to the change compared to national average"),
cspan.rgroup = 1)
```
If you want to further add to the visual hints you can use specific HTML-code and insert it into the cells. Here we will color the Δstd according to color. By default htmlTable does not escape HTML characters.
```{r}
cols_2_clr <- grep("Δstd", colnames(mx))
# We need a copy as the formatting causes the matrix to loos
# its numerical property
out_mx <- txtRound(mx, 1)
min_delta <- min(mx[,cols_2_clr])
span_delta <- max(mx[,cols_2_clr]) - min(mx[,cols_2_clr])
for (col in cols_2_clr) {
out_mx[, col] <- mapply(function(val, strength)
paste0("",
val, ""),
val = out_mx[,col],
strength = round((mx[,col] - min_delta)/span_delta*100 + 1),
USE.NAMES = FALSE)
}
out_mx |>
addHtmlTableStyle(align = "rrrr|r",
align.header = "cccc|c",
pos.rowlabel = "bottom",
col.rgroup = c("none", "#FFFFCC"),
col.columns = c(rep("#EFEFF0", 4),
rep("none", ncol(mx) - 4))) |>
htmlTable(caption = "Average age in Sweden counties over a period of
15 years. The Norbotten county is typically known
for having a negative migration pattern compared to
Stockholm, while Uppsala has a proportionally large
population of students.",
rowlabel = "Year",
cgroup = cgroup,
n.cgroup = n.cgroup,
rgroup = c("1st period",
"2nd period",
"3rd period"),
n.rgroup = rep(5, 3),
tfoot = txtMergeLines("Δint corresponds to the change since start",
"Δstd corresponds to the change compared to national average"),
cspan.rgroup = 1)
```
Although a graph most likely does the visualization task better, tables are good at conveying detailed information. It is in my mind without doubt easier in the latest version to find the pattern in the data.
Lastly I would like to thank [Stephen Few](https://www.amazon.com/Show-Me-Numbers-Designing-Enlighten/dp/0970601999), [ThinkUI](http://www.thinkui.co.uk/resources/effective-design-of-data-tables/), and [LabWrite](https://labwrite.ncsu.edu/res/gh/gh-tables.html) for inspiration.
htmlTable/vignettes/text_formatters.Rmd 0000644 0001762 0000144 00000011145 14165130172 020076 0 ustar ligges users ---
title: "Text formatters"
author: "Max Gordon"
date: "`r Sys.Date()`"
VignetteBuilder: knitr, rmarkdown
output:
rmarkdown::html_vignette:
css: custom.css
keep_md: true
toc: true
vignette: >
%\VignetteIndexEntry{Text formatters}
%\usepackage[utf8]{inputenc}
%\VignetteEngine{knitr::rmarkdown}
editor_options:
chunk_output_type: inline
---
Text formatters
===============
Bundled with this package are some text formatting functions. The purpose of these is to convert numeric values into character/text that is more pleasent in publication tables.
txtRound
--------
While `base::round()` is an excellent function in most cases we often want a table to retain trailing 0:s. E.g.
```{r message=FALSE}
library(htmlTable)
library(dplyr)
library(magrittr)
data("mtcars")
mtcars %<>%
mutate(am = factor(am, levels = 0:1, labels = c("Automatic", "Manual")),
vs = factor(vs, levels = 0:1, labels = c("V-shaped", "straight")))
mtcars %>%
head(3) %>%
select(Transmission = am, Gas = mpg, Weight = wt) %>%
htmlTable()
```
doesn't look visually that great, instead we would prefer to have something like this:
```{r}
mtcars %>%
head(3) %>%
select(Transmission = am, Gas = mpg, Weight = wt) %>%
txtRound(digits = 1) %>%
htmlTable()
```
### Single/vector values
At the core of the `txtRound` is the single/vector value conversion:
```{r}
txtRound(c(1, 1.1034), digits = 2)
# Use a character to convert
txtRound("1.2333", digits = 2)
```
If you have some values that need thousand separation you can also add `txtInt_args`.
```{r}
# Large numbers can be combined with the txtInt option
txtRound(12345.12, digits = 1, txtInt_args = TRUE)
txtRound(12345.12, digits = 1, txtInt_args = list(language = "se", html = FALSE))
```
### Data frames
As seen in the introduction we can use data frames for input. We can here rename the converted columns:
```{r}
mtcars %>%
head(3) %>%
select(mpg, wt) %>%
txtRound(mpg, wt_txt = wt, digits = 1)
```
And we can specify the number of decimals that we're interested in per column:
```{r}
mtcars %>%
head(3) %>%
select(mpg, qsec, wt) %>%
txtRound(digits = list(wt = 2, .default = 1))
```
### Matrix
We can also feed a matrix into the `txtRound`:
```{r}
mtcars_matrix <- mtcars %>%
select(mpg, qsec, wt) %>%
head(3) %>%
as.matrix()
mtcars_matrix %>%
txtRound(digits = 1)
```
Here we have some options of excluding columns/rows using regular expressions:
```{r}
mtcars_matrix %>%
txtRound(excl.cols = "^wt$",
excl.rows = "^Mazda RX4$",
digits = 1)
```
Similarly to the data.frame we can use the same syntax to pick column specific digits:
```{r}
mtcars_matrix %>%
txtRound(digits = list(mpg = 0, wt = 2, .default = 1))
```
txtInt
------
While scientific format is useful if familiar with the syntax it can be difficult to grasp for scholars with a less mathematical background. Therefore the thousand separator style can be quite useful, also known as [digital grouping](https://en.wikipedia.org/wiki/Decimal_separator#Digit_grouping):
```{r}
txtInt(1e7)
```
As Swedish and many other languages rely on space (SI-standard) we can specify language as a parameter. Note that as we don't want to have line breaks within a digit we can use [non-breaking space](https://en.wikipedia.org/wiki/Non-breaking_space) for keeping the number intact (the html-code is ` `):
```{r}
txtInt(1e7, language = "SI", html = FALSE)
txtInt(1e7, language = "SI", html = TRUE)
```
Note that there are the option `htmlTable.language` and `htmlTable.html` that you can use for the input of these parameters.
txtPval
-------
The p-value is perhaps the most controversial of statistical output, nevertheless it is still needed and used correctly it has it's use. P-values are frequently rounded as the decimals are not as important. The `txtPval` is a convenient function with some defaults that correspond to typical uses in medical publications.
```{r}
txtPval(c(0.1233213, 0.035, 0.001, 0.000001), html = FALSE)
# The < sign is less-than in html code '<'
txtPval(c(0.05, 0.001, 0.000001), html = TRUE)
```
txtMergeLines
-------------
In html we indicate new line using *<br />* while the latex style uses *hbox*. To help with these two there is the `txtMergeLines` that merges lines into one properly formatted unit:
```{r}
txtMergeLines("Line 1",
"Line 2",
"Line 3")
```
Note that you can also use a single multi-line string:
```{r}
txtMergeLines("Line 1
Line 2
Line 3")
```
```{r}
txtMergeLines("Line 1
Line 2
Line 3",
html = FALSE)
```
htmlTable/R/ 0000755 0001762 0000144 00000000000 14517463044 012377 5 ustar ligges users htmlTable/R/htmlTable_render_getRgroupLine.R 0000644 0001762 0000144 00000011430 13730316012 020626 0 ustar ligges users #' Gets the number of `rgroup` HTML line
#'
#' @param total_columns The total number of columns including the `rowlabel` and the
#' spacer cells
#' @param cspan The column span of the current `rgroup`
#' @param style The css style corresponding to the `rgroup` css style that includes
#' the color specific for the `rgroup`, i.e. `col.rgroup`.
#' @param cgroup_spacer_cells The vector indicating the position of the `cgroup`
#' spacer cells
#' @param prepped_row_css The `css.cell` information for this particular row.
#' @param rgroup_iterator An integer indicating the `rgroup`
#' @inheritParams htmlTable
#' @keywords internal
prGetRgroupLine <- function(x,
total_columns = NULL,
rgroup = NULL,
rgroup_iterator = NULL,
cspan = NULL,
rnames = NULL,
style = NULL,
cgroup_spacer_cells = NULL,
style_list = NULL,
prepped_row_css = NULL) {
ret_str <- ""
rgroup_elmnt <- rgroup[rgroup_iterator]
add_elmnt <- prAttr4RgroupAdd(
rgroup = rgroup,
rgroup_iterator = rgroup_iterator,
no_cols = ncol(x)
)
## this will allow either css.rgroup or col.rgroup to
## color the rgroup label rows
if (is.numeric(cspan) &&
cspan < ncol(x) ||
!is.null(add_elmnt)) {
filler_cells <- rep("", ncol(x))
if (!is.null(add_elmnt)) {
if (!is.numeric(cspan)) {
cspan <- ncol(x) + 1 * !prSkipRownames(rnames)
}
if (length(add_elmnt) > 1) {
if (is.null(names(add_elmnt))) {
stop(
"The rgroup 'add' attribute element no '", rgroup_iterator, "'",
" either be a single element or a named list/vector"
)
}
add_pos <- as.integer(names(add_elmnt))
if (any(is.na(add_pos)) ||
any(add_pos < 1) ||
any(add_pos > ncol(x))) {
stop(
"You have provided invalid element position for rgroup = '", rgroup_elmnt, "'",
" the attribute seeems to be a list but the names are invalid",
" '", paste(names(add_elmnt), collapse = "', '"), "'",
" they should be integers between 1 and ", ncol(x)
)
}
first_pos <- min(add_pos) - 1 + 1 * !prSkipRownames(rnames)
if (is.null(cspan)) {
cspan <- first_pos
} else {
cspan <- min(
cspan,
first_pos
)
}
for (ii in 1:length(add_pos)) {
filler_cells[add_pos[ii]] <- add_elmnt[[ii]]
}
} else if (length(add_elmnt) == 1) {
if (is.null(names(add_elmnt)) ||
names(add_elmnt) == "last") {
add_pos <- ncol(x)
} else {
add_pos <- as.integer(names(add_elmnt))
if (is.na(add_pos) ||
add_pos < 1 ||
add_pos > ncol(x)) {
stop(
"You have provided invalid element position for rgroup = '", rgroup_elmnt, "'",
" the attribute seeems to be a list but the name is invalid",
" '", names(add_elmnt), "'",
" it should be an integer between 1 and ", ncol(x)
)
}
}
first_pos <- add_pos - 1 + 1 * !prSkipRownames(rnames)
if (is.null(cspan)) {
cspan <- first_pos
} else {
cspan <- min(
cspan,
first_pos
)
}
filler_cells[add_pos] <- add_elmnt
} else {
stop(
"The attribute to the rgroup '", rgroup_elmnt, "'",
" does not have a length!"
)
}
}
true_span <- cspan +
sum(cgroup_spacer_cells[0:(cspan - 1 * !prSkipRownames(rnames))]) * prGetEmptySpacerCellSize(style_list = style_list)
ret_str %<>%
sprintf(
"%s\n\t
", header_list),
sep = "\n\t\t")
}
cell_style <- c(style_list$css.header.border_bottom)
if (first_row) {
cell_style %<>% c(top_row_style)
}
cell_str <- prAddCells(
rowcells = header,
cellcode = "th",
style_list = style_list,
style = cell_style,
cgroup_spacer_cells = cgroup_spacer_cells,
has_rn_col = !prSkipRownames(rnames) * 1,
prepped_cell_css = attr(prepped_cell_css, "header"),
style_list_align_key = "align.header"
)
# The bottom border was ment to be here but it doesn't
# work that well in the export
if (is.na(header_rowlabel_str)) {
head_str %<>% paste(paste0("
",
sep = "\n\t")
}
first_row <- FALSE
}
#################################
# Close head and start the body #
#################################
head_str %<>%
paste0("\n\t")
return(head_str)
}
htmlTable/R/htmlTable_render_addCells.R 0000644 0001762 0000144 00000007222 13730316012 017557 0 ustar ligges users #' Add a cell
#'
#' Adds a row of cells `
val
...
` to a table string for
#' [htmlTable()]
#'
#' @inheritParams htmlTable
#' @param rowcells The cells with the values that are to be added
#' @param cellcode Type of cell, can either be `th` or `td`
#' @param style The cell style
#' @param cgroup_spacer_cells The number of cells that occur between
#' columns due to the cgroup arguments.
#' @param has_rn_col Due to the alignment issue we need to keep track
#' of if there has already been printed a rowname column or not and therefore
#' we have this has_rn_col that is either 0 or 1.
#' @param offset For rgroup rows there may be an offset != 1
#' @param style_list The style_list
#' @return `string` Returns the string with the new cell elements
#' @keywords internal
#' @family hidden helper functions for htmlTable
#' @importFrom stringr str_interp
prAddCells <- function(rowcells, cellcode, style_list, style, prepped_cell_css, cgroup_spacer_cells, has_rn_col, offset = 1, style_list_align_key = "align") {
cell_str <- ""
style <- prAddSemicolon2StrEnd(style)
previous_was_spacer_cell <- FALSE
for (nr in offset:length(rowcells)) {
cell_value <- rowcells[nr]
# We don't want missing to be NA in a table, it should be empty
if (is.na(cell_value)) {
cell_value <- ""
}
followed_by_spacer_cell <- nr != length(rowcells) &&
nr <= length(cgroup_spacer_cells) &&
cgroup_spacer_cells[nr] > 0
align_style <- prGetAlign(style_list[[style_list_align_key]],
index = nr + has_rn_col,
style_list = style_list,
followed_by_spacer_cell = followed_by_spacer_cell,
previous_was_spacer_cell = previous_was_spacer_cell)
cell_style <- c(prepped_cell_css[nr],
style)
if (!is.null(style_list$col.columns)) {
cell_style %<>%
c(`background-color` = style_list$col.columns[nr])
}
cell_str %<>% paste(str_interp("<${CELL_TAG} style='${STYLE}'>${CONTENT}",
list(CELL_TAG = cellcode,
STYLE = prGetStyle(cell_style,
align_style),
CONTENT = cell_value)),
sep = "\n\t\t")
# Add empty cell if not last column
if (followed_by_spacer_cell) {
align_style <- prGetAlign(style_list[[style_list_align_key]],
index = nr + has_rn_col,
style_list = style_list,
spacerCell = TRUE,
followed_by_spacer_cell = followed_by_spacer_cell,
previous_was_spacer_cell = previous_was_spacer_cell)
# The same style as previous but without align borders
cell_style <- c(
prepped_cell_css[nr],
style,
align_style
)
spanner_style <- style
if (!is.null(style_list$col.columns)) {
if (style_list$col.columns[nr] == style_list$col.columns[nr + 1]) {
spanner_style %<>% c(`background-color` = style_list$col.columns[nr])
}
}
cell_str %<>%
paste("\n\t\t") %>%
prAddEmptySpacerCell(style_list = style_list,
cell_style = prGetStyle(cell_style, spanner_style),
colspan = cgroup_spacer_cells[nr],
cell_tag = cellcode,
align_style = align_style)
}
previous_was_spacer_cell <- followed_by_spacer_cell
}
return(cell_str)
}
htmlTable/R/tidyHtmlTable_helpers_extractElementsAndConvertToTbl.R 0000644 0001762 0000144 00000000471 13701421460 025162 0 ustar ligges users #' Extract the elements and generate a table with unique elements
#'
#' @param x `list` with columns to be joined
#' @param elements `char` vector with the elements to select
prExtractElementsAndConvertToTbl <- function(x, elements) {
x[elements] %>%
prBindDataListIntoColumns() %>%
dplyr::distinct()
}
htmlTable/R/htmlTable_helpers_escapeHtml.R 0000644 0001762 0000144 00000001024 13701421460 020310 0 ustar ligges users #' Remove html entities from table
#'
#' Removes the htmlEntities from table input data. Note that
#' this also replaces $ signs in order to remove the MathJax
#' issue.
#'
#' @importFrom htmltools htmlEscape
#'
#' @inheritParams htmlTable
#' @return `x` without the html entities
#' @family hidden helper functions for htmlTable
prEscapeHtml <- function(x) {
attributes_x <- attributes(x)
x <- lapply(x, htmlEscape)
x <- lapply(x, function(x) str_replace_all(x, "\\$", "$"))
attributes(x) <- attributes_x
return(x)
}
htmlTable/R/htmlTable_helpers_getStyle.R 0000644 0001762 0000144 00000007114 14517434555 020050 0 ustar ligges users
#' Gets the CSS style element
#'
#' A function for checking, merging, and more
#' with a variety of different style formats.
#'
#' @param ... Styles can be provided as `vector`, `named vector`, or `string`.
#' If you provide a name, e.g. `background: blue`, `align="center"`,
#' the function will convert the `align` into proper `align: center`.
#' @return `string` Returns the codes merged into one string with
#' correct CSS ; and : structure.
#' @keywords internal
#' @import magrittr
#' @family hidden helper functions for htmlTable
prGetStyle <- function(...) {
mergeNames <- function(sv) {
sv <- sv[!is.na(sv)]
if (!is.null(names(sv))) {
sv <-
mapply(function(n, v) {
if (n == "") {
return(v)
}
paste0(n, ": ", v)
}, n = names(sv), v = sv, USE.NAMES = FALSE)
}
return(sv)
}
spltNames <- function(sv) {
ret_sv <- c()
for (i in 1:length(sv)) {
ret_sv <- c(
ret_sv,
# Split on the ; in case it is not at the end/start
unlist(strsplit(sv[i], "\\b;(\\b|\\W+)", perl = TRUE))
)
}
return(ret_sv)
}
styles <- c()
dots <- list(...)
dots <- dots[sapply(dots, function(x) any(!is.na(x) & !is.null(x)))]
if (length(dots) == 0) {
return("")
}
for (i in 1:length(dots)) {
element <- dots[[i]]
if (length(element) == 1) {
if (element == "") {
next
}
if (!grepl("\\b[:](\\b|\\W+)", element, perl = TRUE)) {
if (!is.null(names(element))) {
element <-
paste0(names(element), ": ", element)
} else if (!is.null(names(dots)) &&
names(dots)[i] != "") {
element <-
paste0(names(dots)[i], ": ", element)
} else if (element != "none") {
stop(
"The style should be formatted according to 'style_name: value'",
" you have provided style '", element, "'"
)
}
}
styles %<>%
c(element)
} else {
if (!is.null(names(element))) {
element <- mergeNames(element)
}
styles <- c(
styles,
spltNames(element)
)
}
}
if (!all(grepl("^[^:]+:.+", styles))) {
stop(
"Invalid styles detected, one or more styles lack the needed style 'name: value': ",
paste(paste0("'", styles[!grepl("^[^:]+:.+", styles)], "'"), collapse = ", ")
)
}
# Remove empty background colors - sometimes a background color appears with
# just background-color:; for some unknown reason
if (any(grepl("^background-color:( none|[ ]*;*$)", styles))) {
styles <- styles[-grep("^background-color:( none|[ ]*;*$)", styles)]
}
# Merge background colors
if (sum(grepl("^background-color:", styles)) > 1) {
clrs <- styles[grep("^background-color:", styles)]
clrs <- gsub("^background-color:[ ]*([^;]+);*", "\\1", clrs)
clr <- prMergeClr(clrs)
# Pick a color merge
styles <- styles[-grep("^background-color:", styles)]
styles <-
c(
styles,
paste0("background-color: ", clr)
)
}
style_names <- gsub("^([^:]+).+", "\\1", styles)
if (!any(duplicated(style_names))) {
unique_styles <- styles
} else {
# Only select the last style if two of the same type
# exist. This in order to avoid any conflicts.
unique_styles <- c()
for (n in unique(style_names)) {
unique_styles <-
c(
unique_styles,
styles[max(which(n == style_names))]
)
}
}
unique_styles <- sapply(unique_styles, prAddSemicolon2StrEnd, USE.NAMES = FALSE)
paste(unique_styles, collapse = " ")
}
htmlTable/R/htmlTable_helpers_getAlign.R 0000644 0001762 0000144 00000004335 13730316012 017763 0 ustar ligges users #' Gets alignment
#'
#' @param index The index of the align parameter of interest
#' @family hidden helper functions for
#' @keywords internal
#' @inheritParams addHtmlTableStyle
prGetAlign <- function(align,
index,
style_list = NULL,
spacerCell = FALSE,
followed_by_spacer_cell = FALSE,
previous_was_spacer_cell = FALSE) {
segm_rgx <- "[^lrc]*[rlc][^lrc]*"
res_align <- align
align <- ""
# Loop to remove every element prior to the one of interest
for (i in 1:index) {
if (nchar(res_align) == 0) {
stop("Requested column outside of span, ", index, " > ", i)
}
rmatch <- regexpr(segm_rgx, res_align)
lrc_data <- substr(res_align, 1, rmatch + attr(rmatch, "match.length") - 1)
res_align <- substring(res_align, rmatch + attr(rmatch, "match.length"))
}
styles <- c()
border_in_spacer_cell <- FALSE
if (!is.null(style_list) && style_list$spacer.celltype == "double_cell") {
border_in_spacer_cell = TRUE
}
border_position <- NULL
if (grepl("^\\|", lrc_data)) {
border_position <- "left"
}
if (grepl("\\|$", lrc_data)) {
border_position <- c(border_position, "right")
}
border_style <- list(default = getOption("htmlTable.css.border", default = "1px solid black"))
if (!is.null(border_position)) {
for (pos in border_position) {
border_name <- paste0("border-", pos)
border_style[[pos]] <- getOption(paste0("htmlTable.css.", border_name),
default = border_style$default)
if (!spacerCell &&
(!border_in_spacer_cell ||
(!followed_by_spacer_cell && pos == "right") ||
(!previous_was_spacer_cell && pos == "left"))) {
styles[border_name] <- border_style[[pos]]
}
}
}
if (grepl("l", lrc_data)) {
styles["text-align"] <- "left"
}
if (grepl("c", lrc_data)) {
styles["text-align"] <- "center"
}
if (grepl("r", lrc_data)) {
styles["text-align"] <- "right"
}
return(structure(styles,
has_border = !is.null(border_position),
border_position = border_position,
border_style = border_style))
}
htmlTable/R/deprecated.R 0000644 0001762 0000144 00000002027 13701421460 014611 0 ustar ligges users # Deprecated function names
#' See [txtMergeLines()]
#'
#' @param ... passed onto [txtMergeLines()]
#' @examples
#' \dontrun{
#' # Deprecated function
#' splitLines4Table("hello", "world")
#' }
#' @keywords internal
#' @export
splitLines4Table <- function(...){
warning("splitLines4Table is deprecated, use txtMergeLines() instead")
txtMergeLines(...)
}
#' Deprecated use [txtInt()] instead.
#'
#' @param ... Passed to [txtInt()]
#'
#' @examples
#' \dontrun{
#' # Deprecated function
#' outputInt(123456)
#' }
#'
#' @keywords internal
#' @export
outputInt <- function(...){
warning("outputInt is deprecated, use txtInt() instead.")
txtInt(...)
}
#' Deprecated use [txtPval()] instead
#'
#' @param ... Currently only used for generating warnings of deprecated call
#' @examples
#' \dontrun{
#' # Deprecated function
#' pvalueFormatter(c(0.10234,0.010234, 0.0010234, 0.000010234))
#' }
#' @export
#' @keywords internal
pvalueFormatter <- function(...){
warning("pvalueFormatter is deprecated, use txtPval() instead.")
txtPval(...)
}
htmlTable/R/htmlTable_helpers_tblNo.R 0000644 0001762 0000144 00000002070 13701421460 017303 0 ustar ligges users #' Gets the table counter string
#'
#' Returns the string used for htmlTable to number the different tables.
#' Uses options `table_counter`, `table_counter_str`,
#' and `table_counter_roman` to produce the final string. You
#' can set each option by simply calling `options()`.
#'
#' @param caption The caption if any
#' @return `string` Returns a string formatted according to
#' the table_counter_str and table_counter_roman. The number is
#' decided by the table_counter variable
#' @keywords internal
#' @family hidden helper functions for htmlTable
#' @importFrom utils as.roman
prTblNo <- function(caption = NULL) {
tc <- getOption("table_counter", FALSE)
if (tc == FALSE) {
if (is.null(caption)) {
return("")
} else {
return(caption)
}
}
table_template <- getOption("table_counter_str", "Table %s: ")
out <- sprintf(
table_template,
ifelse(getOption("table_counter_roman", FALSE),
as.character(as.roman(tc)),
as.character(tc)
)
)
if (!is.null(caption)) {
out <- paste(out, caption)
}
return(out)
}
htmlTable/R/htmlTable_helpers_prepareCgroup.R 0000644 0001762 0000144 00000020565 13701421460 021054 0 ustar ligges users
#' Prepares the cgroup argument
#'
#' Due to the complicated structure of multilevel cgroups there
#' some preparation for the cgroup options is required.
#'
#' @inheritParams htmlTable
#' @return `list(cgroup, n.cgroup, align.cgroup, cgroup_spacer_cells)`
#' @keywords internal
#' @family hidden helper functions for htmlTable
prPrepareCgroup <- function(x, cgroup = NULL, n.cgroup = NULL, style_list){
cgroup_spacer_cells <- rep(0, times = (ncol(x) - 1))
# The cgroup is by for compatibility reasons handled as a matrix
if (is.list(cgroup)) {
if (!is.list(n.cgroup)) stop("If cgroup is a list then so must n.cgroup")
if (length(n.cgroup) != length(cgroup)) stop("Different length of cgroup and n.cgroup")
if (!all(sapply(cgroup, is.vector))) stop("The cgroup list consist of vectors")
lengths <- sapply(n.cgroup, sum)
if (any(is.na(lengths))) stop("The cgroup has invalid lengths!")
for (i in 1:length(cgroup)) {
if (length(cgroup[[i]]) != length(n.cgroup[[i]]))
stop("The cgroup and n.cgroup elemennt's lengths don't match for the ", i, "th element")
}
ncols <- max(lengths, na.rm = TRUE)
if (any(sapply(lengths, function(l) ncol(x) %% l != 0))) {
stop("Invalid size of lists: ", vector2string(lengths),
" each element should be be able to evenly divide ", ncol(x))
}
cgroup_mtrx <- matrix(nrow = length(cgroup), ncol = ncols)
n.cgroup_mtrx <- matrix(nrow = length(cgroup), ncol = ncols)
for (i in 1:length(cgroup)) {
for (ii in 1:length(cgroup[[i]])) {
cgroup_mtrx[i, ii] <- cgroup[[i]][ii]
n.cgroup_mtrx[i, ii] <- n.cgroup[[i]][ii]
}
}
cgroup <- cgroup_mtrx
n.cgroup <- n.cgroup_mtrx
} else if (!is.matrix(cgroup)) {
cgroup <- matrix(cgroup, nrow = 1)
if (is.null(n.cgroup)) {
n.cgroup <- matrix(NA, nrow = 1)
} else {
if (any(n.cgroup < 1)) {
warning("You have provided cgroups with less than 1 element,",
" these will therefore be removed: ",
paste(sprintf("'%s' = %d", cgroup, n.cgroup)[n.cgroup < 1],
collapse = ", "))
cgroup <- cgroup[,n.cgroup >= 1, drop = FALSE]
n.cgroup <- n.cgroup[n.cgroup >= 1]
}
if (ncol(cgroup) != length(n.cgroup)) {
n.cgroup <- n.cgroup[n.cgroup > 0]
if (ncol(cgroup) < length(n.cgroup))
stop("You have provided too many n.cgroup,",
" it should have the same length or one less than the cgroup (", ncol(cgroup), ")",
" but it has the length of ", length(n.cgroup))
if (ncol(cgroup) - 1 < length(n.cgroup))
stop("You have provided too few n.cgroup,",
" it should have the ate the length or one less than the cgroup (", ncol(cgroup), ")",
" but it has the length of ", length(n.cgroup))
if (ncol(cgroup) - 1 == length(n.cgroup))
n.cgroup <- c(n.cgroup, ncol(x) - sum(n.cgroup))
}
n.cgroup <- matrix(n.cgroup, nrow = 1)
}
} else if (is.null(n.cgroup)) {
stop("If you specify the cgroup argument as a matrix you have to",
" at the same time specify the n.cgroup argument.")
}
# Go bottom up as the n.cgroup can be based on the previous
# n.cgroup row.
for (i in nrow(cgroup):1) {
# The row is empty and filled with NA's then we check
# that it is possible to evenly split the cgroups among
# the columns of the table
if (all(is.na(n.cgroup[i,])) &&
ncol(x) %% length(cgroup[i,]) == 0){
# This generates the n.cgroup if this is missing
n.cgroup[i,] <- rep(ncol(x)/length(cgroup[i,]), times=length(cgroup[i,]))
}else if(any(n.cgroup[i,!is.na(n.cgroup[i,])] < 1)){
stop("You have in n.cgroup row no ", i, " cell(s) with < 1")
}else if(sum(n.cgroup[i,], na.rm=TRUE) != ncol(x)){
ncgroupFixFromBelowGroup <- function(nc, i){
if (i+1 > nrow(nc))
stop("You have provided an invalid nc",
" where it has fewer rows than the one of interest")
# Select those below that are not missing
row_below <- nc[i + 1, !is.na(nc[i + 1, ])]
# The first position to start
start_pos <- 1
# This is a slightly complicated run that took a while to figure out
# and I'm still afraid of ever having to debug this section.
for (ii in 1:ncol(nc)){
if (!is.na(nc[i, ii])){
# Need to find where to begin tha addition
pos <- ifelse(any(start_pos > cumsum(row_below)),
tail(which(start_pos > cumsum(row_below)), 1) + 1,
1)
# Change the value to the rows below values that add up to this row
# if the nc value is 1 and start position is 1 -> 1:(1+1-1) -> 1:1 -> 1
# if the nc value is 2 and start position is 2 -> 2:(2+2-1) -> 2:3
# if the nc value is 2 and start position is 1 -> 1:(1+2-1) -> 1:2
nc[i, ii] <- sum(row_below[pos:(pos + nc[i, ii] - 1)])
# Update the new start position:
# if first run and nc is 2 then 1 + 2 -> 3 i.e.
# next run the start_pos is 3 and lets say that nc is 3 then 3 + 3 -> 6
start_pos <- start_pos + nc[i, ii]
}
}
# Return the full object
return(nc)
}
# This grouping can be based upon the next row
if (i < nrow(cgroup) &&
sum(n.cgroup[i, ], na.rm = TRUE) == sum(!is.na(n.cgroup[i + 1, ])))
{
n.cgroup <- ncgroupFixFromBelowGroup(n.cgroup, i)
}else{
stop(sprintf("Your columns don't match in the n.cgroup for the %d header row, i.e. %d != %d",
i,
sum(n.cgroup[i,], na.rm=TRUE),
ncol(x)))
}
}
if (!all(is.na(n.cgroup[i, ]) == is.na(cgroup[i, ]))){
stop("On header row (the cgroup argument) no ", i,
" you fail to get the NA's matching.",
"\n The n.cgroup has elements no:",
sprintf(" '%s'", paste(which(is.na(n.cgroup[i, ])), collapse=", ")),
" missing while cgroup has elements no:",
sprintf(" '%s'", paste(which(is.na(cgroup[i, ])), collapse=", ")),
" missing.",
"\n If the NA's don't occur at the same point",
" the software can't decide what belongs where.",
"\n The full cgroup row: ", paste(cgroup[i, ], collapse=", "),
"\n The full n.cgroup row: ", paste(n.cgroup[i, ], collapse=", "),
"\n Example: for a two row cgroup it would be:",
" n.cgroup = rbind(c(1, NA), c(2, 1)) and",
" cgroup = rbind(c('a', NA), c('b', 'c'))")
}
# Add a spacer cell for each cgroup. If two cgroups
# on different rows have the same separation then it
# is enough to have one spacer.
for (ii in 1:(length(n.cgroup[i, ])-1)){
if (!is.na(n.cgroup[i, ii]) && sum(n.cgroup[i, 1:ii], na.rm=TRUE) <= length(cgroup_spacer_cells))
cgroup_spacer_cells[sum(n.cgroup[i, 1:ii], na.rm=TRUE)] <- 1
}
}
# Get alignment
if (is.null(style_list$align.cgroup)) {
style_list$align.cgroup <- apply(n.cgroup, 1,
function(nc) paste(rep("c", times=sum(!is.na(nc))), collapse=""))
style_list$align.cgroup <- matrix(style_list$align.cgroup,
ncol = 1)
} else {
if (NROW(style_list$align.cgroup) != nrow(n.cgroup))
stop("You have different dimensions for your style_list$align.cgroup and your cgroups, ",
NROW(style_list$align.cgroup), " (just) !=", nrow(n.cgroup), " (n.cgroup)")
# An old leftover behaviour from the latex() function
if (NCOL(style_list$align.cgroup) > 1)
style_list$align.cgroup <- apply(style_list$align.cgroup, 1,
function(x) paste(ifelse(is.na(x), "", x), collapse=""))
style_list$align.cgroup <- mapply(prPrepareAlign,
align = style_list$align.cgroup,
x = apply(n.cgroup, 1, function(nc) sum(!is.na(nc))),
rnames=FALSE)
style_list$align.cgroup <- matrix(style_list$align.cgroup, ncol=1)
}
style_list$css.cgroup <- prPrepareCss(x = cgroup, css = style_list$css.cgroup)
return(list(cgroup = cgroup,
n.cgroup = n.cgroup,
align.cgroup = style_list$align.cgroup,
cgroup_spacer_cells = cgroup_spacer_cells,
css.cgroup = style_list$css.cgroup))
}
htmlTable/R/tidyHtmlTable_helpers_removeRowsWithNA.r 0000644 0001762 0000144 00000001653 13701421460 022350 0 ustar ligges users # Removes rows containing NA values in any mapped columns from the tidy dataset
removeRowsWithNA <- function(tidyTableDataList, skip_removal_warning = FALSE) {
tidyTableData <- tidyTableDataList %>% tibble::as_tibble()
hasNA <- tidyTableData %>% is.na()
naPerRow <- hasNA %>%
rowSums()
keepIdx <- naPerRow == 0
removed <- sum(naPerRow > 0)
if (removed != 0) {
naPerCol <- hasNA %>% colSums()
naColumns <- colnames(hasNA)[naPerCol > 0]
if (!skip_removal_warning) {
warning(paste0(
"NA values were detected in the following columns of ",
"the tidy dataset: ",
paste(naColumns, collapse = ", "), ". ",
removed, " row(s) in the tidy dataset were removed."
))
}
}
return(sapply(tidyTableDataList,
function(x) {
if (is.data.frame(x)) {
return(x %>% dplyr::filter(keepIdx))
}
return(x[keepIdx])
},
simplify = FALSE
))
}
htmlTable/R/interactiveTable.R 0000644 0001762 0000144 00000021307 14517434555 016017 0 ustar ligges users #' An interactive table that allows you to limit the size of boxes
#'
#' This function wraps the htmlTable and adds JavaScript code for toggling the amount
#' of text shown in any particular cell.
#'
#' @param x The table to be printed
#' @param ... The exact same parameters as [htmlTable()] uses
#' @param txt.maxlen The maximum length of a text
#' @param button Indicator if the cell should be clickable or if a button should appear with a plus/minus
#' @param minimized.columns Notifies if any particular columns should be collapsed from start
#' @param js.scripts If you want to add your own JavaScript code you can just add it here.
#' All code is merged into one string where each section is wrapped in it's own
#' `` element.
#' @return An htmlTable with a javascript attribute containing the code that is then printed
#' @export
#' @example inst/examples/interactiveTable_example.R
#' @rdname interactiveTable
interactiveTable <- function(x,
...,
txt.maxlen = 20,
button = getOption("htmlTable.interactiveTable.button", default = FALSE),
minimized.columns = NULL,
js.scripts = c()) {
UseMethod("interactiveTable")
}
getButtonDiv <- function(sign = "-") {
template <- system.file("html_components/button.html", package = "htmlTable")
if (template == "") {
stop("Could not find the button template file")
}
template <- readChar(template, nchars = file.info(template)$size)
gsub("%sign%", sign, template) %>%
gsub("[\n\r]", " ", .)
}
#' @export
#' @method interactiveTable default
interactiveTable.default <- function(x,
...,
txt.maxlen = 20,
button = getOption("htmlTable.interactiveTable.button", default = FALSE),
minimized.columns = NULL,
js.scripts = c()) {
if ("data.frame" %in% class(x)) {
x <- prConvertDfFactors(x)
}
if (!is.null(minimized.columns)) {
if (is.character(minimized.columns)) {
if (minimized.columns != "last") {
stop(
"If you want to provide a character for columns you must",
" provide 'last' - '", minimized.columns, "' has not yet",
" been implemented."
)
}
minimized.columns <- ncol(x)
} else if (is.logical(minimized.columns)) {
minimized.columns <- which(minimized.columns)
} else if (!is.numeric(minimized.columns)) {
stop("Expecting the minimized columns to either be numbers or logical parameters")
} else if (max(minimized.columns) > ncol(x)) {
stop(
"You can't minimize columns larger than the number of columns available.",
"I.e. ", paste(minimized.columns[minimized.columns > ncol(x)], collapse = ", "),
" > ", ncol(x)
)
}
if (!is.null(dim(minimized.columns))) {
stop("Can only handle column vectors for minimization")
}
addon_elements <- paste(
"... ",
"%span_inner_text%"
)
if (button) {
addon_elements <- paste(
addon_elements,
getButtonDiv("+")
)
}
for (col_no in minimized.columns) {
for (row_no in 1:nrow(x)) {
if (nchar(x[row_no, col_no]) > txt.maxlen) {
x[row_no, col_no] <-
paste0(
substr(x[row_no, col_no], 1, txt.maxlen),
gsub("%span_inner_text%", x[row_no, col_no], addon_elements)
)
}
}
}
# Pass false to allow warning later on
minimized.columns <- FALSE
}
tbl <- htmlTable(x, escape.html = FALSE, ...)
return(interactiveTable(tbl,
txt.maxlen = 20,
button = button,
minimized.columns = minimized.columns,
js.scripts = js.scripts
))
}
#' @method interactiveTable htmlTable
#' @rdname interactiveTable
#' @export
interactiveTable.htmlTable <- function(x,
...,
txt.maxlen = 20,
button = getOption("htmlTable.interactiveTable.button", default = FALSE),
minimized.columns = NULL,
js.scripts = c()) {
if (!is.null(minimized.columns) && all(minimized.columns != FALSE)) {
stop(
"Can't minimize columns after creating the htmlTable.",
" Try calling the function directly with the input data that you used for htmlTable"
)
}
class(x) <- c("interactiveTable", class(x))
if (button) {
template <- system.file("javascript/button.js", package = "htmlTable")
if (template == "") {
stop("Could not find the javascript button template file")
}
template <- readChar(template, nchars = file.info(template)$size)
attr(x, "javascript") <- c(
js.scripts,
template %>%
gsub("%txt.maxlen%", txt.maxlen, .) %>%
gsub("%btn%", getButtonDiv(), .)
)
} else {
template <- system.file("javascript/toggler.js", package = "htmlTable")
if (template == "") {
stop("Could not find the javascript toggler template file")
}
template <- readChar(template, nchars = file.info(template)$size)
attr(x, "javascript") <- c(
js.scripts,
template %>%
gsub("%txt.maxlen%", txt.maxlen, .)
)
}
return(x)
}
#' @rdname interactiveTable
#' @importFrom knitr knit_print
#' @importFrom knitr asis_output
#' @export
knit_print.interactiveTable <- function(x, ...) {
if (getOption("interactiveTable_knitprint", FALSE)) {
asis_output(x)
} else {
options(interactiveTable_knitprint = TRUE)
asis_output(paste(
x,
attr(x, "javascript")
))
}
}
#' Gets a string with all the scripts merged into one script tag
#'
#' Each element has it's own script tags in otherwise an error will cause
#' all the scripts to fail.
#'
#' @param x An interactiveTable
#' @return string
#' @keywords internal
prGetScriptString <- function(x) {
scripts <- attr(x, "javascript")
if (is.null(scripts)) {
stop("You have provided an object of class ", class(x), " that does not contain a javascript attribute")
}
sapply(scripts,
USE.NAMES = FALSE,
FUN = function(s) {
if (s == "") {
return("")
}
paste(
""
)
}
) %>%
paste(collapse = "\n\n \n")
}
#' @rdname interactiveTable
#' @inheritParams htmlTable
#' @export
print.interactiveTable <- function(x, useViewer, ...) {
args <- attr(x, "...")
# Use the latest ... from the print call
# and override the original htmlTable call ...
# if there is a conflict
print_args <- list(...)
for (n in names(print_args)) {
args[[n]] <- print_args[[n]]
}
# Since the print may be called from another print function
# it may be handy to allow functions to use attributes for the
# useViewer parameter
if (missing(useViewer)) {
if ("useViewer" %in% names(args) &&
(is.logical(args$useViewer) ||
is.function(args$useViewer))) {
useViewer <- args$useViewer
args$useViewer <- NULL
} else {
useViewer <- TRUE
}
}
if (interactive() &&
!getOption("htmlTable.cat", FALSE) &&
(is.function(useViewer) ||
useViewer != FALSE)) {
if (is.null(args$file)) {
args$file <- tempfile(fileext = ".html")
}
htmlPage <- paste("",
"",
"",
"",
"",
"",
"
",
x,
"
",
prGetScriptString(x),
"",
"",
sep = "\n"
)
# We only want to use those arguments that are actually in cat
# anything else that may have inadvertadly slipped in should
# be ignored or it will be added to the output
cat_args <- args
cat_args <- cat_args[names(cat_args) %in% names(formals(cat))[-1]]
do.call(cat, c(htmlPage, cat_args))
if (is.function(useViewer)) {
useViewer(args$file)
} else {
viewer <- getOption("viewer")
if (!is.null(viewer) &&
is.function(viewer)) {
# (code to write some content to the file)
viewer(args$file)
} else {
utils::browseURL(args$file)
}
}
} else {
cat_args <- args
cat_args <- cat_args[names(cat_args) %in% names(formals(cat))[-1]]
do.call(cat, c(x, cat_args))
cat(prGetScriptString(x))
}
invisible(x)
}
htmlTable/R/htmlTable_helpers_prepareAlign.R 0000644 0001762 0000144 00000002772 13725113315 020652 0 ustar ligges users #' Prepares the align to match the columns
#'
#' The alignment may be tricky and this function therefore simplifies
#' this process by extending/shortening the alignment to match the
#' correct number of columns.
#'
#' @param default_rn The default rowname alignment. This is an option
#' as the header uses the same function and there may be differences in
#' how the alignments should be implemented.
#' @keywords internal
#' @family hidden helper functions for htmlTable
#' @inheritParams htmlTable
prPrepareAlign <- function(align, x, rnames, default_rn = "l") {
assert_character(align)
if (length(align) > 1) {
align <- paste(align, collapse = "")
}
segm_rgx <- "[^lrc]*[rlc][^lrc]*"
no_elements <- length(strsplit(align, split = segm_rgx)[[1]])
no_cols <- ifelse(is.null(dim(x)), x, ncol(x))
if (!prSkipRownames(rnames)) {
no_cols <- no_cols + 1
if (no_elements < no_cols) {
align <- paste0(default_rn, align)
}
}
res_align <- align
align <- ""
for (i in 1:no_cols) {
rmatch <- regexpr(segm_rgx, res_align)
tmp_lrc <- substr(res_align, 1, rmatch + attr(rmatch, "match.length") - 1)
res_align <- substring(res_align, rmatch + attr(rmatch, "match.length"))
align <- paste0(
align,
tmp_lrc
)
if (nchar(res_align) < 1 &&
i != no_cols) {
align <- paste0(
align,
paste(rep(tmp_lrc, times = no_cols - i), collapse = "")
)
break
}
}
structure(align,
n = no_cols,
class = class(align)
)
}
htmlTable/R/htmlTable.R 0000644 0001762 0000144 00000116666 14517464155 014462 0 ustar ligges users #' Output an HTML table
#'
#' Generates advanced HTML tables with column and row groups
#' for a dense representation of complex data. Designed for
#' maximum compatibility with copy-paste into word processors.
#' For styling, see [addHtmlTableStyle()] and [setHtmlTableTheme()].
#' *Note:* If you are using \pkg{tidyverse} and \pkg{dplyr} you may
#' want to check out [tidyHtmlTable()] that automates many of the arguments
#' that `htmlTable` requires.
#'
#' @section Multiple rows of column spanners `cgroup`:
#'
#' If you want to have a column spanner in multiple levels (rows) you can
#' set the `cgroup` and `n.cgroup` arguments to a `matrix` or `list`.
#'
#' For different level elements, set absent ones to NA in a matrix. For example,
#' `cgroup = rbind(c("first", "second", NA), c("a", "b", "c"))`.
#' And the corresponding `n.cgroup` would be `n.cgroup = rbind(c(1, 2, NA), c(2, 1, 2))`.
#' for a table consisting of 5 columns. The "first" spans the first two columns,
#' the "second" spans the last three columns, "a" spans the first two, "b"
#' the middle column, and "c" the last two columns.
#'
#' Using a list is recommended to avoid handling `NA`s.
#'
#' For an empty `cgroup`, use `""`.
#'
#' @section The `rgroup` argument:
#'
#' The `rgroup` groups rows seamlessly. Each row in a group is indented by two
#' spaces (unless the rgroup is `""`) and grouped by its rgroup element. The `sum(n.rgroup)`
#' should be \if{html}{\out{≤}}\eqn{\leq} matrix rows. If fewer, remaining rows are padded with an empty rgroup (`""`). If `rgroup`
#' has one more element than `n.rgroup`, the last `n.rgroup` is computed as `nrow(x) - sum(n.rgroup)`
#' for a smoother table generation.
#'
#' @section The add attribute to `rgroup`:
#'
#' To add an extra element at the `rgroup` level/row, use `attr(rgroup, 'add')`.
#' The value can either be a `vector`, a `list`,
#' or a `matrix`. See `vignette("general", package = "htmlTable")` for examples.
#'
#' * A `vector` of either equal number of `rgroup`s to the number
#' of `rgroup`s that aren't empty, i.e. `rgroup[rgroup != ""]`. Or a named vector where
#' the name must correspond to either an `rgroup` or to an `rgroup` number.
#' * A `list` that has exactly the same requirements as the vector.
#' In addition to the previous we can also have a list with column numbers within
#' as names within the list.
#' * A `matrix` with the dimension `nrow(x) x ncol(x)` or
#' `nrow(x) x 1` where the latter is equivalent to a named vector.
#' If you have `rownames` these will resolve similarly to the names to the
#' `list`/`vector` arguments. The same thing applies to `colnames`.
#'
#' @section Important \pkg{knitr}-note:
#'
#' This function will only work with \pkg{knitr} outputting *HTML*, i.e.
#' markdown mode. As the function returns raw HTML-code
#' the compatibility with non-HTML formatting is limited,
#' even with [pandoc](https://pandoc.org/).
#'
#' Thanks to the the [knitr::knit_print()] and the [knitr::asis_output()]
#' the `results='asis'` is *no longer needed* except within for-loops.
#' If you have a knitr-chunk with a for loop and use `print()` to produce
#' raw HTML you must set the chunk option `results='asis'`. *Note*:
#' the print-function relies on the [base::interactive()] function
#' for determining if the output should be sent to a browser or to the terminal.
#' In vignettes and other directly knitted documents you may need to either set
#' `useViewer = FALSE` alternatively set `options(htmlTable.cat = TRUE)`.
#'
#' @section RStudio's notebook:
#'
#' RStudio has an interactive notebook that allows output directly into the document.
#' In order for the output to be properly formatted it needs to have the `class`
#' of `html`. The `htmlTable` tries to identify if the environment is a
#' notebook document (uses the \pkg{rstudioapi} and identifies if its a file with and `Rmd`
#' file ending or if there is an element with `html_notebook`). If you don't want this
#' behavior you can remove it using the `options(htmlTable.skip_notebook = TRUE)`.
#'
#' @section Table counter:
#'
#' If you set the option table_counter you will get a Table 1,2,3
#' etc before each table, just set `options(table_counter=TRUE)`. If
#' you set it to a number then that number will correspond to the start of
#' the table_counter. The `table_counter` option will also contain the number
#' of the last table, this can be useful when referencing it in text. By
#' setting the option `options(table_counter_str = "Table %s: ")`
#' you can manipulate the counter table text that is added prior to the
#' actual caption. Note, you should use the [sprintf()] `%s`
#' instead of `%d` as the software converts all numbers to characters
#' for compatibility reasons. If you set `options(table_counter_roman = TRUE)`
#' then the table counter will use Roman numerals instead of Arabic.
#'
#' @section Empty data frames:
#' An empty data frame will result in a warning and output an empty table, provided that
#' `rgroup` and `n.rgroup` are not specified. All other row layout options will be ignored.
#'
#' @section Options:
#'
#' There are multiple options that can be set, here is a set of the perhaps most used
#' * `table_counter` - logical - activates a counter for each table
#' * `table_counter_roman` - logical - if true the counter is in Roman numbers, i.e. I, II, III, IV...
#' * `table_counter_str` - string - the string used for generating the table counter text
#' * `useViewer` - logical - if viewer should be used fro printing the table
#' * `htmlTable.cat` - logical - if the output should be directly sent to `cat()`
#' * `htmlTable.skip_notebook` - logical - skips the logic for detecting notebook
#' * `htmlTable.pretty_indentation` - logical - there was some issues in previous Pandoc versions
#' where HTML indentation caused everything to be interpreted as code. This seems to be fixed
#' and if you want to look at the raw HTML code it is nice to have this set to `TRUE` so that
#' the tags and elements are properly indented.
#' * `htmlTableCompat` - string - see parameter description
#'
#' @section Other:
#'
#' *Copy-pasting:* As you copy-paste results into Word you need to keep
#' the original formatting. Either right click and choose that paste option or click
#' on the icon appearing after a paste. Currently the following compatibilities
#' have been tested with MS Word 2016:
#'
#' * **Internet Explorer** (v. 11.20.10586.0) Works perfectly when copy-pasting into Word
#' * **RStudio** (v. 0.99.448) Works perfectly when copy-pasting into Word.
#' *Note:* can have issues with multi-line `cgroup`s -
#' see [bug](https://bugs.chromium.org/p/chromium/issues/detail?id=305130)
#' * **Chrome** (v. 47.0.2526.106) Works perfectly when copy-pasting into Word.
#' *Note:* can have issues with multi-line `cgroup`s -
#' see [bug](https://bugs.chromium.org/p/chromium/issues/detail?id=305130)
#' * **Firefox** (v. 43.0.3) Works poorly - looses font-styling, lines and general feel
#' * **Edge** (v. 25.10586.0.0) Works poorly - looses lines and general feel
#'
#' *Direct word processor opening:* Opening directly in Libre Office or Word is no longer
#' recommended. You get much prettier results using the cut-and-paste option.
#'
#' *Google docs*: Copy-paste directly into a Google docs document is handled rather well. This
#' seems to work especially well when the paste comes directly from a Chrome browser.
#'
#' *Note* that when using complex `cgroup` alignments with multiple levels
#' not every browser is able to handle this. For instance the RStudio
#' webkit browser seems to have issues with this and a
#' [bug has been filed](https://bugs.chromium.org/p/chromium/issues/detail?id=305130).
#'
#' As the table uses HTML for rendering you need to be aware of that headers,
#' row names, and cell values should try respect this for optimal display. Browsers
#' try to compensate and frequently the tables still turn out fine but it is
#' not advised. Most importantly you should try to use
#' `<` instead of `<` and
#' `>` instead of `>`. You can find a complete list
#' of HTML characters [here](https://ascii.cl/htmlcodes.htm).
#'
#' Lastly, I want to mention that function was inspired by the [Hmisc::latex()]
#' that can be an excellent alternative if you wish to switch to PDF-output.
#' For the sibling function [tidyHtmlTable()] you can directly switch between
#' the two using the `table_fn` argument.
#'
#' @param x The matrix/data.frame with the data. For the `print` and `knit_print`
#' it takes a string of the class `htmlTable` as `x` argument.
#' @param header A vector of character strings specifying column
#' header, defaulting to [`colnames(x)`][base::colnames]
#' @param rnames Default row names are generated from [`rownames(x)`][base::colnames]. If you
#' provide `FALSE` then it will skip the row names. *Note:* For `data.frames`
#' if you do [`rownames(my_dataframe) <- NULL`][base::colnames] it still has
#' row names. Thus you need to use `FALSE` if you want to
#' supress row names for `data.frames`.
#' @param rowlabel If the table has row names or `rnames`,
#' `rowlabel` is a character string containing the
#' column heading for the `rnames`.
#' @param caption Adds a table caption.
#' @param tfoot Adds a table footer (uses the `` HTML element). The
#' output is run through [txtMergeLines()] simplifying the generation
#' of multiple lines.
#' @param label A text string representing a symbolic label for the
#' table for referencing as an anchor. All you need to do is to reference the
#' table, for instance `see table 2`. This is
#' known as the element's id attribute, i.e. table id, in HTML linguo, and should
#' be unique id for an HTML element in contrast to the `css.class` element attribute.
#' @param rgroup A vector of character strings containing headings for row groups.
#' `n.rgroup` must be present when `rgroup` is given. See
#' detailed description in section below.
#' @param n.rgroup An integer vector giving the number of rows in each grouping. If `rgroup`
#' is not specified, `n.rgroup` is just used to divide off blocks of rows by horizontal
#' lines. If `rgroup` is given but `n.rgroup` is omitted, `n.rgroup` will
#' default so that each row group contains the same number of rows. If you want additional
#' rgroup column elements to the cells you can sett the "add" attribute to `rgroup` through
#' `attr(rgroup, "add")`, see below explaining section.
#' @param cgroup A vector, matrix or list of character strings defining major column header. The default
#' is to have none. These elements are also known as *column spanners*. If you want a column *not*
#' to have a spanner then put that column as "". If you pass cgroup and `n.crgroup` as
#' matrices you can have column spanners for several rows. See cgroup section below for details.
#' @param n.cgroup An integer vector, matrix or list containing the number of columns for which each element in
#' cgroup is a heading. For example, specify `cgroup=c("Major_1","Major_2")`,
#' `n.cgroup=c(3,3)` if `"Major_1"` is to span columns 1-3 and
#' `"Major_2"` is to span columns 4-6.
#' `rowlabel` does not count in the column numbers. You can omit `n.cgroup`
#' if all groups have the same number of columns. If the `n.cgroup` is one less than
#' the number of columns in the matrix/data.frame then it automatically adds those.
#' @param tspanner The table spanner is somewhat of a table header that
#' you can use when you want to join different tables with the same columns.
#' @param n.tspanner An integer vector with the number of rows or `rgroup`s in the original
#' matrix that the table spanner should span. If you have provided one fewer n.tspanner elements
#' the last will be imputed from the number of `rgroup`s (if you have provided `rgroup` and
#' `sum(n.tspanner) < length(rgroup)`) or the number of rows in the table.
#' @param cspan.rgroup The number of columns that an `rgroup` should span. It spans
#' by default all columns but you may want to limit this if you have column colors
#' that you want to retain.
#' @param total The last row is sometimes a row total with a border on top and
#' bold fonts. Set this to `TRUE` if you are interested in such a row. If you
#' want a total row at the end of each table spanner you can set this to `"tspanner"`.
#' @param ... Passed on to `print.htmlTable` function and any argument except the
#' `useViewer` will be passed on to the [base::cat()] functions arguments.
#' *Note:* as of version 2.0.0 styling options are still allowed but it is recommended
#' to instead preprocess your object with [addHtmlTableStyle()].
#' @param ctable If the table should have a double top border or a single a' la LaTeX ctable style
#' @param compatibility Is default set to `LibreOffice` as some
#' settings need to be in old HTML format as Libre Office can't
#' handle some commands such as the css caption-alignment. Note: this
#' option is not yet fully implemented for all details, in the future
#' I aim to generate a HTML-correct table and one that is aimed
#' at Libre Office compatibility. Word-compatibility is difficult as
#' Word ignores most settings and destroys all layout attempts
#' (at least that is how my 2010 version behaves). You can additinally use the
#' `options(htmlTableCompat = "html")` if you want a change to apply
#' to the entire document.
#' MS Excel sometimes misinterprets certain cell data when opening HTML-tables (eg. 1/2 becomes 1. February).
#' To avoid this please specify the correct Microsoft Office format for each cell in the table using the css.cell-argument.
#' To make MS Excel interpret everything as text use "mso-number-format:\"\\@\"".
#' @param escape.html logical: should HTML characters be escaped? Defaults to FALSE.
#' @return Returns a formatted string representing an HTML table of class `htmlTable`.
#'
#' @example inst/examples/htmlTable_example.R
#'
#' @seealso [addHtmlTableStyle()],
#' [setHtmlTableTheme()],
#' [tidyHtmlTable()].
#' [txtMergeLines()],
#' [Hmisc::latex()]
#'
#' @export
#' @rdname htmlTable
#' @family table functions
htmlTable <- function(x,
header = NULL,
rnames = NULL,
rowlabel = NULL,
caption = NULL,
tfoot = NULL,
label = NULL,
# Grouping
rgroup = NULL,
n.rgroup = NULL,
cgroup = NULL,
n.cgroup = NULL,
tspanner = NULL,
n.tspanner = NULL,
total = NULL,
ctable = TRUE,
compatibility = getOption("htmlTableCompat", "LibreOffice"),
cspan.rgroup = "all",
escape.html = FALSE,
...) {
UseMethod("htmlTable")
}
#' @export
htmlTable.data.frame <- function(x, ...) {
# deal gracefully with an empty data frame - issue a warning.
if (nrow(x) == 0) {
warning(paste(deparse(substitute(x)), "is an empty object"))
}
htmlTable.default(prConvertDfFactors(x), ...)
}
#' @export
htmlTable.matrix <- function(x, ...) {
# deal gracefully with an empty matrix - issue a warning.
if (nrow(x) == 0) {
warning(paste(deparse(substitute(x)), "is an empty object"))
}
# Default to a sum-row when provided a table that
dots <- list(...)
if (all(class(x) %in% c("table", "matrix", "array")) &&
!is.null(rownames(x)) &&
grepl("^sum$", tail(rownames(x), 1), ignore.case = TRUE) &&
is.null(dots$total)) {
dots$total <- TRUE
}
dots$x <- x
do.call(htmlTable.default, dots)
}
`.` <- "magrittr CMD check issue"
#' @importFrom stringr str_replace str_replace_all str_trim
#' @importFrom htmltools htmlEscape
#' @import checkmate
#' @import magrittr
#' @rdname htmlTable
#' @export
htmlTable.default <- function(x,
header = NULL,
rnames = NULL,
rowlabel = NULL,
caption = NULL,
tfoot = NULL,
label = NULL,
# Grouping
rgroup = NULL,
n.rgroup = NULL,
cgroup = NULL,
n.cgroup = NULL,
tspanner = NULL,
n.tspanner = NULL,
total = NULL,
ctable = TRUE,
compatibility = getOption("htmlTableCompat", "LibreOffice"),
cspan.rgroup = "all",
escape.html = FALSE,
...) {
if (isTRUE(escape.html)) {
x <- prEscapeHtml(x)
}
x <- prPrepInputMatrixDimensions(x, header = header)
dots <- list(...)
style_dots <- names(dots) %in% Filter(
function(x) !(x %in% c("", "x")),
formals(addHtmlTableStyle) %>% names()
)
if (sum(style_dots) > 0) {
style_dots_list <- dots[style_dots]
dots <- dots[!style_dots]
style_dots_list$x <- x
x <- do.call(addHtmlTableStyle, style_dots_list)
}
style_list <- prGetAttrWithDefault(x,
which = style_attribute_name,
default = getHtmlTableTheme()
)
if (is.null(rgroup) && !is.null(n.rgroup)) {
# Add "" rgroups corresponding to the n.rgroups
rgroup <- rep("", length.out = length(n.rgroup))
}
# Unfortunately in knitr there seems to be some issue when the
# rnames is specified immediately as: rnames=rownames(x)
if (is.null(rnames)) {
if (any(is.null(rownames(x)) == FALSE)) {
rnames <- rownames(x)
}
if (any(is.null(rownames(x))) &&
!is.null(rgroup)) {
warning(
"You have not specified rnames but you seem to have rgroups.",
" If you have the first column as rowname but you want the rgroups",
" to result in subhedings with indentation below then, ",
" you should change the rnames to the first column and then",
" remove it from the table matrix (the x argument object)."
)
}
}
if (!is.null(rowlabel) &&
prSkipRownames(rnames)) {
stop(
"You can't have a row label and no rownames.",
" Either remove the rowlabel argument",
", set the rnames argument",
", or set the rownames of the x argument."
)
}
if (is.null(header) && !is.null(colnames(x))) {
header <- colnames(x)
} else if (!is.null(header)) {
if (length(header) != ncol(x)) {
stop(
"You have a header with ", length(header), " cells",
" while your output matrix has only ", ncol(x), " columns"
)
}
}
# Fix alignment to match with the matrix
style_list$align <- prPrepareAlign(style_list$align, x = x, rnames = rnames)
style_list$align.header <- prPrepareAlign(style_list$align.header, x = x, rnames = rnames, default_rn = "c")
if (tolower(compatibility) %in% c(
"libreoffice", "libre office",
"open office", "openoffice",
"word", "ms word", "msword"
)) {
compatibility <- "LibreOffice"
}
if (!is.null(rgroup)) {
if (is.null(n.rgroup)) {
stop("You need to specify the argument n.rgroup if you want to use rgroups")
}
if (any(n.rgroup < 1)) {
warning(
"You have provided rgroups with less than 1 elements,",
" these will therefore be removed: ",
paste(sprintf("'%s' = %d", rgroup, n.rgroup)[n.rgroup < 1],
collapse = ", "
)
)
rgroup <- rgroup[n.rgroup >= 1]
n.rgroup <- n.rgroup[n.rgroup >= 1]
}
# Sanity check for rgroup
if (sum(n.rgroup) > nrow(x)) {
stop(
"Your rows are fewer than suggested by the n.rgroup,",
" i.e. ", sum(n.rgroup), "(n.rgroup) > ", nrow(x), "(rows in x)"
)
}
if (sum(n.rgroup) < nrow(x) &&
(length(n.rgroup) == length(rgroup) - 1 ||
length(n.rgroup) == length(rgroup))) {
# Add an empty rgroup if missing
if (length(n.rgroup) == length(rgroup)) {
rgroup <- c(rgroup, "")
}
# Calculate the remaining rows and add those
n.rgroup <- c(n.rgroup, nrow(x) - sum(n.rgroup))
} else if (sum(n.rgroup) != nrow(x)) {
stop("Your n.rgroup doesn't add up")
}
# Sanity checks style_list$css.rgroup and prepares the style
if (length(style_list$css.rgroup) > 1 &&
length(style_list$css.rgroup) != length(rgroup)) {
stop(sprintf(
"You must provide the same number of styles as the rgroups, %d != %d",
length(style_list$css.rgroup), length(rgroup)
))
} else if (length(style_list$css.rgroup) == 1) {
style_list$css.rgroup <- prGetStyle(style_list$css.rgroup)
if (length(rgroup) > 0) {
style_list$css.rgroup <- rep(style_list$css.rgroup, length.out = length(rgroup))
}
} else {
for (i in 1:length(style_list$css.rgroup)) {
style_list$css.rgroup[i] <- prGetStyle(style_list$css.rgroup[i])
}
}
# Sanity checks style_list$css.rgroup.sep and prepares the style
if (length(style_list$css.rgroup.sep) > 1 &&
length(style_list$css.rgroup.sep) != length(rgroup) - 1) {
stop(sprintf(
"You must provide the same number of separators as the rgroups - 1, %d != %d",
length(style_list$css.rgroup.sep), length(rgroup) - 1
))
} else if (length(style_list$css.rgroup.sep) == 1) {
style_list$css.rgroup.sep <- prAddSemicolon2StrEnd(style_list$css.rgroup.sep)
if (length(rgroup) > 0) {
style_list$css.rgroup.sep <- rep(style_list$css.rgroup.sep, length.out = length(rgroup))
}
} else {
for (i in 1:length(style_list$css.rgroup.sep)) {
style_list$css.rgroup.sep[i] <- prAddSemicolon2StrEnd(style_list$css.rgroup.sep[i])
}
}
cspan.rgroup <- rep(cspan.rgroup, length.out = length(rgroup))
}
## this will convert color names to hexadecimal (easier for user)
## but also leaves hex format unchanged
style_list$col.rgroup <- prPrepareColors(style_list$col.rgroup, n = nrow(x), ng = n.rgroup, gtxt = rgroup)
style_list$col.columns <- prPrepareColors(style_list$col.columns, ncol(x))
if (!is.null(tspanner)) {
# Sanity checks style_list$css.tspanner and prepares the style
if (length(style_list$css.tspanner) > 1 &&
length(style_list$css.tspanner) != length(tspanner)) {
stop(sprintf(
"You must provide the same number of styles as the tspanners, %d != %d",
length(style_list$css.tspanner), length(tspanner)
))
} else if (length(style_list$css.tspanner) == 1) {
style_list$css.tspanner <- prAddSemicolon2StrEnd(style_list$css.tspanner)
if (length(tspanner) > 0) {
style_list$css.tspanner <- rep(style_list$css.tspanner, length.out = length(tspanner))
}
} else {
for (i in 1:length(style_list$css.tspanner)) {
style_list$css.tspanner[i] <- prAddSemicolon2StrEnd(style_list$css.tspanner[i])
}
}
# Sanity checks style_list$css.tspanner.sep and prepares the style
if (length(style_list$css.tspanner.sep) > 1 &&
length(style_list$css.tspanner.sep) != length(tspanner) - 1) {
stop(sprintf(
"You must provide the same number of separators as the tspanners - 1, %d != %d",
length(style_list$css.tspanner.sep), length(tspanner) - 1
))
} else if (length(style_list$css.tspanner.sep) == 1) {
style_list$css.tspanner.sep <- prGetStyle(style_list$css.tspanner.sep)
if (length(tspanner) > 0) {
style_list$css.tspanner.sep <- rep(style_list$css.tspanner.sep, length.out = length(tspanner) - 1)
}
} else {
for (i in 1:length(style_list$css.tspanner.sep)) {
style_list$css.tspanner.sep[i] <- prGetStyle(style_list$css.tspanner.sep[i])
}
}
}
# Convert dimnames to something useful
if (!is.null(names(dimnames(x)))) {
# First dimname is always the variable name for the row
dimname4row <- names(dimnames(x))[1]
if (!is.null(dimname4row) && dimname4row != "") {
# Use rgroup or tspanner as this is visually more separated than rowlabel
# if these are available
if (is.null(rgroup)) {
rgroup <- dimname4row
n.rgroup <- nrow(x)
} else if (is.null(tspanner)) {
tspanner <- dimname4row
n.tspanner <- nrow(x)
} else if (is.null(rowlabel)) {
rowlabel <- dimname4row
}
}
# Second dimname is always the variable name for the columns
dimname4col <- names(dimnames(x))[2]
if (!is.null(dimname4col) && dimname4col != "") {
# Use rgroup or tspanner as this is visually more separated than rowlabel
# if these are available
if (is.null(cgroup)) {
cgroup <- dimname4col
n.cgroup <- ncol(x)
# If this is a addmargins object we shouldn't have the cspanner including the
# sum marker
if (!is.null(total) && total &&
grepl("^sum$", tail(colnames(x), 1), ignore.case = TRUE)) {
cgroup %<>% c("")
n.cgroup <- c(n.cgroup[1] - 1, 1)
}
}
}
}
# Sanity check for tspanner
if (!is.null(tspanner)) {
if (is.null(n.tspanner)) {
stop("You need to specify the argument n.tspanner if you want to use table spanners")
}
if (any(n.tspanner < 1)) {
stop(
"You have provided invalid number of rows in the n.tspanner argument - minimum is 1, you have: ",
vector2string(n.tspanner),
" where no. ", vector2string(which(n.tspanner)),
" was less than 1"
)
}
if (length(n.tspanner) == length(tspanner) - 1) {
if (is.null(rgroup) || sum(n.tspanner) > length(rgroup)) {
n.tspanner <- append(n.tspanner, nrow(x) - sum(n.tspanner))
} else {
n.tspanner <- append(n.tspanner, length(rgroup) - sum(n.tspanner))
}
}
if (any(n.tspanner < 1)) {
stop("You have more tspannners than n.tspanner while the number of rows doesn't leave room for more tspanners")
}
if (sum(n.tspanner) != nrow(x)) {
if (is.null(rgroup)) {
stop(sprintf(
"Your rows don't match in the n.tspanner, i.e. %d != %d",
sum(n.tspanner), nrow(x)
))
}
if (sum(n.tspanner) != length(rgroup)) {
stop(sprintf(
"Your rows don't match either the total number of rows '%d'
or the number of rgroups '%d' the sum of n.tspanner %d",
nrow(x),
length(rgroup),
sum(n.tspanner)
))
}
org_nt <- n.tspanner
for (i in 1:length(n.tspanner)) {
offset <- sum(org_nt[0:(i - 1)]) + 1
n.tspanner[i] <- sum(n.rgroup[offset:(offset + org_nt[i] - 1)])
}
}
# Make sure there are no collisions with rgrou
if (!is.null(n.rgroup)) {
for (i in 1:length(n.tspanner)) {
rows <- sum(n.tspanner[1:i])
if (!rows %in% cumsum(n.rgroup)) {
stop(
"There is no splitter that matches the table spanner ",
tspanner[i],
" (no. ", i, ") with rgroup splits.",
" The missing row splitter should be on row number ", rows,
" and is not in the n.rgroup list: ", vector2string(n.rgroup),
" note, it should match the cumulative sum n.rgroup", vector2string(cumsum(n.rgroup))
)
}
}
}
}
# With multiple rows in cgroup we need to keep track of
# how many spacer cells occur between the groups
cgroup_spacer_cells <- rep(0, times = (ncol(x) - 1))
# Sanity check for cgroup
if (!is.null(cgroup)) {
ret <- prPrepareCgroup(
x = x,
cgroup = cgroup,
n.cgroup = n.cgroup,
style_list = style_list
)
cgroup <- ret$cgroup
n.cgroup <- ret$n.cgroup
cgroup_spacer_cells <- ret$cgroup_spacer_cells
style_list$align.cgroup <- ret$align.cgroup
style_list$css.cgroup <- ret$css.cgroup
}
style_list$pos.rowlabel <- prGetRowlabelPos(cgroup, style_list$pos.rowlabel, header)
tc <- getOption("table_counter", FALSE)
if (tc) {
# Count which table it currently is
if (is.numeric(tc)) {
tc <- tc + 1
} else {
tc <- 1
}
options(table_counter = tc)
}
# The id works just as well as any anchor
table_id <- getOption("table_counter", "")
if (!is.null(label)) {
table_id <- sprintf(" id='%s'", label)
} else if (is.numeric(table_id)) {
table_id <- paste0(" id='table_", table_id, "'")
} else if (table_id == FALSE) {
table_id <- ""
}
# A column counter that is used for
total_columns <- ncol(x) + !prSkipRownames(rnames)
if (!is.null(cgroup)) {
if (!is.matrix(cgroup)) {
total_columns <- total_columns + length(cgroup) - 1
} else {
total_columns <- total_columns + sum(cgroup_spacer_cells) * prGetEmptySpacerCellSize(style_list = style_list)
}
}
if (is.null(total) ||
(is.logical(total) &&
all(total == FALSE))) {
total <- c()
} else if (is.logical(total)) {
if (length(total) == 1) {
total <- nrow(x)
} else if (length(total) == nrow(x)) {
total <- which(total)
} else if (!is.null(n.tspanner) &&
length(total) == length(n.tspanner)) {
total <- cumsum(n.tspanner)[total]
} else {
stop(
"You have provided an invalid 'total' argument:",
" '", paste(total, collapse = "', '"), "'.",
" Logical values accepted are either single TRUE elements",
", of the same length as the output matrix (", nrow(x), ")",
", or of the same length as the tspanner (",
ifelse(is.null(n.tspanner), "not provided", length(n.tspanner)), ")."
)
}
} else if (is.numeric(total)) {
if (any(!total %in% 1:nrow(x))) {
stop(
"You have indicated an invalid row as the total row.",
" Valid rows are only 1 to ", nrow(x),
" and you have provided invalid row(s): ",
"'", paste(total[!total %in% 1:nrow(x)], collapse = "', '"), "'"
)
}
} else if (all(total == "tspanner")) {
total <- cumsum(n.tspanner)
} else {
stop(
"You have provided an invalid 'total' argument:",
" '", paste(total, collapse = "', '"), "' ",
" of the class ", paste(class(total), collapse = " & "), ".",
" The function currently only accepts logical or numerical",
" values."
)
}
style_list$css.total <- rep(style_list$css.total, length.out = length(total))
assert(
check_matrix(style_list$css.cell),
check_character(style_list$css.cell)
)
prepped_cell_css <- prPrepareCss(x,
css = style_list$css.cell,
rnames = rnames, header = header,
style_list = style_list
)
###############################
# Start building table string #
###############################
table_str <- str_interp(
"
",
list(
CLASS_NAME = paste(style_list$css.class, collapse = ", "),
TABLE_CSS = paste(style_list$css.table, collapse = "; "),
TABLE_ID = table_id
)
)
# Theoretically this should be added to the table but the
# import to word processors works then less well and therefore I've
# constructed this work-around with borders for the top and bottom cells
first_row <- TRUE
if (isTRUE(ctable)) {
top_row_style <- "border-top: 2px solid grey;"
bottom_row_style <- "border-bottom: 2px solid grey;"
} else if (any(ctable %in% c("single", "double"))) {
ctable <- rep_len(ctable, 2L)
ctable[ctable %in% "single"] <- "solid"
top_row_style <- ifelse(ctable[1] == "solid", "border-top: 2px solid grey;", "border-top: 4px double grey;")
bottom_row_style <- ifelse(ctable[2] == "solid",
"border-bottom: 2px solid grey;",
"border-bottom: 4px double grey;"
)
} else {
top_row_style <- "border-top: 4px double grey;"
bottom_row_style <- "border-bottom: 1px solid grey;"
}
# Add caption according to standard HTML
if (!is.null(caption)) {
# Combine a table counter if provided
caption <- paste0("\n\t", prTblNo(caption))
if (compatibility != "LibreOffice") {
if (style_list$pos.caption %in% c("bottom", "below")) {
table_str %<>% paste0("\n\t
")
if (is.null(rgroup)) {
row_clrs <- style_list$col.rgroup
} else {
row_clrs <- unlist(attr(style_list$col.rgroup, "group"))
}
rgroup_iterator <- 0
tspanner_iterator <- 0
if (nrow(x) > 0) {
for (row_nr in 1:nrow(x)) {
rname_style <- attr(prepped_cell_css, "rnames")[row_nr]
# First check if there is a table spanner that should be applied
if (!is.null(tspanner) &&
(row_nr == 1 ||
row_nr > sum(n.tspanner[1:tspanner_iterator]))) {
tspanner_iterator <- tspanner_iterator + 1
rs <- c(
rname_style,
style_list$css.tspanner[tspanner_iterator]
)
# Use a separator from the one above if this
# at least the second spanner. Graphically this
# appears as if underneath the group while it's
# actually above but this merges into one line
if (tspanner_iterator > 1) {
rs %<>%
c(style_list$css.tspanner.sep[tspanner_iterator - 1])
}
if (first_row) {
rs %<>%
c(top_row_style)
}
table_str %<>%
sprintf(
"%s\n\t
%s
",
.,
total_columns,
prGetStyle(rs),
tspanner[tspanner_iterator]
)
first_row <- FALSE
}
# Add the row group if any
# and it's:
# - first row
# - the row belongs to the next row group
rgroup_sep_style <- FALSE
if (!is.null(rgroup) &&
(row_nr == 1 ||
row_nr > sum(n.rgroup[1:rgroup_iterator]))) {
rgroup_iterator <- rgroup_iterator + 1
rs <- c(rname_style,
style_list$css.rgroup[rgroup_iterator],
`background-color` = style_list$col.rgroup[rgroup_iterator]
)
# Use a separator from the one above if this
# at least the second group. Graphically this
# appears as if underneath the group while it's
# actually above but this merges into one line
if (rgroup_iterator > 1) {
rs <- c(
rs,
style_list$css.rgroup.sep[rgroup_iterator - 1]
)
}
# Only add if there is anything in the group
if (is.na(rgroup[rgroup_iterator]) == FALSE &&
rgroup[rgroup_iterator] != "") {
if (first_row) {
rs <- c(
rs,
top_row_style
)
}
rgroup_str <- prGetRgroupLine(
x = x,
total_columns = total_columns,
rgroup = rgroup,
rgroup_iterator = rgroup_iterator,
cspan = cspan.rgroup[rgroup_iterator],
rnames = rnames,
style = rs,
cgroup_spacer_cells = cgroup_spacer_cells,
style_list = style_list,
prepped_row_css = prepped_cell_css[row_nr, ]
)
table_str %<>%
paste(rgroup_str)
first_row <- FALSE
} else if (rgroup_iterator > 1 && style_list$css.rgroup.sep[rgroup_iterator - 1] != "") {
# Add the separator if the rgroup wasn't added so that it's included in the regular cells
rgroup_sep_style <- style_list$css.rgroup.sep[rgroup_iterator - 1]
}
}
cell_style <- rs <- paste("background-color:", row_clrs[row_nr])
if (first_row) {
rs %<>%
c(top_row_style)
cell_style %<>%
c(top_row_style)
} else if (rgroup_sep_style != FALSE) {
rs %<>% c(rgroup_sep_style)
}
first_row <- FALSE
if (row_nr == nrow(x)) {
cell_style %<>%
c(bottom_row_style)
}
if (row_nr %in% total) {
cell_style %<>%
c(style_list$css.total[which(row_nr == total)])
}
if (prGetStyle(rs) == "") {
table_str %<>%
paste0("\n\t
")
} else {
table_str %<>%
sprintf(
"%s\n\t
",
.,
prGetStyle(rs)
)
}
if (!prSkipRownames(rnames)) {
pdng <- style_list$padding.tspanner
# Minor change from original function. If the group doesn't have
# a group name then there shouldn't be any indentation
if (!is.null(rgroup) &&
rgroup_iterator > 0 &&
is.na(rgroup[rgroup_iterator]) == FALSE &&
rgroup[rgroup_iterator] != "") {
pdng %<>%
paste0(style_list$padding.rgroup)
}
# The padding doesn't work well with the Word import - well nothing really works well with word...
# table_str <- sprintf("%s\n\t\t
",
.,
total_columns
)
# Add the body
table_str %<>%
paste0("\n\t", txtMergeLines(tfoot))
table_str %<>% paste0("
")
}
# Close table
table_str %<>%
paste0("\n
")
# Fix indentation issue with pandoc v1.13 - can be overridden if you want to look at a pretty `cat()`
if (!getOption("htmlTable.pretty_indentation", default = FALSE)) {
table_str %<>% gsub("\t", "", .)
}
# HTML favors UTF-8 and thus the string should be encoded as utf8
table_str <- enc2utf8(table_str)
class(table_str) <- c("htmlTable", class(table_str))
attr(table_str, "...") <- dots
attr(table_str, "html") <- TRUE
# Add html class if this is a table inside a notebook for inline output
if (!getOption("htmlTable.skip_notebook", FALSE) && prIsNotebook()) {
class(table_str) <- c("html", class(table_str))
}
return(table_str)
}
#' @importFrom methods setClass
setClass("htmlTable", contains = "character") htmlTable/R/htmlTable_helpers_attr4RgroupAdd.R 0000644 0001762 0000144 00000010451 13701421460 021075 0 ustar ligges users #' Get the add attribute element
#'
#' Gets the add element attribute if it exists. If non-existant it will
#' return NULL.
#'
#' @param rgroup_iterator The rgroup number of interest
#' @param no_cols The `ncol(x)` of the core htmlTable x argument
#' @inheritParams htmlTable
#' @keywords internal
#' @importFrom stats na.omit
prAttr4RgroupAdd <- function(rgroup, rgroup_iterator, no_cols) {
if (is.null(attr(rgroup, "add"))) {
return(NULL)
}
add_elmnt <- attr(rgroup, "add")
if (is.null(names(add_elmnt))) {
if (is.null(dim(add_elmnt)) &&
length(add_elmnt) == sum(rgroup != "")) {
if (!is.list(add_elmnt)) {
add_elmnt <- as.list(add_elmnt)
}
names(add_elmnt) <- (1:length(rgroup))[rgroup != ""]
} else if (!is.null(dim(add_elmnt)) &&
ncol(add_elmnt) %in% c(1, no_cols)) {
# Convert matrix to stricter format
tmp <- list()
for (i in 1:nrow(add_elmnt)) {
if (ncol(add_elmnt) == 1) {
tmp[[i]] <- add_elmnt[i, ]
} else {
tmp2 <- as.list(add_elmnt[i, ])
names(tmp2) <- 1:no_cols
tmp[[i]] <- tmp2
}
}
if (nrow(add_elmnt) == sum(rgroup != "")) {
names(tmp) <- (1:length(rgroup))[rgroup != ""]
} else if (!is.null(rownames(add_elmnt))) {
names(tmp) <- rownames(add_elmnt)
} else {
stop(
"You have provided a matrix as the
add attribute to rgroups without rows that either
match the number of rgroups available '", length(rgroup[rgroup != ""]), "'",
" (you provided '", nrow(add_elmnt), "' rows).",
" And you also failed to have rownames."
)
}
add_elmnt <- tmp
} else {
stop(
"The length of the rgroup 'add' attribute must either match",
" (1) the length of the rgroup",
" (2) or have names corresponding to the mapping integers"
)
}
}
if (!is.list(add_elmnt) &&
!is.vector(add_elmnt)) {
stop("The rgroup mus either be a list or a vector")
}
add_pos <- ifelse(grepl(
"^[123456789][0-9]*$",
names(add_elmnt)
),
as.integer(names(add_elmnt)),
NA
)
if (any(is.na(add_pos))) {
# Look for rgroup names that match to those not
# found through the integer match
# If found the number is assigned to the add_pos
available_rgroups <- rgroup
if (!all(is.na(add_pos))) {
available_rgroups <- available_rgroups[-na.omit(add_pos)]
}
for (missing_pos in which(is.na(add_pos))) {
row_label <- names(add_elmnt)
if (row_label %in% available_rgroups) {
available_rgroups <-
available_rgroups[available_rgroups != row_label]
pos <- which(rgroup == row_label)
if (length(pos) > 1) {
stop(
"There seem to be two identical row groups ('", row_label, "')",
" that you whish to assign a add columns to through the 'add'",
" attribute for the rgroup element."
)
} else {
add_pos[missing_pos] <- pos
}
}
}
if (any(is.na(add_pos))) {
failed_elements <- paste(names(add_elmnt)[is.na(add_pos)], collapse = "', '")
available <- paste(rgroup, collapse = "', '")
stop(
"Failed to find matchin rgroup elements for: ",
"'", failed_elements, "'",
" from availabel rgroups: ",
"'", available, "'"
)
}
names(add_elmnt) <- add_pos
}
if (!is.list(add_elmnt)) {
add_elmnt <- as.list(add_elmnt)
}
if (any(add_pos < 1)) {
stop("The rgroup 'add' attribute cannot have integer names below 1")
}
if (any(!add_pos <= length(rgroup)) || any(rgroup[add_pos] == "")) {
no_rgroups_empty <- paste(which(rgroup == ""), collapse = ", ")
prob_positions <- paste(add_pos[add_pos > length(rgroup) | add_pos %in% which(rgroup == "")], collapse = "', '")
stop(
"The rgroup 'add' attribute cannot have integer names indicating",
" positions larger than the length of the rgroup",
" (=", length(rgroup), ") or matches",
" one of the empty groups (no. ", no_rgroups_empty, ").",
" The problematic position(s):",
" '", prob_positions, "'"
)
}
# Return the matching iterator
if (rgroup_iterator %in% names(add_elmnt)) {
return(add_elmnt[[as.character(rgroup_iterator)]])
}
return(NULL)
}
htmlTable/R/tidyHtmlTable.R 0000644 0001762 0000144 00000026072 14517463044 015277 0 ustar ligges users #' Generate an htmlTable using tidy data as input
#'
#' This function maps columns from the input data, `x`, to [htmlTable()] parameters.
#' It's designed to provide a fluent interface for those familiar with the `tidyverse` ecosystem.
#'
#' @param x Tidy data used to build the `htmlTable`
#' @param value Column containing values for individual table cells. Defaults to "value" (same as [tidyr::pivot_wider]).
#' @param header Column in `x` specifying column headings
#' @param rnames Column in `x` specifying row names. Defaults to "name" (same as [tidyr::pivot_wider()]).
#' @param rgroup Column in `x` specifying row groups.
#' @param hidden_rgroup Strings indicating `rgroup` values to be hidden.
#' @param cgroup Columns in `x` specifying the column groups.
#' @param tspanner Column in `x` specifying `tspanner` groups.
#' @param hidden_tspanner Strings indicating `tspanner` values to be hidden.
#' @param skip_removal_warning Boolean to suppress warnings when removing `NA` columns.
#' @param rnames_unique Designates unique row names when regular names lack uniqueness.
#' @param table_fn Function to format the table, defaults to [htmlTable()].
#' @param ... Additional arguments passed to [htmlTable()].
#'
#' @section Column-mapping:
#'
#' Columns from `x` are mapped (transformed) to specific parameters of the [htmlTable()]
#' The following columns are converted to match the intended input structure:
#'
#' * `value`
#' * `header`
#' * `rnames`
#' * `rgroup`
#' * `cgroup`
#' * `tspanner`
#'
#' Each combination of the variables in `x` should be unique to map correctly to the output table.
#'
#' @section Row uniqueness:
#'
#' Usually each row should have a unique combination of the mappers.
#' Sometimes though rows come in a distinct order and the order identifies
#' the row more than the name. E.g. if we are identifying bone fractures using the
#' AO-classification we will have classes ranging in the form of:
#'
#' - A
#' - A1
#' - A1.1
#' - A2
#' - A2.1
#' - A2.2
#' - B
#' - ...
#'
#' we can simplify the names while retaining the key knowledge to:
#'
#' - A
#' - .1
#' - ...1
#' - .2
#' - ...1
#' - ...2
#' - B
#' - ...
#'
#' This will though result in non-unique rows and thus we need to provide the original
#' names in addition to the `rnames` argument. To do this we have `rnames_unique` as a parameter,
#' without this `tidyHtmlTable` we risk unintended merging of cells, generating > 1 value per cell.
#'
#' *Note* it is recommended that you verify with the full names just to make sure that
#' any unexpected row order change has happened in the underlying pivot functions.
#'
#' @section Sorting:
#'
#' Rows can be pre-sorted using [dplyr::arrange()] before passing to `tidyHtmlTable`.
#' Column sorting is based on `arrange(cgroup, header)`. If you want to sort in non-alphabetic
#' order you can provide a factor variable and that information will be retained.
#'
#' @section Hidden values:
#'
#' `htmlTable` Allows for some values within `rgroup`,
#' `cgroup`, etc. to be specified as `""`. The following parameters
#' allow for specific values to be treated as if they were a string of length
#' zero in the `htmlTable` function.
#'
#' * `hidden_rgroup`
#' * `hidden_tspanner`
#'
#' @section Simple tibble output:
#'
#' The tibble discourages the use of row names. There is therefore a convenience
#' option for `tidyHtmlTable` where you can use the function just as you
#' would with [htmlTable()] where `rnames` is populated with
#' the `rnames` argument provided using `tidyselect` syntax (defaults to
#' the "names" column if present int the input data).
#'
#' @section Additional dependencies:
#'
#' In order to run this function you also must have \pkg{dplyr},
#' \pkg{tidyr}, \pkg{tidyselect} and \pkg{purrr}
#' packages installed. These have been removed due to
#' the additional 20 Mb that these dependencies added (issue #47).
#' *Note:* if you use \pkg{tidyverse} it will already have
#' all of these and you do not need to worry.
#'
#'
#' @return Returns the HTML code that, when rendered, displays a formatted table.
#' @export
#' @seealso [htmlTable()]
#' @example inst/examples/tidyHtmlTable_example.R
tidyHtmlTable <- function(x,
value,
header,
rnames,
rgroup,
hidden_rgroup,
cgroup,
tspanner,
hidden_tspanner,
skip_removal_warning = getOption("htmlTable.skip_removal_warning", FALSE),
rnames_unique,
table_fn = htmlTable,
...) {
UseMethod("tidyHtmlTable")
}
#' @export
tidyHtmlTable.default <- function(x,
value,
header,
rnames,
rgroup,
hidden_rgroup,
cgroup,
tspanner,
hidden_tspanner,
skip_removal_warning = getOption("htmlTable.skip_removal_warning", FALSE),
rnames_unique,
table_fn = htmlTable,
...) {
stop("x must be of class data.frame")
}
#' @export
tidyHtmlTable.data.frame <- function(x,
value,
header,
rnames,
rgroup,
hidden_rgroup,
cgroup,
tspanner,
hidden_tspanner,
skip_removal_warning = FALSE,
rnames_unique,
table_fn = htmlTable,
...) {
# You need the suggested package for this function
safeLoadPkg("dplyr")
safeLoadPkg("tidyr")
safeLoadPkg("tidyselect")
safeLoadPkg("purrr")
safeLoadPkg("rlang")
# Re-attach style to the new object at the end
style_list <- prGetAttrWithDefault(x, which = style_attribute_name, default = NULL)
# Check if x is a grouped tbl_df
if (dplyr::is.grouped_df(x)) {
x <- dplyr::ungroup(x)
}
if (missing(value) && missing(header)) {
# Sometimes we just want to print a tibble and these don't allow for
# rownames and htmlTable becomes a little annoying why we want to
# have a tidyverse compatible option
if (missing(rnames)) {
orgName <- rlang::as_name("name")
} else {
orgName <- substitute(rnames)
}
args <- list(...)
args$x <- x %>% dplyr::select(-{{ orgName }})
args$rnames <- x[[as.character(orgName)]]
if (is.null(args$rowlabel)) {
args$rowlabel <- as.character(orgName)
}
return(do.call(htmlTable, args))
}
tidyTableDataList <- list(
value = prAssertAndRetrieveValue(x, value),
header = prAssertAndRetrieveValue(x, header),
rnames = prAssertAndRetrieveValue(x, rnames, name = "name"),
rnames_unique = prAssertAndRetrieveValue(x, rnames_unique, optional = TRUE),
rgroup = prAssertAndRetrieveValue(x, rgroup, optional = TRUE),
cgroup = prAssertAndRetrieveValue(x, cgroup, optional = TRUE, maxCols = getOption("htmlTabl.tidyHtmlTable.maxCols", default = 5)),
tspanner = prAssertAndRetrieveValue(x, tspanner, optional = TRUE)
) %>%
purrr::keep(~ !is.null(.))
checkUniqueness(tidyTableDataList)
tidyTableDataList %<>% removeRowsWithNA(skip_removal_warning = skip_removal_warning)
# Create tables from which to gather row, column, and tspanner names
# and indices
rowRefTbl <- getRowTbl(tidyTableDataList)
colRefTbl <- getColTbl(tidyTableDataList)
# Format the values for display
formatted_df <- tidyTableDataList %>%
prBindDataListIntoColumns() %>%
innerJoinByCommonCols(colRefTbl) %>%
innerJoinByCommonCols(rowRefTbl) %>%
dplyr::select(r_idx, c_idx, value) %>%
dplyr::mutate_at(dplyr::vars(value), as.character) %>%
# It is important to sort the rows as below or the data won't be properly
# displayed, i.e. there will be primarily be a mismatch between columns
dplyr::arrange(r_idx) %>%
tidyr::pivot_wider(names_from = "c_idx") %>%
dplyr::select(-r_idx)
# Hide row groups specified in hidden_rgroup
if (!missing(hidden_rgroup)) {
rowRefTbl <- rowRefTbl %>%
dplyr::mutate(rgroup = ifelse(rgroup %in% hidden_rgroup, "", rgroup))
}
# Hide tspanners specified in hidden_tspanner
if (!missing(hidden_tspanner)) {
rowRefTbl <- rowRefTbl %>%
dplyr::mutate(tspanner = ifelse(tspanner %in% hidden_tspanner, "", tspanner))
}
# Now order the columns so that cgroup and headers match
formatted_df <- formatted_df[, order(colnames(formatted_df) %>% as.numeric())]
# Get names and indices for row groups and tspanners
htmlTable_args <- list(
formatted_df, # Skip names for direct compatibility with Hmisc::latex
rnames = rowRefTbl %>% dplyr::pull(rnames),
header = colRefTbl %>% dplyr::pull(header),
...
)
if (!missing(rgroup)) {
# This will take care of a problem in which adjacent row groups
# with the same value will cause rgroup and tspanner collision
comp_val <- rowRefTbl %>% dplyr::pull(rgroup)
if (!missing(tspanner)) {
comp_val <- paste0(
comp_val,
rowRefTbl %>% dplyr::pull(tspanner)
)
}
rcnts <- prepGroupCounts(comp_val)
htmlTable_args$rgroup <- rowRefTbl %>%
dplyr::slice(rcnts$idx) %>%
dplyr::pull(rgroup)
htmlTable_args$n.rgroup <- rcnts$n
}
if (!missing(tspanner)) {
tcnt <- prepGroupCounts(rowRefTbl %>% dplyr::pull(tspanner))
htmlTable_args$tspanner <- tcnt$names
htmlTable_args$n.tspanner <- tcnt$n
}
# Get names and indices for column groups
if (!missing(cgroup)) {
cg <- list(names = list(), n = list())
noCgroup <- 1
if (is.data.frame(tidyTableDataList$cgroup)) {
noCgroup <- ncol(tidyTableDataList$cgroup)
}
for (colNo in 1:noCgroup) {
counts <- prepGroupCounts(colRefTbl %>% dplyr::pull(colNo))
cg$names[[colNo]] <- counts$names
cg$n[[colNo]] <- counts$n
}
maxLen <- sapply(cg$names, length) %>% max()
for (colNo in 1:length(cg$names)) {
missingNA <- maxLen - length(cg$names[[colNo]])
if (missingNA > 0) {
cg$names[[colNo]] <- c(cg$names[[colNo]], rep(NA, times = missingNA))
cg$n[[colNo]] <- c(cg$n[[colNo]], rep(NA, times = missingNA))
}
}
if (length(cg$names) == 1) {
htmlTable_args$cgroup <- cg$names[[1]]
htmlTable_args$n.cgroup <- cg$n[[1]]
} else {
htmlTable_args$cgroup <- do.call(rbind, cg$names)
htmlTable_args$n.cgroup <- do.call(rbind, cg$n)
}
}
if (!is.null(style_list)) {
attr(htmlTable_args[[1]], style_attribute_name) <- style_list
}
ret <- do.call(table_fn, htmlTable_args)
attr(ret, "htmlTable_args") <- htmlTable_args
return(ret)
}
`c_idx` <- "Fix no visible binding"
`r_idx` <- "Fix no visible binding" htmlTable/R/txtFrmt_round_data.frame.R 0000644 0001762 0000144 00000004573 14165130172 017464 0 ustar ligges users #' @export
#' @rdname txtRound
#' @section Tidy-select with `data.frame`:
#'
#' The `txtRound` can use `data.frame` for input. This allows us to use
#' [tidyselect](https://tidyselect.r-lib.org/articles/tidyselect.html)
#' patterns as popularized by **dplyr**.
#'
#' @examples
#'
#' # Using a data.frame directly
#' library(magrittr)
#' data("mtcars")
#' # If we want to round all the numerical values
#' mtcars %>%
#' txtRound(digits = 1)
#'
#' # If we want only want to round some columns
#' mtcars %>%
#' txtRound(wt, qsec_txt = qsec, digits = 1)
#' @importFrom methods formalArgs
txtRound.data.frame <- function(x, ..., digits = 0L){
safeLoadPkg("tidyselect")
vars <- tidyselect::eval_select(rlang::expr(c(...)), x)
vars <- vars[!(names(vars) %in% formalArgs(txtRound.default))]
if (length(vars) == 0) {
vars <- sapply(x, is.numeric)
vars <- sapply(names(vars)[vars], function(cn) which(cn == colnames(x)))
}
call <- as.list(match.call())
# Drop function & x call arguments
call[[1]] <- NULL
call[[1]] <- NULL
call <- Filter(function(argument_value) !is.language(argument_value) &&
(!is.name(argument_value) ||
!(as.character(argument_value) %in% colnames(x))),
call)
if (length(vars) > 0) {
for (i in 1:length(vars)) {
call$digits <- prPickDigits(colname = colnames(x)[vars[i]],
colindex = i,
total_cols = ncol(x),
digits = digits)
x[[names(vars)[i]]] <- do.call(txtRound,
c(list(x = x[[vars[i]]]), call))
}
}
return(x)
}
prPickDigits <- function(colname, colindex, total_cols, digits) {
if (length(digits) == 1 && is.numeric(digits)) return(digits)
if (is.null(names(digits))) {
if (total_cols == length(digits)) {
return(digits[colindex])
}
stop("Either provide digits as a single numerical or",
" a named vector/list that we can pick elements from")
}
stopifnot(all(sapply(digits, is.numeric)))
if (colname %in% names(digits)) {
return(digits[[colname]])
}
if (".default" %in% names(digits)) {
return(digits[[".default"]])
}
stop("The column '", colname, "' (pos. ", colindex, ") was not among provided digits: '",
paste(names(digits), collapse = "', '"), "' and no '.default' was found.")
} htmlTable/R/txtFrmt_round.R 0000644 0001762 0000144 00000016651 14165130172 015402 0 ustar ligges users #' A convenient rounding function
#'
#' Regular round often looses trailing 0:s as these are truncated, this function
#' converts everything to strings with all 0:s intact so that tables have the
#' correct representation, e.g. `txtRound(1.01, digits = 1)` turns into `1.0`.
#'
#' @param x The value/vector/data.frame/matrix to be rounded
#' @param digits The number of digits to round each element to. For `matrix`
#' or `data.frame` input you can provide a `vector`/`list`. An unnamed `vector`/`list`
#' must equal the length of the columns to round. If you provide a named vector you
#' can provide specify per column the number of digits, and then use `.default`
#' for those columns that we don't need to have separate values for.
#' @param digits.nonzero The number of digits to keep if the result is close to
#' zero. Sometimes we have an entire table with large numbers only to have a
#' few but interesting observation that are really interesting
#' @param txt.NA The string to exchange `NA` with
#' @param dec The decimal marker. If the text is in non-English decimal
#' and string formatted you need to change this to the appropriate decimal
#' indicator. The option for this is `htmlTable.decimal_marker`.
#' @param scientific If the value should be in scientific format.
#' @param txtInt_args A list of arguments to pass to [txtInt()] if that is to be
#' used for large values that may require a thousands separator. The option
#' for this is `htmlTable.round_int`. If `TRUE` it will activate the `txtInt`
#' functionality.
#' @param ... Passed to next method
#' @return `matrix/data.frame`
#'
#' @examples
#' # Basic usage
#' txtRound(1.023, digits = 1)
#' # > "1.0"
#'
#' txtRound(pi, digits = 2)
#' # > "3.14"
#'
#' txtRound(12344, digits = 1, txtInt_args = TRUE)
#' # > "12,344.0"
#'
#' @export
#' @rdname txtRound
#' @importFrom stringr str_split str_replace
#' @family text formatters
txtRound <- function(x, ...){
UseMethod("txtRound")
}
#' @export
#' @rdname txtRound
txtRound.default = function(x,
digits = 0,
digits.nonzero = NA,
txt.NA = "",
dec = getOption("htmlTable.decimal_marker", default = "."),
scientific = NULL,
txtInt_args = getOption("htmlTable.round_int",
default = NULL),
...){
if (length(digits) != 1 & length(digits) != length(x))
stop("You have ",
length(digits),
" digits specifications but a vector of length ",
length(x),
": ",
paste(x, collapse = ", "))
if (isTRUE(txtInt_args)) {
txtInt_args = getOption("htmlTable.round_int", default = list())
}
if (length(x) > 1) {
return(mapply(txtRound.default,
x = x,
digits = digits,
digits.nonzero = digits.nonzero,
txt.NA = txt.NA,
dec = dec,
txtInt_args = rep(list(txtInt_args), times = length(x)),
...))
}
if (!is.na(digits.nonzero)) {
if (!is.numeric(digits.nonzero)
|| floor(digits.nonzero) != digits.nonzero
) {
stop("The digits.nonzero should be an integer, you provided: ", digits.nonzero)
}
if (digits.nonzero < digits) {
stop("The digits.nonzero must be larger than digits, as it is used for allowing more 0 when encountering small numbers.",
" For instance, if we have 10.123 we rarely need more than 10.1 in form of digits while a for a small number",
" such as 0.00123 we may want to report 0.001 (i.e. digits = 1, digits.nonzero = 3)")
}
}
dec_str <- sprintf("^[^0-9\\%s-]*([\\-]{0,1}(([0-9]*|[0-9]+[ 0-9]+)[\\%s]|)[0-9]+(e[+]{0,1}[0-9]+|))(|[^0-9]+.*)$",
dec, dec)
if (is.na(x))
return(txt.NA)
if (!is.numeric(x) &&
!grepl(dec_str, x))
return(x)
if (is.character(x) && grepl(dec_str, x)) {
if (dec != ".")
x <- gsub(dec, ".", x)
if (grepl("[0-9.]+e[+]{0,1}[0-9]+", x) && is.null(scientific)) {
scientific <- TRUE
}
# Select the first occurring number
# remove any spaces indicating thousands
# and convert to numeric
x <-
sub(dec_str, "\\1", x) %>%
gsub(" ", "", .) %>%
as.numeric
}
if (!is.na(digits.nonzero)) {
decimal_position <- floor(log10(abs(x)))
if (decimal_position < -digits && decimal_position >= -digits.nonzero) {
digits <- -decimal_position
}
}
if (round(x, digits) == 0)
x <- 0
if (!is.null(scientific) && scientific) {
x <- round(x, digits)
return(format(x, scientific = TRUE))
}
ret <- sprintf(paste0("%.", digits, "f"), x)
if (is.null(txtInt_args)) {
return(ret)
}
stopifnot(is.list(txtInt_args))
separator <- str_replace(ret, "^[0-9]*([.,])[0-9]*$", "\\1")
# There is no decimal
if (separator == ret) {
int_section <- as.numeric(ret)
txtInt_args$x <- int_section
return(do.call(txtInt, txtInt_args))
}
ret_sections <- str_split(ret, paste0("[", separator, "]"))[[1]]
if (length(ret_sections) == 1) {
return(ret)
}
if (length(ret_sections) != 2) {
return(ret)
}
int_section <- as.numeric(ret_sections[1])
txtInt_args$x <- int_section
int_section <- do.call(txtInt, txtInt_args)
return(paste0(int_section, separator, ret_sections[2]))
}
#' @rdname txtRound
#' @export
txtRound.table <- function(x, ...){
if (is.na(ncol(x))) {
dim(x) <- c(1, nrow(x))
}
return(txtRound.matrix(x, ...))
}
#' @rdname txtRound
#' @param excl.cols Columns to exclude from the rounding procedure when provided a matrix.
#' This can be either a number or regular expression. Skipped if `x` is a vector.
#' @param excl.rows Rows to exclude from the rounding procedure when provided a matrix.
#' This can be either a number or regular expression.
#' @export
#' @examples
#'
#' # Using matrix
#' mx <- matrix(c(1, 1.11, 1.25,
#' 2.50, 2.55, 2.45,
#' 3.2313, 3, pi),
#' ncol = 3, byrow=TRUE)
#' txtRound(mx, digits = 1)
#' #> [,1] [,2] [,3]
#' #> [1,] "1.0" "1.1" "1.2"
#' #> [2,] "2.5" "2.5" "2.5"
#' #> [3,] "3.2" "3.0" "3.1"
txtRound.matrix <- function(x, digits = 0, excl.cols = NULL, excl.rows = NULL, ...){
if (length(dim(x)) > 2)
stop("The function only accepts vectors/matrices/data.frames as primary argument")
rows <- 1L:nrow(x)
if (!is.null(excl.rows)) {
if (is.character(excl.rows)) {
excl.rows <- grep(excl.rows, rownames(x))
}
if (length(excl.rows) > 0)
rows <- rows[-excl.rows]
}
cols <- 1L:(ifelse(is.na(ncol(x)), 1, ncol(x)))
if (!is.null(excl.cols)) {
if (is.character(excl.cols)) {
excl.cols <- grep(excl.cols, colnames(x))
}
if (length(excl.cols) > 0)
cols <- cols[-excl.cols]
}
if (length(cols) == 0)
stop("No columns to round")
if (length(rows) == 0)
stop("No rows to round")
ret_x <- x
for (i in 1:length(cols)) {
col <- cols[i]
col_digits <- prPickDigits(colname = colnames(x)[col],
colindex = i,
total_cols = length(cols),
digits = digits)
ret_x[rows, col] <- mapply(txtRound,
x = x[rows, col],
digits = col_digits,
...,
USE.NAMES = FALSE)
}
return(ret_x)
}
htmlTable/R/tidyHtmlTable_helpers_simplify_arg_list.R 0000644 0001762 0000144 00000000277 13701421460 022606 0 ustar ligges users # Converts arguments from ... into a list and removes those that have been set
# to NULL
simplify_arg_list <- function(...) {
x <- list(...)
idx <- sapply(x, is.null)
return(x[!idx])
}
htmlTable/R/htmlTable_render_prAddEmptySpacerCell.R 0000644 0001762 0000144 00000004223 13730316012 022051 0 ustar ligges users #' Add an empty cell
#'
#'
#' Depending on the `spacer.celltype` set in [addHtmlTableStyle()] we
#' will use different spacer cells.
#'
#' @param cell_style The style of the current cell that should be applied to all cells
#' @param align_style The style from [prGetAlign()]
#' @param cell_tag What HTML tag to use
#' @param colspan The number of rows each tag should span
#'
#' @return `string`
#' @keywords internal
#' @inheritParams htmlTable
#' @family hidden helper functions for htmlTable
#' @importFrom stringr str_interp str_replace
prAddEmptySpacerCell <- function(x,
style_list,
cell_style,
align_style,
cell_tag = c("td", "th"),
colspan = 1) {
str_to_append <- switch(style_list$spacer.celltype,
single_empty = "<${TAG} style='${CELL_STYLE}' colspan=${COLSPAN}>${CONTENT}",
skip = "",
double_cell = paste("<${TAG} style='${CELL_STYLE}${CELL_STYLE_BORDER}' colspan=${COLSPAN}>${CONTENT}",
"<${TAG} style='${CELL_STYLE}' colspan=${COLSPAN}>${CONTENT}"))
if (is.null(str_to_append)) {
stop("The cell style has not been implemented")
}
border_style = ""
if (attr(align_style, "has_border")) {
border_style = paste("border-right:", attr(align_style, "border_style")$default)
}
variables <- list(TAG = match.arg(cell_tag),
CELL_STYLE = prGetStyle(style_list$spacer.css,
cell_style),
COLSPAN = colspan,
CONTENT = style_list$spacer.content,
CELL_STYLE_BORDER = border_style)
str_to_append %<>% str_interp(variables)
paste0(x, str_to_append)
}
prGetEmptySpacerCellSize <- function(style_list) {
no <- switch(style_list$spacer.celltype,
single_empty = 1,
skip = 0,
double_cell = 2)
if (is.null(no)) {
stop("The cell style has not been implemented")
}
return(no)
} htmlTable/R/concatHtmlTables.R 0000644 0001762 0000144 00000002042 14165130172 015737 0 ustar ligges users #' Function for concatenating [htmlTable()]s
#'
#' @param tables A list of [htmlTable()]s to be concatenated
#' @param headers Either a string or a vector of strings that function as
#' a header for each table. If none is provided it will use the names of
#' the table list or a numeric number.
#' @return [htmlTable()] class object
#' @example inst/examples/concatHtmlTables_example.R
#' @export
concatHtmlTables <- function(tables, headers = NULL) {
assert_list(tables)
if (is.null(headers)) {
if (!is.null(names(tables))) {
headers = sprintf("
%s
", names(tables))
} else {
headers = sprintf("
Table no. %d
", 1:length(tables))
}
} else {
headers = rep(headers, length.out = length(tables))
}
ret = paste(headers[1], tables[[1]])
for (i in 2:length(tables)) {
ret = paste0(
ret,
headers[i],
tables[[i]]
)
}
# Copy all the attributes from the first table
attributes(ret) <- attributes(tables[[1]])
class(ret) <- c('htmlTable', class(tables[[1]]))
return(ret)
}
htmlTable/R/htmlTable_render_print.R 0000644 0001762 0000144 00000005377 13701421460 017213 0 ustar ligges users #' @rdname htmlTable
#' @param useViewer If you are using RStudio there is a viewer thar can render
#' the table within that is envoced if in [base::interactive()] mode.
#' Set this to `FALSE` if you want to remove that functionality. You can
#' also force the function to call a specific viewer by setting this to a
#' viewer function, e.g. `useViewer = utils::browseURL` if you want to
#' override the default RStudio viewer. Another option that does the same is to
#' set the `options(viewer=utils::browseURL)` and it will default to that
#' particular viewer (this is how RStudio decides on a viewer).
#' *Note:* If you want to force all output to go through the
#' [base::cat()] the set `[options][base::options](htmlTable.cat = TRUE)`.
#' @export
#' @importFrom utils browseURL
print.htmlTable <- function(x, useViewer, ...) {
args <- attr(x, "...")
# Use the latest ... from the print call
# and override the original htmlTable call ...
# if there is a conflict
print_args <- list(...)
for (n in names(print_args)) {
args[[n]] <- print_args[[n]]
}
# Since the print may be called from another print function
# it may be handy to allow functions to use attributes for the
# useViewer parameter
if (missing(useViewer)) {
if ("useViewer" %in% names(args) &&
(is.logical(args$useViewer) ||
is.function(args$useViewer))) {
useViewer <- args$useViewer
args$useViewer <- NULL
} else {
useViewer <- TRUE
}
}
if (interactive() &&
!getOption("htmlTable.cat", FALSE) &&
(is.function(useViewer) ||
useViewer != FALSE)) {
if (is.null(args$file)) {
args$file <- tempfile(fileext = ".html")
}
htmlPage <- paste("",
"",
"",
"",
"",
"
",
enc2utf8(x),
"
",
"",
"",
sep = "\n"
)
# We only want to use those arguments that are actually in cat
# anything else that may have inadvertadly slipped in should
# be ignored or it will be added to the output
cat_args <- args
cat_args <- cat_args[names(cat_args) %in% names(formals(cat))[-1]]
do.call(cat, c(htmlPage, cat_args))
if (is.function(useViewer)) {
useViewer(args$file)
} else {
viewer <- getOption("viewer")
if (!is.null(viewer) &&
is.function(viewer)) {
# (code to write some content to the file)
viewer(args$file)
} else {
utils::browseURL(args$file)
}
}
} else {
cat_args <- args
cat_args <- cat_args[names(cat_args) %in% names(formals(cat))[-1]]
do.call(cat, c(x, cat_args))
}
invisible(x)
}
htmlTable/R/tidyHtmlTable_helpers_safeLoadPkg.R 0000644 0001762 0000144 00000000374 13701421460 021244 0 ustar ligges users # You need the suggested package for this function
safeLoadPkg <- function(pkg) {
if (!requireNamespace(pkg, quietly = TRUE)) {
stop("The package ", pkg, " is needed for this function to work. Please install it.",
call. = FALSE
)
}
}
htmlTable/R/tidyHtmlTable_helpers_innerJoinByCommonCols.r 0000644 0001762 0000144 00000000416 13701421460 023341 0 ustar ligges users #' A simple function for joining two tables by their
#' intersected columns
#'
#' @param x `data.frame`
#' @param y `data.frame`
#' @return `data.frame`
innerJoinByCommonCols <- function(x, y) {
by <- intersect(names(x), names(y))
dplyr::inner_join(x, y, by = by)
}
htmlTable/R/htmlTable_helpers_convertDfFactors.R 0000644 0001762 0000144 00000001014 13701421460 021476 0 ustar ligges users #' Convert all factors to characters to print them as they expected
#'
#' @inheritParams htmlTable
#' @return The data frame with factors as characters
prConvertDfFactors <- function(x) {
if (!"data.frame" %in% class(x)) {
return(x)
}
i <- sapply(x, function(col) {
(
(
!is.numeric(col) &&
!is.character(col)
) ||
(
inherits(col, "times") # For handlin Chron input
)
)
})
if (any(i)) {
x[i] <- lapply(x[i], as.character)
}
return(x)
}
htmlTable/R/htmlTable_render_getCgroupHeader.R 0000644 0001762 0000144 00000012131 13730316012 021107 0 ustar ligges users #' Retrieve a header row
#'
#' This function retrieves a header row, i.e. a row
#' within the `
` elements on top of the table. Used by
#' [htmlTable()].
#'
#' @param cgroup_vec The `cgroup` may be a `matrix`, this is
#' just one row of that `matrix`
#' @param n.cgroup_vec The same as above but for the counter
#' @param cgroup_vec.just The same as above bot for the justification
#' @param row_no The row number within the header group. Useful for multi-row
#' headers when we need to output the `rowlabel` at the `pos.rowlabel`
#' level.
#' @param style_list The list with all the styles
#' @param top_row_style The top row has a special style depending on
#' the `ctable` option in the `htmlTable` call.
#' @param cgroup_spacer_cells The spacer cells due to the multiple cgroup levels.
#' With multiple rows in cgroup we need to keep track of how many spacer cells
#' occur between the columns. This variable contains is of the size `ncol(x)-1`
#' and 0 if there is no cgroup element between.
#' @return `string`
#' @keywords internal
#' @inheritParams htmlTable
#' @family hidden helper functions for htmlTable
#' @importFrom stringr str_interp
prGetCgroupHeader <- function(x,
cgroup_vec,
n.cgroup_vec,
cgroup_vec.just,
row_no, top_row_style,
rnames,
rowlabel = NULL,
cgroup_spacer_cells,
style_list,
prepped_cell_css,
css_4_cgroup_vec) {
header_str <- "\n\t
"
if (row_no == 1) {
ts <- top_row_style
} else {
ts <- ""
}
if (!is.null(rowlabel)) {
if (row_no == style_list$pos.rowlabel) {
header_str %<>% sprintf(
"%s\n\t\t
",
header_values),
sep = "\n\t\t")
# If not last then add a filler cell between the row categories
# this is also the reason that we need the cgroup_spacer_cells
if (i != sum(!is.na(cgroup_vec))) {
bottom_border_style = str_interp("border-bottom: ${STYLE};",
list(STYLE = style_list$spacer.css.cgroup.bottom.border))
header_str %<>% prAddEmptySpacerCell(style_list = style_list,
cell_style = prGetStyle(bottom_border_style,
ts),
align_style = header_align,
cell_tag = "th")
}
}
}
header_str %<>%
paste0("\n\t
")
return(header_str)
}
htmlTable/R/tidyHtmlTable_helpers_checkUniqueness.r 0000644 0001762 0000144 00000001505 14165130172 022260 0 ustar ligges users # This checks to make sure that the mapping columns of the tidy dataset
# uniquely specify a given value
checkUniqueness <- function(tidyTableDataList) {
tidyTableData <- do.call(cbind, tidyTableDataList)
dupes <- tidyTableData %>% duplicated()
if (sum(dupes) != 0) {
core_msg <- paste0("The input parameters ",
paste(paste0("\"", names(tidyTableData), "\""), collapse = ", "),
" do not specify unique rows, have you forgotten one?.")
duplicated_rows <- paste0("The following rows are duplicated: ", paste(which(dupes), collapse = ", "))
if (is.null(tidyTableDataList$rnames_unique)) {
core_msg <- paste(core_msg,
"Check if you intended to provide the rnames_unique (see the help page).")
}
stop(core_msg, "\n", duplicated_rows)
}
}
htmlTable/R/tidyHtmlTable_helpers_getColTbl.R 0000644 0001762 0000144 00000000511 13701421460 020734 0 ustar ligges users getColTbl <- function(x) {
out <- prExtractElementsAndConvertToTbl(x, elements = c("cgroup", "header")) %>%
dplyr::arrange_all() %>%
# This is necessary in order to not generate NA values when setting
# hidden elements to ""
dplyr::mutate_if(is.factor, as.character)
out$c_idx <- 1:nrow(out)
return(out)
}
htmlTable/R/htmlTable_helpers_addSemicolon2StrEnd.R 0000644 0001762 0000144 00000002215 13701421460 022031 0 ustar ligges users #' Add a ; at the end
#'
#' The CSS expects a semicolon at the end of each argument
#' this function just adds a semicolong if none is given
#' and remove multiple semicolon if such exist
#'
#' @param my_str The string that is to be processed
#' @return `string`
#' @keywords internal
#' @family hidden helper functions for htmlTable
#' @importFrom utils tail
prAddSemicolon2StrEnd <- function(my_str) {
if (!is.null(names(my_str))) {
tmp <- str_trim(my_str)
names(tmp) <- names(my_str)
my_str <- tmp
} else {
my_str <- str_trim(my_str)
}
my_str_n <- sapply(my_str, nchar, USE.NAMES = FALSE)
if (any(my_str_n == 0)) {
my_str <- my_str[my_str_n > 0]
}
if (length(my_str) == 0) {
return("")
}
if (tail(strsplit(my_str, "")[[1]], 1) != ";") {
n <- names(my_str)
my_str <- sprintf("%s;", my_str)
if (!is.null(n)) {
names(my_str) <- n
}
}
# Remove duplicated ;
my_str <- gsub(";;+", ";", my_str)
empty_str <- sapply(my_str, function(x) x == ";", USE.NAMES = FALSE)
if (any(empty_str)) {
my_str <- my_str[!empty_str]
}
if (length(my_str) == 0) {
return("")
}
return(my_str)
}
htmlTable/R/htmlTableWidget.R 0000644 0001762 0000144 00000004576 13701421460 015604 0 ustar ligges users #' htmlTable with pagination widget
#'
#' This widget renders a table with pagination into an htmlwidget
#'
#' @param x A data frame to be rendered
#' @param number_of_entries a numeric vector with the number of entries per page to show.
#' If there is more than one number given, the user will be able to show the number
#' of rows per page in the table.
#' @param ... Additional parameters passed to htmlTable
#' @inheritParams htmlwidgets::createWidget
#' @import htmlwidgets
#' @return an htmlwidget showing the paginated table
#' @export
htmlTableWidget <- function(x, number_of_entries = c(10, 25, 100),
width = NULL, height = NULL, elementId = NULL,
...) {
rendered_table <- htmlTable(x, ...)
# forward options and variables using the input list:
input <- list(
thetable = rendered_table,
options = list(number_of_entries = number_of_entries)
)
# create widget
htmlwidgets::createWidget(
name = "htmlTableWidget",
x = input,
width = width,
height = height,
package = "htmlTable",
elementId = elementId
)
}
#' Shiny bindings for htmlTableWidget
#'
#' Output and render functions for using htmlTableWidget within Shiny
#' applications and interactive Rmd documents.
#'
#' @param outputId output variable to read from
#' @param width,height Must be a valid CSS unit (like `'100%'`, `'400px'`, `'auto'`) or a number,
#' which will be coerced to a string and have `'px'` appended.
#' @param expr An expression that generates a [htmlTableWidget()]
#' @param env The environment in which to evaluate `expr`.
#' @param quoted Is `expr` a quoted expression (with `quote()`)? This
#' is useful if you want to save an expression in a variable.
#'
#' @name htmlTableWidget-shiny
#'
#' @examples
#' \dontrun{
#' # In the UI:
#' htmlTableWidgetOutput("mywidget")
#' # In the server:
#' renderHtmlTableWidget({
#' htmlTableWidget(iris)
#' })
#' }
#' @export
htmlTableWidgetOutput <- function(outputId, width = "100%", height = "400px") {
htmlwidgets::shinyWidgetOutput(outputId, "htmlTableWidget", width, height, package = "htmlTable")
}
#' @rdname htmlTableWidget-shiny
#' @export
renderHtmlTableWidget <- function(expr, env = parent.frame(), quoted = FALSE) {
if (!quoted) {
expr <- substitute(expr)
} # force quoted
htmlwidgets::shinyRenderWidget(expr, htmlTableWidgetOutput, env, quoted = TRUE)
}
htmlTable/R/htmlTable_helpers_isNotebook.R 0000644 0001762 0000144 00000001773 13701421460 020352 0 ustar ligges users #' Detects if the call is made from within an RStudio Rmd file or a file
#' with the html_notebook output set.
#' @importFrom rstudioapi isAvailable getActiveDocumentContext
#' @keywords internal
prIsNotebook <- function() {
if (!isAvailable()) {
return(FALSE)
}
ctxt <- getActiveDocumentContext()
if (grepl("\\.Rmd$", ctxt$path)) {
return(prCheck4output2console(ctxt))
}
# Look for html_notebook within the header if the file hasn't been saved
contents <- ctxt$contents
header <- grep("^---$", contents)
if (length(header) == 2) {
return(any(grepl(
"html_notebook$",
contents[min(header):max(header)]
)))
}
return(FALSE)
}
prCheck4output2console <- function(ctxt) {
contents <- ctxt$contents
header_boundary <- grep("^---$", contents)
if (length(header_boundary) <= 1) {
# Play it safe if the header is invalid
return(TRUE)
}
header <- contents[header_boundary[1]:header_boundary[2]]
return(!any(grepl("chunk_output_type: console", header)))
} htmlTable/R/htmlTable_helpers_prepInputMatrixDimensions.R 0000644 0001762 0000144 00000001561 13730316012 023433 0 ustar ligges users #' Makes sure the input is correct
#'
#' Checks and converts dimensions into something the
#' [htmlTable()] is comfortable with.
#'
#' @inheritParams htmlTable
#' @keywords internal
#' @family hidden helper functions for htmlTable
prPrepInputMatrixDimensions <- function(x, header = NULL) {
if (!is.null(dim(x))) {
if (length(dim(x)) != 2) {
stop(
"Your table variable seems to have the wrong dimension,",
" length(dim(x)) = ", length(dim(x)), " != 2"
)
}
return(x)
}
preset_styles <- getHtmlTableStyle(x)
if (!is.numeric(x) && !is.character(x)) {
x <- as.character(x)
}
ncol <- length(x)
if (!is.null(header)) {
ncol <- length(header)
}
ret <- matrix(x, ncol = ncol)
# We need to make sures that the style info has been retained throughout
attr(ret, style_attribute_name) <- preset_styles
return(ret)
}
htmlTable/R/htmlTable_style_assertions.R 0000644 0001762 0000144 00000002272 13701421460 020121 0 ustar ligges users prAssertStyleNames <- function(x, message) {
if (any(x == "")) {
stop(message, " Empty names not allowed.")
}
invalid_names <- prGetInvalidStyleNames(x)
if (length(invalid_names) > 0) {
stop(message, " See name(s): ", paste(invalid_names, collapse = ", "))
}
}
prGetInvalidStyleNames <- function(x) {
valid_names <- Filter(
function(x) !(x %in% c("theme", "")),
names(formals(setHtmlTableTheme))
)
checked_names <- args %in% valid_names
return(args[!checked_names])
}
prAssertStyles <- function(style_list) {
assert_list(style_list, names = "named", .var.name = deparse(substitute(style_list)))
css_styles <- names(style_list)[startsWith(names(style_list), "css.")]
for (style in css_styles) {
prAssertStyle(style_list[[style]], name = style)
}
return(TRUE)
}
prAssertStyle <- function(elmnt, name) {
assert_character(elmnt,
min.chars = 0,
min.len = 1,
.var.name = name
)
elmnts2check <- Filter(
function(x) nchar(x) > 0,
elmnt
)
if (name != "css.class" && is.null(names(elmnts2check)) && length(elmnts2check) > 0) {
assert_true(all(sapply(elmnts2check, function(e) grepl(":", e))),
.var.name = name
)
}
}
htmlTable/R/htmlTable_helpers_skipRownames.R 0000644 0001762 0000144 00000000506 13730316012 020707 0 ustar ligges users #' Returns if rownames should be printed for the htmlTable
#'
#' @inheritParams htmlTable
#' @keywords internal
prSkipRownames <- function(rnames) {
if (missing(rnames) || is.null(rnames) || length(rnames) == 0) {
return(TRUE)
}
if (length(rnames) == 1 && rnames == FALSE) {
return(TRUE)
}
return(FALSE)
}
htmlTable/R/tblNo.R 0000644 0001762 0000144 00000003574 13701421460 013577 0 ustar ligges users #' Gets the last table number
#'
#' The function relies on `options("table_counter")`
#' in order to keep track of the last number.
#'
#' @param roman Whether or not to use roman numbers instead
#' of arabic. Can also be set through `options(table_caption_no_roman = TRUE)`
#'
#' @export
#' @examples
#' org_opts <- options(table_counter=1)
#' tblNoLast()
#' options(org_opts)
#' @family table functions
#' @importFrom utils as.roman
tblNoLast <- function(roman = getOption("table_counter_roman",
FALSE)){
last_no <- getOption("table_counter")
if (is.logical(last_no) ||
is.null(last_no)){
stop("You cannot call the get last figure number",
" when there has been no prior figure registerd.",
" In other words, you need to call the fiCapNo()",
" on a figure before you call this function.",
" If you want the next number then call figCapNoNext()",
" instead of this function.")
}
if (roman)
last_no <- as.character(as.roman(last_no))
return(last_no)
}
#' Gets the next table number
#'
#' The function relies on `options("table_counter")`
#' in order to keep track of the last number.
#'
#' @inheritParams tblNoLast
#' @export
#' @examples
#' org_opts <- options(table_counter=1)
#' tblNoNext()
#' options(org_opts)
#' @family table functions
#' @importFrom utils as.roman
tblNoNext <- function(roman = getOption("table_counter_roman",
FALSE)){
last_no <- getOption("table_counter")
if (is.logical(last_no)){
if (last_no == FALSE)
stop("You cannot call the get last figure number",
" when you have explicitly set the fig_cap_no",
" option to false.")
last_no <- 0
}else if (is.null(last_no)){
last_no <- 0
}
next_no <- last_no + 1
if (roman)
next_no <- as.character(as.roman(next_no))
return(next_no)
}
htmlTable/R/htmlTable_helpers_prepareColors.R 0000644 0001762 0000144 00000003054 13701421460 021050 0 ustar ligges users #' Prepares the alternating colors
#'
#' @param clr The colors
#' @param n The number of rows/columns applicable to the color
#' @param ng The n.rgroup/n.cgroup argument if applicable
#' @param gtxt The rgroup/cgroup texts
#' @return `character` A vector containing hexadecimal colors
#' @import magrittr
#' @keywords internal
#' @importFrom grDevices col2rgb
prPrepareColors <- function(clr, n = NULL, ng = NULL, gtxt) {
clr <- sapply(clr, function(a_clr) {
if (a_clr == "none") {
return(a_clr)
}
if (grepl("^#[0-9ABCDEFabcdef]{3,3}$", a_clr)) {
a_clr %<>%
substring(first = 2) %>%
strsplit(split = "") %>%
unlist() %>%
sapply(FUN = rep, times = 2) %>%
paste(collapse = "") %>%
tolower() %>%
paste0("#", .)
} else {
a_clr %<>%
col2rgb %>%
as.hexmode() %>%
as.character() %>%
paste(collapse = "") %>%
paste0("#", .)
}
}, USE.NAMES = FALSE)
if (!is.null(ng)) {
# Split groups into separate if the gtxt is ""
if (any(gtxt == "")) {
tmp <- c()
for (i in 1:length(ng)) {
if (gtxt[i] != "" &&
!is.na(gtxt[i])) {
tmp <- c(
tmp,
ng[i]
)
} else {
tmp <- c(
tmp,
rep(1, ng[i])
)
}
}
ng <- tmp
}
clr <- rep(clr, length.out = length(ng))
attr(clr, "groups") <-
Map(rep, clr, length.out = ng)
} else if (!is.null(n)) {
clr <- rep(clr, length.out = n)
}
return(clr)
}
htmlTable/R/tidyHtmlTable_helpers_getRowTbl.r 0000644 0001762 0000144 00000000750 14165130172 021035 0 ustar ligges users getRowTbl <- function(x) {
out <- prExtractElementsAndConvertToTbl(x,
elements = c("tspanner", "rgroup", "rnames", "rnames_unique")
) %>%
dplyr::arrange() %>%
# This is necessary in order to not generate NA values when setting
# hidden elements to "" and this can't be in prExtractElementsAndConvertToTbl
# as we need to be able to sort according to the column in getColTbl
dplyr::mutate_if(is.factor, as.character)
out$r_idx <- 1:nrow(out)
return(out)
}
htmlTable/R/htmlTable_helpers_getRowlabelPos.R 0000644 0001762 0000144 00000002367 13701421460 021167 0 ustar ligges users
#' Gets the rowlabel position
#'
#' @inheritParams htmlTable
#' @return `integer` Returns the position within the header rows
#' to print the `rowlabel` argument
#' @keywords internal
#' @family hidden helper functions for htmlTable
prGetRowlabelPos <- function(cgroup = NULL, pos.rowlabel, header = NULL) {
no_cgroup_rows <-
ifelse(!is.null(cgroup),
nrow(cgroup),
0
)
no_header_rows <-
no_cgroup_rows +
(!is.null(header)) * 1
if (is.numeric(pos.rowlabel)) {
if (pos.rowlabel < 1) {
stop("You have specified a pos.rowlabel that is less than 1: ", pos.rowlabel)
} else if (pos.rowlabel > no_header_rows) {
stop(
"You have specified a pos.rowlabel that more than the max limit, ",
no_header_rows,
", you have provided: ", pos.rowlabel
)
}
} else {
pos.rowlabel <- tolower(pos.rowlabel)
if (pos.rowlabel %in% c("top")) {
pos.rowlabel <- 1
} else if (pos.rowlabel %in% c("bottom", "header")) {
pos.rowlabel <- no_header_rows
} else {
stop(
"You have provided an invalid pos.rowlabel text,",
" only 'top', 'bottom' or 'header' are allowed,",
" can't interpret '", pos.rowlabel, "'"
)
}
}
return(pos.rowlabel)
}
htmlTable/R/htmlTable_helpers_prepareCss.R 0000644 0001762 0000144 00000007076 13701421460 020347 0 ustar ligges users #' Prepares the cell style
#'
#' @param css The CSS styles that are to be converted into
#' a matrix.
#' @param name The name of the CSS style that is prepared
#' @inheritParams htmlTable
#' @return `matrix`
#' @keywords internal
prPrepareCss <- function(x, css, rnames, header = NULL, name = deparse(substitute(css)), style_list = NULL) {
if (is.null(style_list)) {
css.header <- rep("", times = ncol(x))
css.rnames <- rep("", times = nrow(x) + !is.null(header))
} else {
css.header <- rep(ifelse(is.null(style_list$css.header),
"",
style_list$css.header),
times = ncol(x))
css.rnames <- rep(ifelse(is.null(style_list$css.rnames),
"",
style_list$css.rnames),
times = nrow(x) + !missing(header))
}
if (is.matrix(css)) {
if (any(grepl("^[^:]*[a-zA-Z]+[:]*:", css))) {
rownames(css) <- NULL
colnames(css) <- NULL
}
if (ncol(css) == ncol(x) + 1 &&
!prSkipRownames(rnames)) {
if (!is.null(header)) {
if (nrow(css) == nrow(x) + 1) {
css.rnames <- css[, 1]
} else if (nrow(css) == nrow(x)) {
css.rnames[2:length(css.rnames)] <- css[, 1]
} else {
stop(
"There is an invalid number of rows for the ", name, " matrix.",
" Your x argument has '", nrow(x), "' rows",
" while your ", name, " has '", nrow(css), "' rows",
" and there is a header"
)
}
} else if (nrow(x) == nrow(css)) {
css.rnames <- css[, 1]
} else {
stop(
"There is an invalid number of rows for the ", name, " matrix.",
" Your x argument has '", nrow(x), "' rows",
" while your ", name, " has '", nrow(css), "' rows",
" (there is no header)"
)
}
css <- css[, -1, drop = FALSE]
} else if (ncol(css) != ncol(x)) {
stop(
"There is an invalid number of columns for the ", name, " matrix.",
" Your x argument has '", ncol(x), "' columns",
" while your ", name, " has '", ncol(css), "' columns",
" and there are ", ifelse(prSkipRownames(rnames),
"no", ""
),
" rownames."
)
}
if (nrow(css) == nrow(x) + 1 && !is.null(header)) {
for (i in 1:length(css.header)) {
css.header[i] <- prGetStyle(css.header[i], css[1, i])
}
css <- css[-1, , drop = FALSE]
} else if (nrow(css) != nrow(x)) {
stop(
"There is an invalid number of rows for the ", name, " matrix.",
" Your x argument has '", nrow(x), "' rows",
" while your ", name, " has '", nrow(css), "' rows",
" and there is ", ifelse(is.null(header), "no", "a"),
" header"
)
}
} else if (is.vector(css)) {
if (length(css) == ncol(x) + 1) {
css.rnames <- rep(css[1], nrow(x) + prSkipRownames(rnames))
css <-
css[-1]
} else if (length(css) == 1) {
css.rnames <- rep(css, times = nrow(x) + !is.null(header))
} else if (length(css) != ncol(x)) {
stop(
"The length of your ", name, " vector '", length(css), "'",
" does not correspond to the column length '", ncol(x), "'",
" (there are ", ifelse(prSkipRownames(rnames),
"no", ""
),
" rownames)"
)
}
css <- matrix(css,
nrow = nrow(x),
ncol = ncol(x),
byrow = TRUE
)
}
return(structure(css,
rnames = css.rnames,
header = css.header,
class = class(css)
))
}
htmlTable/R/txtFrmt.R 0000644 0001762 0000144 00000014002 14165130172 014157 0 ustar ligges users #' A merges lines while preserving the line break for HTML/LaTeX
#'
#' This function helps you to do a table header with multiple lines
#' in both HTML and in LaTeX. In HTML this isn't that tricky, you just use
#' the ` ` command but in LaTeX I often find
#' myself writing `vbox`/`hbox` stuff and therefore
#' I've created this simple helper function
#'
#' @param ... The lines that you want to be joined
#' @param html If HTML compatible output should be used. If `FALSE`
#' it outputs LaTeX formatting. Note if you set this to 5
#' then the HTML5 version of *br* will be used: ` `
#' otherwise it uses the ` ` that is compatible
#' with the XHTML-formatting.
#' @return `string` with `asis_output` wrapping if html output is activated
#'
#' @examples
#' txtMergeLines("hello", "world")
#' txtMergeLines("hello", "world", html=FALSE)
#' txtMergeLines("hello", "world", list("A list", "is OK"))
#'
#' @family text formatters
#' @export
#' @importFrom knitr asis_output
txtMergeLines <- function(..., html = 5){
strings <- c()
for (i in list(...)) {
if (is.list(i)) {
for (c in i)
strings <- append(strings, i)
} else{
strings <- append(strings, i)
}
}
if (length(strings) == 0) {
return("")
} else if (length(strings) == 1) {
# Split multi-line strings
strings <- strsplit(strings, "\n[ ]*")[[1]]
}
if (length(strings) == 1) {
if (html) {
return(asis_output(strings))
}
return(strings)
}
ret <- ifelse(html != FALSE, "", "\\vbox{")
first <- TRUE
for (line in strings) {
line <- as.character(line)
if (first)
ret <- paste0(ret, ifelse(html != FALSE, line, sprintf("\\hbox{\\strut %s}", line)))
else
ret <- paste0(ret, ifelse(html != FALSE,
paste(ifelse(html == 5, " \n", " \n"),
line),
sprintf("\\hbox{\\strut %s}", line)))
first <- FALSE
}
if (html) {
return(asis_output(ret))
}
paste0(ret, "}")
}
#' SI or English formatting of an integer
#'
#' English uses ',' between every 3 numbers while the
#' SI format recommends a ' ' if x > 10^4. The scientific
#' form 10e+? is furthermore avoided.
#'
#' @param x The integer variable
#' @param language The ISO-639-1 two-letter code for the language of
#' interest. Currently only English is distinguished from the ISO
#' format using a ',' as the separator.
#' @param html If the format is used in HTML context
#' then the space should be a non-breaking space, ` `
#' @param ... Passed to [base::format()]
#' @return `string`
#'
#' @examples
#' txtInt(123)
#'
#' # Supplying a matrix
#' txtInt(matrix(c(1234, 12345, 123456, 1234567), ncol = 2))
#'
#' # Missing are returned as empty strings, i.e. ""
#' txtInt(c(NA, 1e7))
#'
#' @family text formatters
#' @export
txtInt <- function(x,
language = getOption("htmlTable.language", default = "en"),
html = getOption("htmlTable.html", default = TRUE),
...){
if (length(x) > 1) {
ret <- sapply(x, txtInt, language = language, html = TRUE, ...)
if (is.matrix(x)) {
ret <- matrix(ret, nrow = nrow(x))
rownames(ret) <- rownames(x)
colnames(ret) <- colnames(x)
}
return(ret)
}
if (is.na(x)) return('')
if (abs(x - round(x)) > .Machine$double.eps^0.5 &&
!"nsmall" %in% names(list(...)))
warning("The function can only be served integers, '", x, "' is not an integer.",
" There will be issues with decimals being lost if you don't add the nsmall parameter.")
if (language == "en")
return(format(x, big.mark = ",", scientific = FALSE, ...))
if (x >= 10^4)
return(format(x,
big.mark = ifelse(html, " ", " "),
scientific = FALSE, ...))
return(format(x, scientific = FALSE, ...))
}
#' Formats the p-values
#'
#' Gets formatted p-values. For instance
#' you often want `0.1234` to be `0.12` while also
#' having two values up until a limit,
#' i.e. `0.01234` should be `0.012` while
#' `0.001234` should be `0.001`. Furthermore you
#' want to have `< 0.001` as it becomes ridiculous
#' to report anything below that value.
#'
#' @param pvalues The p-values
#' @param lim.2dec The limit for showing two decimals. E.g.
#' the p-value may be `0.056` and we may want to keep the two decimals in order
#' to emphasize the proximity to the all-mighty `0.05` p-value and set this to
#' \eqn{10^-2}. This allows that a value of `0.0056` is rounded to `0.006` and this
#' makes intuitive sense as the `0.0056` level as this is well below
#' the `0.05` value and thus not as interesting to know the exact proximity to
#' `0.05`. *Disclaimer:* The `0.05`-limit is really silly and debated, unfortunately
#' it remains a standard and this package tries to adapt to the current standards in order
#' to limit publication associated issues.
#' @param lim.sig The significance limit for the less than sign, i.e. the '`<`'
#' @param html If the less than sign should be `<` or `<` as needed for HTML output.
#' @param ... Currently only used for generating warnings of deprecated call parameters.
#' @return vector
#'
#' @examples
#' txtPval(c(0.10234,0.010234, 0.0010234, 0.000010234))
#' @family text formatters
#' @rdname txtPval
#' @export
txtPval <- function(pvalues,
lim.2dec = 10^-2,
lim.sig = 10^-4,
html=TRUE, ...){
if (is.logical(html))
html <- ifelse(html, "< ", "< ")
sapply(pvalues, function(x, lim.2dec, lim.sig, lt_sign) {
if (is.na(as.numeric(x))) {
warning("The value: '", x, "' is non-numeric and txtPval",
" can't therefore handle it")
return(x)
}
if (x < lim.sig)
return(sprintf("%s%s", lt_sign, format(lim.sig, scientific = FALSE)))
if (x > lim.2dec)
return(format(x,
digits = 2,
nsmall = -floor(log10(x)) + 1))
return(format(x, digits = 1, scientific = FALSE))
}, lim.sig = lim.sig,
lim.2dec = lim.2dec,
lt_sign = html)
}
htmlTable/R/htmlTable_helpers_mergeClr.R 0000644 0001762 0000144 00000002012 13701421460 017761 0 ustar ligges users #' Merges multiple colors
#'
#' Uses the [`colorRampPalette()`][grDevices::colorRamp] for merging colors.
#' *Note:* When merging more than 2 colors the order in the color
#' presentation matters. Each color is merged with its neigbors before
#' merging with next. If there is an uneven number of colors the middle
#' color is mixed with both left and right side.
#'
#' @param clrs The colors
#' @return `character` A hexadecimal color
#' @import magrittr
#' @keywords internal
#' @importFrom grDevices colorRampPalette
#' @importFrom utils head
prMergeClr <- function(clrs) {
if (length(clrs) == 1) {
return(clrs)
}
if (length(clrs) == 2) {
return(colorRampPalette(clrs)(3)[2])
}
split_lngth <- floor(length(clrs) / 2)
left <- head(clrs, split_lngth)
right <- tail(clrs, split_lngth)
if (length(clrs) %% 2 == 1) {
left %<>%
c(clrs[split_lngth + 1])
right %<>%
c(clrs[split_lngth + 1], .)
}
left <- prMergeClr(left)
right <- prMergeClr(right)
return(prMergeClr(c(left, right)))
}
htmlTable/R/tidyHtmlTable_helpers_bindDataListIntoColumns.r 0000644 0001762 0000144 00000000707 13701421460 023661 0 ustar ligges users #' Merge columns into a tibble
#'
#' Almost the same as [tibble::tibble()] but it solves the issue
#' with some of the arguments being columns and some just being vectors.
#'
#' @param dataList `list` with the columns/data.frames
#' @return `data.frame` object
prBindDataListIntoColumns <- function(dataList) {
stopifnot(is.list(dataList))
dataList %>%
purrr::keep(~ !is.null(.)) %>%
do.call(dplyr::bind_cols, .) %>%
tibble::as_tibble()
}
htmlTable/R/htmlTable_style_handlers.R 0000644 0001762 0000144 00000031572 13730316012 017532 0 ustar ligges users #' Add/set css and other style options
#'
#' This function is a preprocessing step before applying the [htmlTable()] function.
#' You use this to style your tables with HTML cascading style sheet features.
#'
#' The function stores the current theme (see [setHtmlTableTheme()]) + custom styles
#' to the provided object as an [base::attributes()]. It is stored under the element
#' `htmlTable.style` in the form of a list object.
#'
#' @section The `css.cell` argument:
#'
#' The `css.cell` parameter allows you to add any possible CSS style
#' to your table cells. `css.cell` can be either a vector or a matrix.
#'
#' If `css.cell` is a *vector*, it's assumed that the styles should be repeated
#' throughout the rows (that is, each element in css.cell specifies the style
#' for a whole column of 'x').
#'
#' In the case of `css.cell` being a *matrix* of the same size of the `x` argument,
#' each element of `x` gets the style from the corresponding element in css.cell. Additionally,
#' the number of rows of `css.cell` can be `nrow(x) + 1` so the first row of of `css.cell`
#' specifies the style for the header of `x`; also the number of columns of `css.cell`
#' can be `ncol(x) + 1` to include the specification of style for row names of `x`.
#'
#' Note that the `text-align` CSS field in the `css.cell` argument will be overriden
#' by the `align` argument.
#'
#' Excel has a specific css-style, `mso-number-format` that can be used for improving the
#' copy-paste functionality. E.g. the style could be written as: `css_matrix <-
#' matrix( data = "mso-number-format:\"\\@\"", nrow = nrow(df), ncol = ncol(df))`
#'
#' @param x The object that you later want to pass into [htmlTable()].
#' @param align A character strings specifying column alignments, defaulting to `'c'`
#' to center. Valid chars for alignments are l = left, c = center and r = right. You can also specify
#' `align='c|c'` and other LaTeX tabular formatting. If you want to set the alignment of the
#' rownames this string needst to be `ncol(x) + 1`, otherwise it automatically
#' pads the string with a left alignment for the rownames.
#' @param align.header A character strings specifying alignment for column header,
#' defaulting to centered, i.e. `[paste][base::paste](rep('c',ncol(x)),collapse='')`.
#' @param align.cgroup The justification of the `cgroups`
#' @param css.rgroup CSS style for the rgroup, if different styles are wanted for each of the
#' rgroups you can just specify a vector with the number of elements.
#' @param css.rgroup.sep The line between different rgroups. The line is set to the TR element
#' of the lower rgroup, i.e. you have to set the border-top/padding-top etc to a line with
#' the expected function. This is only used for rgroups that are printed. You can specify
#' different separators if you give a vector of rgroup - 1 length (this is since the first
#' rgroup doesn't have a separator).
#' @param css.tspanner The CSS style for the table spanner.
#' @param css.tspanner.sep The line between different spanners.
#' @param css.total The css of the total row if such is activated.
#' @param css.cell The css.cell element allows you to add any possible CSS style to your
#' table cells. See section below for details.
#' @param css.header The header style, not including the cgroup style
#' @param css.header.border_bottom The header bottom-border style, e.g. `border-bottom: 1px solid grey`
#' @param css.cgroup The same as `css.class` but for cgroup formatting.
#' @param css.class The html CSS class for the table. This allows directing html
#' formatting through [CSS](https://www.w3schools.com/Css/)
#' directly at all instances of that class. *Note:* unfortunately the
#' CSS is frequently ignored by word processors. This option
#' is mostly inteded for web-presentations.
#' @param css.table You can specify the the style of the table-element using this parameter
#' @param pos.rowlabel Where the rowlabel should be positioned. This value can be `"top"`,
#' `"bottom"`, `"header"`, or a integer between `1` and `nrow(cgroup) + 1`. The options
#' `"bottom"` and `"header"` are the same, where the row label is presented at the same level as
#' the header.
#' @param pos.caption Set to `"bottom"` to position a caption below the table
#' instead of the default of `"top"`.
#' @param col.rgroup Alternating colors (zebra striping/banded rows) for each `rgroup`; one or two colors
#' is recommended and will be recycled.
#' @param col.columns Alternating colors for each column.
#' @param padding.rgroup Generally two non-breakings spaces, i.e. ` `, but some
#' journals only have a bold face for the rgroup and leaves the subelements unindented.
#' @param padding.tspanner The table spanner is usually without padding but you may specify padding
#' similar to `padding.rgroup` and it will be added to all elements, including the rgroup elements.
#' This allows for a 3-level hierarchy if needed.
#' @param spacer.celltype When using cgroup the table headers are separated through a empty
#' HTML cell that is by default filled with ` ` (no-breaking-space) that prevents the cell
#' from collapsing. The purpose of this is to prevent the headers underline to bleed into one
#' as the underline is for the entire cell. You can alter this behavior by changing this option,
#' valid options are `single_empty`, `skip`, `double_cell`. The `single_empty` is the default,
#' the `skip` lets the header bleed into one and skips entirely, `double_cell` is for having
#' two cells so that a vertical border ends up centered (specified using the `align` option).
#' The arguments are matched internally using [base::match.arg] so you can specify only a part
#' of the name, e.g. `"sk"` will match `"skip"`.
#' @param spacer.css.cgroup.bottom.border Defaults to `none` and used for separating cgroup headers.
#' Due to a browser bug this is sometimes ignored and you may therefore need to set this
#' to `1px solid white` to enforce a white border.
#' @param spacer.css If you want the spacer cells to share settings you can set it here
#' @param spacer.content Defaults to ` ` as this guarantees that the cell is not collapsed
#' and is highly compatible when copy-pasting to word processors.
#'
#' @return `x` with the style added as an attribute that the htmlTable then can use for formatting.
#' @export
#'
#' @examples
#' library(magrittr)
#' matrix(1:4, ncol = 2) %>%
#' addHtmlTableStyle(align = "c", css.cell = "background-color: orange;") %>%
#' htmlTable(caption = "A simple style example")
#' @rdname addStyles
#' @family htmlTableStyle
addHtmlTableStyle <- function(x,
align = NULL,
align.header = NULL,
align.cgroup = NULL,
# CSS stuff
css.rgroup = NULL,
css.rgroup.sep = NULL,
css.tspanner = NULL,
css.tspanner.sep = NULL,
css.total = NULL,
css.cell = NULL,
css.cgroup = NULL,
css.header = NULL,
css.header.border_bottom = NULL,
css.class = NULL,
css.table = NULL,
# Positions
pos.rowlabel = NULL,
pos.caption = NULL,
# Colors
col.rgroup = NULL,
col.columns = NULL,
# More alternatives
padding.rgroup = NULL,
padding.tspanner = NULL,
spacer.celltype = NULL,
spacer.css.cgroup.bottom.border = NULL,
spacer.css = NULL,
spacer.content = NULL) {
style_list <- prGetAttrWithDefault(x,
which = style_attribute_name,
default = getHtmlTableTheme()
)
style_list <- prValidateAndMergeStyles(
org_style_list = style_list,
styles_from_arguments = prGetArgumentList(match.call(), skip_elements = c("x")),
overwrite = TRUE
)
attr(x, style_attribute_name) <- style_list
return(x)
}
#' @rdname addStyles
appendHtmlTableStyle <- function(x,
align = NULL,
align.header = NULL,
align.cgroup = NULL,
# CSS stuff
css.rgroup = NULL,
css.rgroup.sep = NULL,
css.tspanner = NULL,
css.tspanner.sep = NULL,
css.total = NULL,
css.cell = NULL,
css.cgroup = NULL,
css.header = NULL,
css.header.border_bottom = NULL,
css.class = NULL,
css.table = NULL,
# Positions
pos.rowlabel = NULL,
pos.caption = NULL,
# Colors
col.rgroup = NULL,
col.columns = NULL,
# More alternatives
padding.rgroup = NULL,
padding.tspanner = NULL,
spacer.celltype = NULL,
spacer.css.cgroup.bottom.border = NULL,
spacer.css = NULL,
spacer.content = NULL) {
style_list <- prGetAttrWithDefault(x,
which = style_attribute_name,
default = getHtmlTableTheme()
)
style_list <- prValidateAndMergeStyles(
org_style_list = style_list,
styles_from_arguments = prGetArgumentList(match.call(), skip_elements = c("x")),
overwrite = FALSE
)
attr(x, style_attribute_name) <- style_list
return(x)
}
#' Get style options for object
#'
#' A wrap around the [base::attr()] that retrieves the style
#' attribute used by [htmlTable()] (`htmlTable.style`).
#'
#' @param x The object intended for [htmlTable()].
#' @return A `list` if the attribute exists, otherwise `NULL`
#' @export
#' @examples
#' library(magrittr)
#'
#' mx <- matrix(1:4, ncol = 2)
#' colnames(mx) <- LETTERS[1:2]
#' mx %>%
#' addHtmlTableStyle(align = "l|r") %>%
#' getHtmlTableStyle()
getHtmlTableStyle <- function(x) {
attr(x, style_attribute_name, exact = TRUE)
}
#' Check if object has a style set to it
#'
#' If the attribute `htmlTable.style` is set it will check if
#' the `style_name` exists and return a `logical`.
#'
#' @param x The object intended for [htmlTable()].
#' @param style_name A string that contains the style name.
#' @return `logical` `TRUE` if the attribute and style is not `NULL`
#' @export
#' @family htmlTableStyle
#' @examples
#' library(magrittr)
#'
#' mx <- matrix(1:4, ncol = 2)
#' colnames(mx) <- LETTERS[1:2]
#' mx %>%
#' addHtmlTableStyle(align = "l|r") %>%
#' hasHtmlTableStyle("align")
hasHtmlTableStyle <- function(x, style_name) {
style <- getHtmlTableStyle(x)
if (is.null(style)) {
return(FALSE)
}
if (is.null(style[[style_name]])) {
return(FALSE)
}
return(TRUE)
}
style_attribute_name <- "htmlTable.style"
#' @importFrom stringr str_replace
prValidateAndMergeStyles <- function(org_style_list, styles_from_arguments, overwrite) {
assert_list(org_style_list)
assert_list(styles_from_arguments)
styles_from_arguments <- Filter(Negate(is.null), styles_from_arguments)
if (length(styles_from_arguments) == 0) {
return(org_style_list)
}
default_args <- list("pos.caption" = c("top", "bottom", "below"),
"spacer.celltype" = c("single_empty", "skip", "double_cell"))
style_list <- org_style_list
for (n in names(styles_from_arguments)) {
# We only merge css components when we're not replacing everything
if (startsWith(n, "css") && n != "css.class" && !overwrite) {
# The second argument takes precedence as the final style when conflicts arise
style_list[[n]] <- prGetStyle(style_list[[n]], styles_from_arguments[[n]])
} else if (n %in% names(default_args)) {
tryCatch({
style_list[[n]] <- match.arg(arg = styles_from_arguments[[n]], choices = default_args[[n]])
}, error = function(x) {
x %>%
extract2("message") %>%
str_replace("^'arg'", sprintf("'%s'", argument_name = n)) %>%
stop()
})
} else {
style_list[[n]] <- styles_from_arguments[[n]]
}
}
return(style_list)
}
prGetAttrWithDefault <- function(x, which, default = NA) {
if (which %in% names(attributes(x))) {
return(attr(x, which))
}
return(default)
}
htmlTable/R/data-SCB.R 0000644 0001762 0000144 00000000705 14517434555 014047 0 ustar ligges users #' Average age in Sweden
#'
#' For the vignettes there is a dataset downloaded by using the
#' `get_pxweb_data()` call. The data is from
#' SCB ([Statistics Sweden](https://www.scb.se//)) and downloaded
#' using the [pxweb package](https://github.com/rOpenGov/pxweb):
#'
#' @example inst/examples/data-SCB_example.R
#'
#' @name SCB
#' @docType data
#' @author Max Gordon \email{max@@gforge.se}
#' @references
#' @keywords data
NULL htmlTable/R/prepGroupCounts.R 0000644 0001762 0000144 00000001152 13701421460 015666 0 ustar ligges users #' Retrieves counts for rgroup, cgroup, & tspanner arguments
#'
#' This function is a wrapper to [base::rle()] that
#' does exactly this but is a little too picky about input values.
#'
#' @param x The vector to process
#' @return `list(n = rle$lengths, names = rle$values)`
#' @export
#' @examples
#' prepGroupCounts(c(1:3, 3:1))
prepGroupCounts <- function(x) {
# Drop all classes but the base class as rle
counts <- rle(as.vector(x))
ret <- list(
n = counts$lengths,
idx = cumsum(counts$lengths),
names = counts$values
)
structure(ret,
class = c("htmlTable_group_count", class(ret))
)
}
htmlTable/R/tidyHtmlTable_helpers_prAssertAndRetrieveValue.R 0000644 0001762 0000144 00000001564 13701421460 024017 0 ustar ligges users prAssertAndRetrieveValue <- function(x,
value,
name = deparse(substitute(value)),
maxCols = 1,
optional = FALSE) {
if (missing(value)) {
if (is.null(x[[name]])) {
if (optional) {
return(NULL)
}
stop(
"You have not provided an argument",
" and the data frame does not have a '", name, "' column"
)
}
return(x[[name]])
}
# We are one-caller removed from the original call so we need to
# do this nasty hack to get the parameter of the parent function
orgName <- eval(substitute(substitute(value)), envir = parent.frame())
value <- dplyr::select(x, {{orgName}})
stopifnot(ncol(value) <= maxCols)
if (maxCols > 1) {
return(value)
}
return(value[[1]])
}
htmlTable/R/htmlTable_render_knit_print.R 0000644 0001762 0000144 00000000237 13701421460 020226 0 ustar ligges users #' @rdname htmlTable
#' @importFrom knitr knit_print
#' @importFrom knitr asis_output
#' @export
knit_print.htmlTable <- function(x, ...) {
asis_output(x)
}
htmlTable/R/htmlTable_theme.R 0000644 0001762 0000144 00000021603 13730316012 015606 0 ustar ligges users #' Set or update theme for [htmlTable()]
#'
#' The theme guides many of the non-data objects visual appearance. The
#' theme can be over-ridden by settings for each table. Too get a more complete
#' understanding of the options, see [addHtmlTableStyle()].
#'
#' @section Theme options:
#'
#' The styles available are:
#'
#' * `standard`: The traditional standard style used in [htmlTable()] since the early days
#' * `Google docs`: A style that is optimized for copy-pasting into documents on Google drive. This
#' is geared towards minimal padding and margins so that the table is as dense as possible.
#' * `blank`: Just as the name suggests the style is completly empty in terms of CSS. Positions
#' for rowlabel and caption are set to `bottom` as these cannot be blank.
#'
#' You can also provide your own style. Each style should be a names vector, e.g. `c(width = "100px", color = "red")`
#' or just a real css string, `width: 100px; color: red;`.
#'
#' @param theme A `list` containing all the styles or a `string` that is matched to some of the preset style (See details
#' below in the *Theme options* section). *Note*: the full name of the theme is not required as they are matched
#' using [base::match.arg()].
#' @inheritParams addHtmlTableStyle
#'
#' @return An invisible `list` with the new theme
#' @export
#' @md
#'
#' @examples
#' \dontrun{
#' setHtmlTableTheme("Google", align = "r")
#' }
setHtmlTableTheme <- function(theme = NULL,
align = NULL,
align.header = NULL,
align.cgroup = NULL,
# CSS stuff
css.rgroup = NULL,
css.rgroup.sep = NULL,
css.tspanner = NULL,
css.tspanner.sep = NULL,
css.total = NULL,
css.cell = NULL,
css.cgroup = NULL,
css.header = NULL,
css.header.border_bottom = NULL,
css.class = NULL,
css.table = NULL,
# Positions
pos.rowlabel = NULL,
pos.caption = NULL,
# Colors
col.rgroup = NULL,
col.columns = NULL,
# More alternatives
padding.rgroup = NULL,
padding.tspanner = NULL,
spacer.celltype = NULL,
spacer.css.cgroup.bottom.border = NULL,
spacer.css = NULL,
spacer.content = NULL) {
if (!is.null(theme)) {
if (is.character(theme)) {
newTheme <- prGetThemeListObject(theme_name = theme)
} else if (is.list(theme)) {
if (any(names(theme) == "")) {
stop("Theme contains unnamed elements")
}
prAssertStyleNames(names(theme), "You have invalid theme names.")
newTheme <- theme
} else {
stop("The theme must either be a list or a valid predefined theme name")
}
} else {
newTheme <- getHtmlTableTheme()
}
newTheme <- prValidateAndMergeStyles(
org_style_list = newTheme,
styles_from_arguments = prGetArgumentList(match.call(), c("", "theme")),
overwrite = TRUE
)
prAssertStyles(newTheme)
options(htmlTable.theme = newTheme)
return(invisible(newTheme))
}
prGetArgumentList <- function(args, skip_elements) {
if (!is.list(args)) {
args <- as.list(args)
}
args <- args[Filter(function(x) !(x %in% skip_elements | x == ""), names(args))]
Map(function(arg) {
if (is.language(arg)) {
value <- tryCatch(eval(arg),
error = function(e) {
for (i in 1:sys.nframe()) {
value <- tryCatch(eval(arg, envir = parent.frame(n = i)),
error = function(x) NULL)
if (!is.null(value)) return(value)
}
})
if (is.null(value)) {
stop("Could not find argument: ", as.character(arg))
}
return(value)
}
return(arg)
}, args)
}
#' Retrieve the [htmlTable()] theme list
#'
#' A wrapper for a [`getOption("htmlTable.theme")()`][base::options] call that
#' returns the standard theme unless one is set.
#'
#' @return `list` with the styles to be applied to the table
#' @export
#'
#' @examples
#' getHtmlTableTheme()
getHtmlTableTheme <- function() {
getOption("htmlTable.theme",
default = prGetThemeListObject(theme_name = "standard")
)
}
prGetThemeListObject <- function(theme_name = c("standard", "Google docs", "blank")) {
theme_name <- match.arg(theme_name)
common_non_css_elements <- list(
align = "c",
align.header = "c",
# colors
col.rgroup = "none",
col.columns = "none",
# More alternatives
padding.rgroup = " ",
padding.tspanner = "",
spacer.celltype = "single_empty",
spacer.css.cgroup.bottom.border = "none",
spacer.css = "",
spacer.content = " "
)
if (theme_name == "standard") {
# This list is the reference with all the available theme elements
standard_theme <- list(
css.rgroup = getOption("htmlTable.css.rgroup", default = "font-weight: 900;"),
css.rgroup.sep = getOption("htmlTable.css.rgroup.sep", default = ""),
css.tspanner = getOption("htmlTable.css.tspanner",
default = "font-weight: 900; text-align: left;"
),
css.tspanner.sep = getOption("htmlTable.css.tspanner.sep",
default = "border-top: 1px solid #BEBEBE;"
),
css.total = getOption("htmlTable.css.total",
default = "border-top: 1px solid #BEBEBE; font-weight: 900;"
),
css.cell = getOption("htmlTable.css.cell", default = ""),
css.cgroup = getOption("htmlTable.css.cgroup", default = ""),
css.header = getOption("htmlTable.css.header", default = "font-weight: 900"),
css.header.border_bottom = getOption("htmlTable.css.header.border_bottom", default = "border-bottom: 1px solid grey"),
css.class = getOption("htmlTable.css.class", default = "gmisc_table"),
css.table = getOption("htmlTable.css.table", default = "margin-top: 1em; margin-bottom: 1em;"),
# Positions
pos.rowlabel = "bottom",
pos.caption = "top"
)
return(prExtendlist(
base = common_non_css_elements,
extensions = standard_theme
))
}
if (theme_name == "Google docs") {
doc_theme <- list(
css.rgroup = getOption("htmlTable.css.rgroup", default = "font-weight: normal; margin: 0; padding: 0;"),
css.rgroup.sep = getOption("htmlTable.css.rgroup.sep", default = ""),
css.tspanner = getOption("htmlTable.css.tspanner",
default = "font-weight: 900; text-align: left;"
),
css.tspanner.sep = getOption("htmlTable.css.tspanner.sep",
default = "border-top: 1px solid #BEBEBE;"
),
css.total = getOption("htmlTable.css.total",
default = "border-top: 1px solid #BEBEBE; font-weight: 900;"
),
css.cell = getOption("htmlTable.css.cell", default = "margin: 0; padding: 0;"),
css.cgroup = getOption("htmlTable.css.cgroup", default = "margin: 0; padding: 0; vertical-align: middle;"),
css.header = getOption("htmlTable.css.header", default = "margin: 0; padding: 0; font-weight: 900; vertical-align: middle;"),
css.header.border_bottom = getOption("htmlTable.css.header.border_bottom", default = "border-bottom: 1px solid grey"),
css.class = getOption("htmlTable.css.class", default = "gmisc_table"),
css.table = getOption("htmlTable.css.table", default = "margin-top: 1em; margin-bottom: 1em;"),
spacer.celltype = "double_cell",
spacer.css.cgroup.bottom.border = "1px solid white",
spacer.content = "",
spacer.css = "width: 2px;",
# Positions
pos.rowlabel = "bottom",
pos.caption = "bottom"
)
return(prExtendlist(
base = common_non_css_elements,
extensions = doc_theme
))
}
if (theme_name == "blank") {
blank_theme <- list(
css.rgroup = "",
css.rgroup.sep = "",
css.tspanner = "",
css.tspanner.sep = "",
css.total = "",
css.cell = "",
css.cgroup = "",
css.header = "",
# Not blank as it is part of core table
css.header.border_bottom = "border-bottom: 1px solid grey",
css.class = "",
css.table = "",
# Positions
pos.rowlabel = "bottom",
pos.caption = "bottom"
)
return(prExtendlist(
base = common_non_css_elements,
extensions = blank_theme
))
}
}
prExtendlist <- function(base, extensions) {
for (n in names(extensions)) {
base[[n]] <- extensions[[n]]
}
return(base)
}
htmlTable/NEWS.md 0000644 0001762 0000144 00000022256 14517434555 013310 0 ustar ligges users NEWS for the htmlTable package
## Changes for 2.4.2
- Updated JQuery dependency in interactiveTable to 3.7.1
- Dropped reshape in favor of pivot_wider (issue #88)
## Changes for 2.4.1
- Updated JQuery dependency in interactiveTable (issue #85)
## Changes for 2.4.0
- The `txtRound.data.frame` converted all data to a matrix before rounding all elements. Changed
to only convert numeric variables and also added tidy-select syntax. The function now returns
the entire input `data.frame` with rounded elements as requested.
- The `txtMergeLines` now returns an `knitr::asis_output` if html mode is activated. Fixed also
multiline strings conversion into latex/html format.
- Added vignette for the text formatting functions.
## Changes for 2.3.0
- Added `rnames_unique` parameter to `tidyHtmlTable` so that rows can have non-unique names
## Changes for 2.2.1
- The `txtInt` handles `NA` more gracefully.
## Changes fro 2.2.0
- Added `htmlTable_args` attribute for making modifications to the final table easier
## Changes fro 2.1.0
- Added options for how the empty spacer cell appears (see `addHtmlTableStyle()` spacer.\* options)
- Fixed ignored `align.header`
- Fix for wrapped styles (issue #80)
## Changes for 2.0.1
- Fix for txtRound not handling negative numbers (issue #76)
- Fix bug for `hidden.rgroup` & `hidden_tspanner` in `tidyHtmlTable`
- Documentation improvements & switched to markdown docs
## Changes for 2.0.0
- Added theming and styling with `addHtmlTableStyle` and `setHtmlTableTheme` to reduce the cognitive burden of finding the right
option within the docs. Note: this may impact your current tables and hence the major version (2.0.0).
- Changed so that `css.cell` is properly applied to rownames, cell fillers and the actual cells of interest (may impact the final layout!)
- Breaking change `tidyHtmlTable`: Moved to a fully tidyverse compatible system with tidyHtmlTable. This is a breaking change to the API as we switch from
columns as strings to `tidyselect` syntax and as `gather`/`spread` have been replaced by `pivot_longer`/`pivot_wider`
the default values have been updated in accordance with their defaults, e.g. `rnames = "name"` and `value = "value"`.
- Breaking change `tidyHtmlTable`: Sorting of rows is skipped as we may have situations with repeating inputs and this can easily
be performed pre-function by calling `dplyr::arrange`. This has furthermore the desirable feature that any custom sorting
is retained.
- Added _mso-number-format_ to help (Issue #63) - thanks Rasmus Hertzum
- txtRound can now add txtInt when formatting the integer section for easier readability
- Added htmlTable css options - they should all start with `htmlTable.`
- `pos.caption` now uses match.arg as expected
- Fixed proper S3 function definition for `htmlTable` with all the arguments
- Added `htmlTable.css.border` style option for allowing to choose border style. Also fixed bug with cgroup empty cells and vertical border.
- Added `htmlTable.pretty_indentation` option for skipping the stripping of all the tabs that was required due to old Pandoc bug.
- Added `attr(x, "html") <- TRUE` by default and UTF-8 encoding on all outputted strings to mimic the `htmltools::HTML` function behavior.
- For simple tibble output the `tidyHtmlTable` can now be used to choose a column for the rnames argument
- The print statement now respects the `chunk_output_type` in Rmd files in RStudio
- `tidyHtmlTable` now accepts table function that allows switching to other table functions
- Added `css.header` style as using `css.cell` wasn't entirely intuitive (fixes issue #73)
## Changes for 1.13.3
- Prepared for R 4.0
## Changes for 1.13.1
- Bug fix for cgroup as list argument
- The `n.tspanner` now also accepts number of `rgroup`s
## Changes for 1.13
- Added the ability to have `cgroup` arguments as a list
- Fixed `n.rgoup` bug with css
- Improved the general vignette
- Added `vector2string` - a convenience function when you want to output a vector into a string
- Added `digits.nonzero` to `txtRound` function that allows more digits with values close to zero
- Force encoding for `print.htmlTable` when outputting a table using the viewer (Issue #61)
## Changes for 1.12
- Added scientific notation to `txtRound` (Issue #35)
## Changes for 1.11.4
- Fix $ MathJax bug (Issue #57)
## Changes for 1.11.3
- Fix single-row `css.cell` bug (Issue #54)
## Changes for 1.11.2
- Set `htmlEscape` to default to `FALSE` as some features depend on the ability to be able to
send html formatted strings.
## Changes for 1.11.1
- Removed tidyr and dplyr from dependencies (issue #47)
## Changes for 1.11.0
- Strings are now escaped using `htmltools::htmlEscape` - issue #40 (thanks Peter Konings)
- Tidy data interface - issue #42 (thanks Stephen Gragg)
## Changes for 1.10.1
- Fixed bug with rownames styling (thanks Shira Mitchell)
## Changes for 1.10
- Added conversion of dimnames into row/column labels
- Added detection of sum row/colum when using `base::table`
- fixed `cgroup` bug with automated `n.cgroup` calculations
- fixed output to viewport when not in RStudio notebook (thanks Peter Konings)
- fixed vector input for `txtRound` warning
## Changes for 1.9
- `txtInt` handles nsmall warning when working with non-atomic numbers (issue #23)
- fixed output for RStudio notebook (issue #26)
## Changes for 1.8
- `txtRound` now throws an error when provided a too short vector of digits (thanks Peter Konings)
- `css.cell` has improved docs and added checkmate to verify format (thanks maverickg)
- Added `concatHtmlTables` for merging multiple tables into one string element of class `htmlTable`
- Fixed CRAN bugs in dev version
## Changes for 1.7
- Added ability to print `matrix` & `data.frame` without any rows, i.e. empty (Thanks Peter Konings)
- Added table border flexibility via the `ctable` argument (Thanks raredd)
- Added option of having row-group separators for no-named row groups (Thanks, prof. Harrell)
- Fixed bug with outputting dates (issue #14)
## Changes for 1.6
- The `txtRound` now properly handles vector digits argument
- The `txtRound` is now a S3-function and handles `data.frame` objects in a cleaner way
## Changes for 1.5
- Added better description for how to use the add attribute for `rgroup`s
- Extended the add attribute for `rgroup` to accept matrices
- The `n.rgroup`/`rgroup` are automaticaly completed with the last rows if sum(`n.rgroup`) is less than the total number of rows
- Similar applies to `n.cgroup`/`cgroup`
- Fixed the line-merge so that all new lines get an ` `-tag
- Added an `interactiveTable` for allowing tables with cells that have resizeable content
- Added `css.table` for table element css styling
## Changes for 1.4
- Handles `data.frames` with factors - thanks Sergio Oller #4
## Changes for 1.3
- Prepared for API-changes with stringr 1.0
- The txtRound can now handle vectors and single values
## Changes for 1.2
- Fixed table counter update
- The `htmlTable` can now also accept vectors
- Removed the `format.df` from Hmisc as it converted & to \& with unexpected results. This functionality
has also been superseeded by the txtRound function.
## Changes for 1.1
- Added the option of having an attribute on the `rgroup` in case there is an interest
of adding more data to that particular row
- Added a fix for the pandoc tab bug
- `knit_print` implemented removing the need for results='asis' except for within for-loops
- Removed the capitalize tspanner css as this may cause confusion with limited word processor compatibility
- Added `htmlTable` tests
- `txtRound` now also rounds character matrices
- Added a detailed vignette with the primary features of `htmlTable`
- Added the option of having a total row
- The `pos.caption` can now also be "below"
- Fixed minor bug with numbering not beeing turned off with options(table_counter = FALSE)
- Zebra striping now works for `rgroup`s mixed with ""
- `txtRound` returns "" by default if value missing. This can also be specified with the
`txt.NA` option
## Changes for 1.0
- The `htmlTable` and associated txt-functions are now separated from Gmisc
- Argument name changes for `htmlTable` for better consistency and logic:
`rowname` -> `rnames`
`headings` -> `header`
`halign` -> `align.header`
`cgroup.just` -> `align.cgroup`
`rgroupCSSstyle` -> `css.rgroup`
`rgroupCSSseparator` -> `css.rgroup.sep`
`tspannerCSSstyle` -> `css.tspanner`
`tspannerCSSseparator` -> `css.tspanner.sep`
`tableCSSclass` -> `css.table.class`
`rowlabel.pos` -> `pos.rowlabel`
`caption.loc` -> `pos.caption`
`altcol` -> `col.rgroup`
- `htmlTable` can now handle `rnames = FALSE` in order to surpress rownames
- `htmlTable` now defaults to the layout of `ctable` as this is the more commonly found layout among medical papers
- `htmlTable` `rgroup` has the additional `padding.rgroup` for those that want to change the no-breaking space padding
- `htmlTable` `tfoot` is automatically run through `txtMergeLines` in order to retain wrapped text
- Renamed `splitLines4Table` to `txtMergeLines`, `outputInt` to `txtInt`, `pvalueFormatter` to `txtPval` and these follow now the argument style of `htmlTable`
- Added `txtRound` for rounding matrices. The problem with `round()` is that 1.01 rounds to 1
instead of "1.0" that is wanted for output.
- Multiple bug-fixes
htmlTable/MD5 0000644 0001762 0000144 00000023465 14517543722 012522 0 ustar ligges users 9b8733ffede6f145196e4bab0904a6cc *DESCRIPTION
33aa6a5904fd484d5a525fdc6ea0a76e *NAMESPACE
f8009817cfa964e520ab13e44a672840 *NEWS.md
0cca60556d4211fccb36ecec6e2d60e0 *R/concatHtmlTables.R
58950cade6d54ec53878d569f0236cec *R/data-SCB.R
de0e53716a5120f2bb1947d1233bffa9 *R/deprecated.R
bf6d4cdb695b643f8b7e2c936b38ed63 *R/htmlTable.R
48c561b8540d2c1f37278f72948646bc *R/htmlTableWidget.R
a12bebef3938512b14a52dffa8827157 *R/htmlTable_helpers_addSemicolon2StrEnd.R
5f02207fefc70185267488ac3b07969a *R/htmlTable_helpers_attr4RgroupAdd.R
37e77f6d1243e045494f20d26127658d *R/htmlTable_helpers_convertDfFactors.R
a8eddadf58d3bc4a4baa1bdff703dd00 *R/htmlTable_helpers_escapeHtml.R
66cb3f64e1b6a30ffea53cc78598532c *R/htmlTable_helpers_getAlign.R
66c476d63fdea6c112b00917befd8cd6 *R/htmlTable_helpers_getRowlabelPos.R
bfe60277acc46e54e8a235a0179a3408 *R/htmlTable_helpers_getStyle.R
39ec7ff2899db0b81fc0886b2b1f0164 *R/htmlTable_helpers_isNotebook.R
955725c406e04787920f3a0ec96f627b *R/htmlTable_helpers_mergeClr.R
735b0fe57dbf96260d36f8643b40d6a8 *R/htmlTable_helpers_prepInputMatrixDimensions.R
3b48339d1c3fe42e45c819549183fb0b *R/htmlTable_helpers_prepareAlign.R
878249f3136eccbc9b8f32e0f0c6c735 *R/htmlTable_helpers_prepareCgroup.R
3709324279b7828b9a4960085dd73f15 *R/htmlTable_helpers_prepareColors.R
55fe8ad030642fd56a3c5cff1885c2e5 *R/htmlTable_helpers_prepareCss.R
46d588c72ff525ed0a578fc0368d9147 *R/htmlTable_helpers_skipRownames.R
b974519a8845d007ab5d67e41d01528f *R/htmlTable_helpers_tblNo.R
d0d9f2192c135ffc4b15904fffe4504c *R/htmlTable_render_addCells.R
cdf08dea56db3953fc1d1054ce3152f4 *R/htmlTable_render_getCgroupHeader.R
3811613d76e6afe26baf64e1f66175f1 *R/htmlTable_render_getRgroupLine.R
f9a0db7b2b5b074105e653cfcc6651dc *R/htmlTable_render_getThead.R
125a13c0a483f7539c736abb1b6a1cd1 *R/htmlTable_render_knit_print.R
2f94bbeb6bd4e2a48dff81855fc60e0b *R/htmlTable_render_prAddEmptySpacerCell.R
3327895c3def1a82925d5ebe46b35265 *R/htmlTable_render_print.R
3224056c9825b3db586bc405c6b2a9b0 *R/htmlTable_style_assertions.R
c4817e3b15d3c8a125b37ed1a53db938 *R/htmlTable_style_handlers.R
f472747427fbf1a6ec9cd07055465816 *R/htmlTable_theme.R
93360d08ec4a65705d54339c711777a1 *R/interactiveTable.R
ec6bba19a763a389aa7e320d063e29b4 *R/prepGroupCounts.R
c6b79388ed70f1054802ab7ee74a99fb *R/tblNo.R
b414d232802166e707e39593f0bc02a5 *R/tidyHtmlTable.R
2542e9e8e7398983a55ee50e1d8fcb65 *R/tidyHtmlTable_helpers_bindDataListIntoColumns.r
6d42882eb3dbca0bbac4e281028322b2 *R/tidyHtmlTable_helpers_checkUniqueness.r
05503328001943ad4db644d95d5c19b9 *R/tidyHtmlTable_helpers_extractElementsAndConvertToTbl.R
5380de329b16f46815ea16862e8739a1 *R/tidyHtmlTable_helpers_getColTbl.R
b310ddcb035daa9b56f0f805dd6b0060 *R/tidyHtmlTable_helpers_getRowTbl.r
21d71bb5ca4c4f361e76f6d4abae3909 *R/tidyHtmlTable_helpers_innerJoinByCommonCols.r
5d0ef174020123e8e5f779988c763856 *R/tidyHtmlTable_helpers_prAssertAndRetrieveValue.R
021dd5fd1b89f8d71e78092f332c410d *R/tidyHtmlTable_helpers_removeRowsWithNA.r
a28b351171fd663879d45748c0b2d5a5 *R/tidyHtmlTable_helpers_safeLoadPkg.R
d2b32e4d3aa12a70cbe38b5e7a9d3207 *R/tidyHtmlTable_helpers_simplify_arg_list.R
e32dd0e30337522871def7b5d62cf155 *R/txtFrmt.R
66aed7e991496d8ad1429a7a2bbf1b20 *R/txtFrmt_round.R
59222991397a0b630b32a6bad45cc0c0 *R/txtFrmt_round_data.frame.R
448a5ec9d8f13be68edc2aac4967c244 *R/vector2string.R
50ef9e1fcbeab122eb72e3d29aabe4cb *README.md
285d3dd6e5ddf3233b7b7acc098b0ec8 *build/vignette.rds
e38a7a346e35171e1b34f7712b29dd82 *data/SCB.rda
731f269961f88758baba04ec76b3a49e *inst/doc/complex_tables.R
4be339abdb3bd0a529b53545227bc554 *inst/doc/complex_tables.Rmd
7ac42869fbc745051e9b993835e937f2 *inst/doc/complex_tables.html
bb028ce36930c690cba6ad9fe9b8ba1c *inst/doc/general.R
3a9629596d0caaa798881337b9c05aad *inst/doc/general.Rmd
fa7f3f9b7fe5279d1f0efb7ed7ae4337 *inst/doc/general.html
f4c843a1176f4bc59840501d037dcad5 *inst/doc/text_formatters.R
77683ef100bd4a9f3115ebd7f3c2bb0e *inst/doc/text_formatters.Rmd
6e5eee8d3825b0d4cb50dfd753a609ce *inst/doc/text_formatters.html
c99b4d8a518e20a89a3a18646af0b3a8 *inst/doc/tidyHtmlTable.R
08b7cd5b0a36eed44e0ea98fde751a42 *inst/doc/tidyHtmlTable.Rmd
81fe128a3acb0c38344a3b44f2bb0e49 *inst/doc/tidyHtmlTable.html
4f65ed52c60f1f85cb43740666ed3c82 *inst/examples/concatHtmlTables_example.R
8e55a3031e1e5fb4765e104befa34226 *inst/examples/data-SCB_example.R
f67d4dc8d31555e99ece94ea926de958 *inst/examples/htmlTable_example.R
3d9fbff0715d20add5ee6d8b32c1bd61 *inst/examples/interactiveTable_example.R
28dac3d055bb72bf156187fc888ba9ed *inst/examples/tidyHtmlTable_example.R
02be25da98a52b5cf49b4df8d5e0de2e *inst/html_components/button.html
132f309e3f83db888152d7106ec41bcf *inst/htmlwidgets/htmlTableWidget.js
9d64ab9c68200839f89866984786eec8 *inst/htmlwidgets/htmlTableWidget.yaml
6e908243e42ce0b91a3de48b1e453df3 *inst/htmlwidgets/lib/jquery/jquery-AUTHORS.txt
2c872dbe60f4ba70fb85356113d8b35e *inst/htmlwidgets/lib/jquery/jquery.min.js
36cb4d79c25bf7b3aefbe78327681a0f *inst/htmlwidgets/lib/table_pagination/table_pagination.css
d677798e4c1f10fb8f9f4d623564a414 *inst/htmlwidgets/lib/table_pagination/table_pagination.js
d2ca198a2b8d36ed4a82c76ce10de625 *inst/javascript/button.js
1b709ec9de931d7f62fd71c56686d268 *inst/javascript/toggler.js
cfe22f78a65ce29c735c587f2d66259e *man/SCB.Rd
cc67933382c1e01e6081793c60172189 *man/addStyles.Rd
e8f635609ce74cf17bcfc4ca2a25a001 *man/concatHtmlTables.Rd
7789f1c3890b9aa99dc74e4d7adb156c *man/getHtmlTableStyle.Rd
9a53e995d36ea30db33ab8eccb316906 *man/getHtmlTableTheme.Rd
e70a10b1194e05436748ffdccface93a *man/hasHtmlTableStyle.Rd
92d1bd002aec906fa962543e17a86030 *man/htmlTable.Rd
8ca2ec117b63d6019cc74df23c65b771 *man/htmlTableWidget-shiny.Rd
b753e6c0e431bc34e7eb5b2ac8aa6f1c *man/htmlTableWidget.Rd
bd134090e424ac5e21a8b7ff79402b78 *man/innerJoinByCommonCols.Rd
3e629563798db13ccc8c3fbad4e3e229 *man/interactiveTable.Rd
6d73e0e13b17b0dde6aa0e8ac62198ce *man/outputInt.Rd
438d459f825d6e46236f8322a762c0fd *man/prAddCells.Rd
4f77ae8175c9ed504a1169e4ccadb516 *man/prAddEmptySpacerCell.Rd
284235fd66794bb1c3483d406dafea61 *man/prAddSemicolon2StrEnd.Rd
6f5ea08de0a78491e18d45c57ac4d571 *man/prAttr4RgroupAdd.Rd
e98f14ce1d397874716731cf607660f2 *man/prBindDataListIntoColumns.Rd
1961494c0ed62e14bdbd08b4bb1b7c99 *man/prConvertDfFactors.Rd
e8ea4fdcd362aacee4a536fb8b76621a *man/prEscapeHtml.Rd
df1f5912a183604ef8561c4d054028fb *man/prExtractElementsAndConvertToTbl.Rd
d8812da209edb8a30c57d771a9468b26 *man/prGetAlign.Rd
6f1c8001382f27236e67c16b60680822 *man/prGetCgroupHeader.Rd
8c7444ffda7be2c86ec378dba2456025 *man/prGetRgroupLine.Rd
8846ae8c783ea088c1e1625cb8d38672 *man/prGetRowlabelPos.Rd
17d61f0b76ffbb46864d54a2a7560ec6 *man/prGetScriptString.Rd
40a0392019b216f1e8629adcf390ef8e *man/prGetStyle.Rd
403520fc548c223ce709c4c4b97b82da *man/prGetThead.Rd
7c72432a2db14d73ba9a2ac9ebdc3d47 *man/prIsNotebook.Rd
cb408208bcfa0b483d3d78eb7c3c9ef7 *man/prMergeClr.Rd
54e5f18b55f19b6bcb3a9d2036822b8e *man/prPrepInputMatrixDimensions.Rd
f38b228126cb8c19e8ae0e469d154d98 *man/prPrepareAlign.Rd
2610a9afa1280e3d71796229b8dfd637 *man/prPrepareCgroup.Rd
37cb9c41bae1c0e10b6037d58f323da1 *man/prPrepareColors.Rd
371e3a85ff36ebeb673ba3a04ef8009d *man/prPrepareCss.Rd
adc172aa11b4cb6c1ab3b2ba9b4202f7 *man/prSkipRownames.Rd
a228c6dbfd4b5d6c3901761df3300d6c *man/prTblNo.Rd
649378a1159eeb0e73b69f8b54b7ad53 *man/prepGroupCounts.Rd
34c598a635042e5e92f063b629773f81 *man/pvalueFormatter.Rd
076504f2a833991fcec96076f4a8802e *man/setHtmlTableTheme.Rd
bd24c775f958d90e4b60a25d47168e88 *man/splitLines4Table.Rd
4231fba8eb25c3ca2e76118821abebd7 *man/tblNoLast.Rd
8b2aeea0964bc63c8f6695506f753497 *man/tblNoNext.Rd
ddffb9e15534b719a90700dace207276 *man/tidyHtmlTable.Rd
8afad6f94acfbf713a0498cd541a29ce *man/txtInt.Rd
2252743dfe1ab7200fb3a743f28a15b8 *man/txtMergeLines.Rd
00f1b02e09950502a4e5a3090476fb4f *man/txtPval.Rd
f0d89426c6dc5d888b86641cc7f8d4ed *man/txtRound.Rd
6a4815e021f9919310030b27d726eb10 *man/vector2string.Rd
97e588c07c3f56549f7f555ce9435f5a *tests/testInteractive.R
9107723799c9b294c18abddcc5c2aa3f *tests/testthat.R
d6f9101b3c5f86a58795822db200865b *tests/testthat/htmlTable_addHtmlTableStyle.R
6ac9e1e46cdd45f6b3068925c33a04be *tests/testthat/structure.tex
bf00fb34a4369747bb8897181eb6fa96 *tests/testthat/ters-htmlTable_cell_styles_via_prPrepareCSS.R
143947f822f6d4d110d85263c162649f *tests/testthat/test-htmlTable-dimnames.R
87ce747995ab93542fb5d068a4c3d48c *tests/testthat/test-htmlTable-input_checks.R
cebb969e0c90b3f35c491a0c4b2dbacc *tests/testthat/test-htmlTable.R
b3d97a87eb9c11bc1316ce692e7eb956 *tests/testthat/test-htmlTable_cgroup.R
621deabac4bd881ce9068a0cb7dc1063 *tests/testthat/test-htmlTable_dates.R
811c90d48a828a181e9f88b0bbbcc633 *tests/testthat/test-htmlTable_escape_html.R
297550643a58a2ca2096d02b6abdf0c6 *tests/testthat/test-htmlTable_rgroup_tspanner.R
7f93f98e0e60d718e5325906585ab007 *tests/testthat/test-htmlTable_styles.R
329931dd4fa34307a266ed6eff882b5c *tests/testthat/test-htmlTable_total.R
ea26eb027ce5c586bd7d6394ce8721bf *tests/testthat/test-interactiveTable.R
27826a3da249973a733e7211227a8b60 *tests/testthat/test-theming.R
116ac7cf15d305a42266e841560aae63 *tests/testthat/test-tidyHtmlTable.R
6edffddc99c57f899f9f0a4f29538e28 *tests/testthat/test-tidyHtmlTable_Hmisc_latex.R
d982e48339a4c980f15fcd23edd76e23 *tests/testthat/test-tidyHtmlTable_sorting.R
ba97822f3dbc0eaffd25ddb05bc4c96d *tests/testthat/test-txtFrmt.R
994d6e332d8a5c81bff240129144fc81 *tests/testthat/test-txtMergeLines.R
bb1e39d05a591f95ccd2870af313b52c *tests/visual_tests/htmlTable_vtests.R
67a35c5f46a8b9f6f93e95498564649f *tests/visual_tests/pandoc_test.Rmd
280e41fe9c38ad69709bc46de9df1740 *tests/visual_tests/word_test.Rmd
49908b458668813b33221f390e018122 *tests/visual_tests/word_test.html
4be339abdb3bd0a529b53545227bc554 *vignettes/complex_tables.Rmd
c6bf870ed5887e59df7400b57148f149 *vignettes/custom.css
3a9629596d0caaa798881337b9c05aad *vignettes/general.Rmd
77683ef100bd4a9f3115ebd7f3c2bb0e *vignettes/text_formatters.Rmd
08b7cd5b0a36eed44e0ea98fde751a42 *vignettes/tidyHtmlTable.Rmd
htmlTable/inst/ 0000755 0001762 0000144 00000000000 14517464237 013160 5 ustar ligges users htmlTable/inst/examples/ 0000755 0001762 0000144 00000000000 14165130172 014761 5 ustar ligges users htmlTable/inst/examples/data-SCB_example.R 0000644 0001762 0000144 00000001722 13407215301 020133 0 ustar ligges users \dontrun{
# The data was generated through downloading via the API
library(pxweb)
# Get the last 15 years of data (the data always lags 1 year)
current_year <- as.integer(format(Sys.Date(), "%Y")) -1
SCB <- get_pxweb_data(
url = "http://api.scb.se/OV0104/v1/doris/en/ssd/BE/BE0101/BE0101B/BefolkningMedelAlder",
dims = list(Region = c('00', '01', '03', '25'),
Kon = c('1', '2'),
ContentsCode = c('BE0101G9'),
Tid = (current_year-14):current_year),
clean = TRUE)
# Some cleaning was needed before use
SCB$region <- factor(substring(as.character(SCB$region), 4))
Swe_ltrs <- c("å" = "å",
"Å" = "Å",
"ä" = "ä",
"Ä" = "Ä",
"ö" = "ö",
"Ö" = "Ö")
for (i in 1:length(Swe_ltrs)){
levels(SCB$region) <- gsub(names(Swe_ltrs)[i],
Swe_ltrs[i],
levels(SCB$region))
}
save(SCB, file = "data/SCB.rda")
}
htmlTable/inst/examples/interactiveTable_example.R 0000644 0001762 0000144 00000001440 13701421460 022101 0 ustar ligges users library(magrittr)
# A simple output
long_txt <- "Lorem ipsum dolor sit amet, consectetur adipiscing elit,
sed do eiusmod tempor incididunt ut labore et dolore magna aliqua.
Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi
ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit
in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur
sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt
mollit anim id est laborum"
short_txt <- gsub("(^[^.]+).*", "\\1", long_txt)
cbind(rep(short_txt, 2),
rep(long_txt, 2)) %>%
addHtmlTableStyle(col.rgroup = c("#FFF", "#EEF")) %>%
interactiveTable(minimized.columns = ncol(.),
header = c("Short", "Long"),
rnames = c("First", "Second"))
htmlTable/inst/examples/concatHtmlTables_example.R 0000644 0001762 0000144 00000003067 14165130172 022054 0 ustar ligges users library(magrittr)
# Basic example
tables <- list()
output <- matrix(1:4,
ncol = 2,
dimnames = list(list("Row 1", "Row 2"),
list("Column 1", "Column 2")))
tables[["Simple table"]] <- htmlTable(output)
# An advanced output
output <- matrix(ncol = 6, nrow = 8)
for (nr in 1:nrow(output)) {
for (nc in 1:ncol(output)) {
output[nr, nc] <-
paste0(nr, ":", nc)
}
}
tables[["Fancy table"]] <- output %>%
addHtmlTableStyle(align = "r",
col.columns = c(rep("none", 2),
rep("#F5FBFF", 4)),
col.rgroup = c("none", "#F7F7F7"),
css.cell = "padding-left: .5em; padding-right: .2em;") %>%
htmlTable(header = paste(c("1st", "2nd",
"3rd", "4th",
"5th", "6th"),
"hdr"),
rnames = paste(c("1st", "2nd",
"3rd",
paste0(4:8, "th")),
"row"),
rgroup = paste("Group", LETTERS[1:3]),
n.rgroup = c(2,4,nrow(output) - 6),
cgroup = rbind(c("", "Column spanners", NA),
c("", "Cgroup 1", "Cgroup 2†")),
n.cgroup = rbind(c(1,2,NA),
c(2,2,2)),
caption = "Basic table with both column spanners (groups) and row groups",
tfoot = "† A table footer commment",
cspan.rgroup = 2)
concatHtmlTables(tables)
htmlTable/inst/examples/htmlTable_example.R 0000644 0001762 0000144 00000006463 14165130172 020544 0 ustar ligges users library(magrittr)
# Basic example
output <- matrix(1:4,
ncol = 2,
dimnames = list(list("Row 1", "Row 2"),
list("Column 1", "Column 2")))
htmlTable(output)
invisible(readline(prompt = "Press [enter] to continue"))
# An advanced output
output <- matrix(ncol = 6, nrow = 8)
for (nr in 1:nrow(output)) {
for (nc in 1:ncol(output)) {
output[nr, nc] <-
paste0(nr, ":", nc)
}
}
output %>% addHtmlTableStyle(align = "r",
col.columns = c(rep("none", 2),
rep("#F5FBFF", 4)),
col.rgroup = c("none", "#F7F7F7"),
css.cell = "padding-left: .5em; padding-right: .2em;") %>%
htmlTable(header = paste(c("1st", "2nd",
"3rd", "4th",
"5th", "6th"),
"hdr"),
rnames = paste(c("1st", "2nd",
"3rd",
paste0(4:8, "th")),
"row"),
rgroup = paste("Group", LETTERS[1:3]),
n.rgroup = c(2,4,nrow(output) - 6),
cgroup = rbind(c("", "Column spanners", NA),
c("", "Cgroup 1", "Cgroup 2†")),
n.cgroup = rbind(c(1,2,NA),
c(2,2,2)),
caption = "Basic table with both column spanners (groups) and row groups",
tfoot = "† A table footer commment",
cspan.rgroup = 2)
invisible(readline(prompt = "Press [enter] to continue"))
# An advanced empty table
suppressWarnings({
matrix(ncol = 6,
nrow = 0) %>%
addHtmlTableStyle(col.columns = c(rep("none", 2),
rep("#F5FBFF", 4)),
col.rgroup = c("none", "#F7F7F7"),
css.cell = "padding-left: .5em; padding-right: .2em;") %>%
htmlTable(align = "r",
header = paste(c("1st", "2nd",
"3rd", "4th",
"5th", "6th"),
"hdr"),
cgroup = rbind(c("", "Column spanners", NA),
c("", "Cgroup 1", "Cgroup 2†")),
n.cgroup = rbind(c(1,2,NA),
c(2,2,2)),
caption = "Basic empty table with column spanners (groups) and ignored row colors",
tfoot = "† A table footer commment",
cspan.rgroup = 2)
})
invisible(readline(prompt = "Press [enter] to continue"))
# An example of how to use the css.cell for header styling
simple_output <- matrix(1:4, ncol = 2)
simple_output %>%
addHtmlTableStyle(css.cell = rbind(rep("background: lightgrey; font-size: 2em;",
times = ncol(simple_output)),
matrix("",
ncol = ncol(simple_output),
nrow = nrow(simple_output)))) %>%
htmlTable(header = LETTERS[1:2])
invisible(readline(prompt = "Press [enter] to continue"))
# See vignette("tables", package = "htmlTable")
# for more examples, also check out tidyHtmlTable() that manages
# the group arguments for you through tidy-select syntax
htmlTable/inst/examples/tidyHtmlTable_example.R 0000644 0001762 0000144 00000002557 14165130172 021376 0 ustar ligges users library(tibble)
library(dplyr)
library(tidyr)
# Prep and select basic data
data("mtcars")
base_data <- mtcars %>%
rownames_to_column() %>%
mutate(gear = paste(gear, "Gears"),
cyl = paste(cyl, "Cylinders")) %>%
select(rowname, cyl, gear, wt, mpg, qsec)
base_data %>%
pivot_longer(names_to = "per_metric",
cols = c(wt, mpg, qsec)) %>%
group_by(cyl, gear, per_metric) %>%
summarise(value_Mean = round(mean(value), 1),
value_Min = round(min(value), 1),
value_Max = round(max(value), 1),
.groups = "drop") %>%
pivot_wider(names_from = per_metric,
values_from = starts_with("value_")) %>%
# Round the values into a nicer format where we want the weights to have two decimals
txtRound(ends_with("_wt"), digits = 2) %>%
txtRound(starts_with("value") & !ends_with("_wt"), digits = 1) %>%
# Convert into long format
pivot_longer(cols = starts_with("value_"), names_prefix = "value_") %>%
separate(name, into = c("summary_stat", "per_metric")) %>%
# Without sorting the row groups wont appear right
# If the columns end up in the wrong order you may want to change the columns
# into factors
arrange(per_metric) %>%
addHtmlTableStyle(align = "r") %>%
tidyHtmlTable(
header = gear,
cgroup = cyl,
rnames = summary_stat,
rgroup = per_metric,
skip_removal_warning = TRUE)
htmlTable/inst/doc/ 0000755 0001762 0000144 00000000000 14517464237 013725 5 ustar ligges users htmlTable/inst/doc/complex_tables.html 0000644 0001762 0000144 00001277076 14517464233 017634 0 ustar ligges users
Building a complex table
Tables are an essential part of publishing, well… anything. I
therefore want to explore the options available for generating these in
knitr. It is important to remember that there are two ways of generating
tables in markdown:
Markdown tables
HTML tables
As the htmlTable-package is all about HTML tables we will work
only with that output option. The core idea is that HTML is ubiquitous
and that most word-processors will have to support copy-pasting tables
and by providing simple simple CSS-formatting we are able to maximize
this compatibility. Note CSS is today an extremely complex
topic and it is no surprise that word-processors may have difficulty
importing tables that have lots of advanced syntax, htmlTable tries to
avoid all of that by putting the style close to each element, often at
the cell-level.
Basics
I developed the htmlTable in order to get tables
matching those available in top medical journals. After finding no
HTML-alternative to the Hmisc::latex function on Stack
Overflow I wrote a basic function allowing column spanners and row
groups. Below is a basic example on these two:
Basic table with both column spanners (groups) and row groups
† A table footer commment
We can modify all our tables by using the
setHtmlTableTemplate() and we also don’t have to set the
exact span of each group as it can be assumed from the data.
build complexity stepwise through passing
addHtmlTableStyle() function
keep arguments to a minimum through templating and
autocalculation
Example based upon Swedish statistics
In order to make a more interesting example we will try to look at
how the average age changes between Swedish counties the last 15 years.
Goal: visualize migration patterns.
The dataset has been downloaded from Statistics Sweden and is
attached to the htmlTable-package. We will start by reshaping our tidy
dataset into a more table adapted format.
data(SCB)# The SCB has three other columns and one value columnprepped_scb <- SCB |> dplyr::mutate(region =relevel(SCB$region, "Sweden")) |> dplyr::select(year, region, sex, values) |> tidyr::pivot_wider(names_from =c(region, sex), values_from = values)# Set rownames to be yearrownames(prepped_scb) <- prepped_scb$yearprepped_scb$year <-NULL# The dataset now has the rowsnames(prepped_scb)
## [,1] [,2] [,3] [,4] [,5]
## [1,] "Sweden" "Stockholm county" "Uppsala county" "Norrbotten county" NA
## [2,] "Men" "Women" "Men" "Women" "Men"
## [,6] [,7] [,8]
## [1,] NA NA NA
## [2,] "Women" "Men" "Women"
print(n.cgroup)
## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
## [1,] 4 6 6 6 NA NA NA NA
## [2,] 2 2 3 3 3 3 3 3
Next step is to output the table after rounding to the correct number
of decimals. The txtRound function helps with this, as it
uses the sprintf function instead of the round
the resulting strings have the correct number of decimals, i.e. 1.02
will by round become 1 while we want it to retain the last decimal,
i.e. be shown as 1.0.
htmlTable(txtRound(mx, 1),cgroup = cgroup,n.cgroup = n.cgroup,rgroup =c("First period","Second period","Third period"),n.rgroup =rep(5, 3),tfoot =txtMergeLines("Δ<sub>int</sub> correspnds to the change since start","Δ<sub>std</sub> corresponds to the change compared to national average"))
Sweden
Stockholm county
Uppsala county
Norrbotten county
Men
Women
Men
Women
Men
Women
Men
Women
Age
Δint
Age
Δint
Age
Δint
Δstd
Age
Δint
Δstd
Age
Δint
Δstd
Age
Δint
Δstd
Age
Δint
Δstd
Age
Δint
Δstd
First period
1
38.9
0.0
41.5
0.0
37.3
0.0
-1.6
40.1
0.0
-1.4
37.2
0.0
-1.7
39.3
0.0
-2.2
39.7
0.0
0.8
41.9
0.0
0.4
2
39.0
0.1
41.6
0.1
37.4
0.1
-1.6
40.1
0.0
-1.5
37.5
0.3
-1.5
39.4
0.1
-2.2
40.0
0.3
1.0
42.2
0.3
0.6
3
39.2
0.3
41.7
0.2
37.5
0.2
-1.7
40.1
0.0
-1.6
37.6
0.4
-1.6
39.6
0.3
-2.1
40.2
0.5
1.0
42.5
0.6
0.8
4
39.3
0.4
41.8
0.3
37.6
0.3
-1.7
40.2
0.1
-1.6
37.8
0.6
-1.5
39.7
0.4
-2.1
40.5
0.8
1.2
42.8
0.9
1.0
5
39.4
0.5
41.9
0.4
37.7
0.4
-1.7
40.2
0.1
-1.7
38.0
0.8
-1.4
39.8
0.5
-2.1
40.7
1.0
1.3
43.0
1.1
1.1
Second period
6
39.6
0.7
42.0
0.5
37.8
0.5
-1.8
40.3
0.2
-1.7
38.1
0.9
-1.5
40.0
0.7
-2.0
40.9
1.2
1.3
43.1
1.2
1.1
7
39.7
0.8
42.0
0.5
37.9
0.6
-1.8
40.3
0.2
-1.7
38.3
1.1
-1.4
40.1
0.8
-1.9
41.1
1.4
1.4
43.4
1.5
1.4
8
39.8
0.9
42.1
0.6
37.9
0.6
-1.9
40.2
0.1
-1.9
38.5
1.3
-1.3
40.4
1.1
-1.7
41.3
1.6
1.5
43.5
1.6
1.4
9
39.8
0.9
42.1
0.6
37.8
0.5
-2.0
40.1
0.0
-2.0
38.6
1.4
-1.2
40.5
1.2
-1.6
41.5
1.8
1.7
43.8
1.9
1.7
10
39.9
1.0
42.1
0.6
37.8
0.5
-2.1
40.1
0.0
-2.0
38.7
1.5
-1.2
40.5
1.2
-1.6
41.7
2.0
1.8
44.0
2.1
1.9
Third period
11
39.9
1.0
42.1
0.6
37.8
0.5
-2.1
40.0
-0.1
-2.1
38.8
1.6
-1.1
40.6
1.3
-1.5
41.9
2.2
2.0
44.2
2.3
2.1
12
40.0
1.1
42.1
0.6
37.8
0.5
-2.2
40.0
-0.1
-2.1
38.9
1.7
-1.1
40.6
1.3
-1.5
42.1
2.4
2.1
44.4
2.5
2.3
13
40.1
1.2
42.2
0.7
37.9
0.6
-2.2
39.9
-0.2
-2.3
39.0
1.8
-1.1
40.7
1.4
-1.5
42.3
2.6
2.2
44.5
2.6
2.3
14
40.2
1.3
42.2
0.7
37.9
0.6
-2.3
39.9
-0.2
-2.3
39.1
1.9
-1.1
40.8
1.5
-1.4
42.4
2.7
2.2
44.6
2.7
2.4
15
40.2
1.3
42.2
0.7
38.0
0.7
-2.2
39.9
-0.2
-2.3
39.2
2.0
-1.0
40.9
1.6
-1.3
42.4
2.7
2.2
44.7
2.8
2.5
Δint correspnds to the change since start
Δstd corresponds to the change compared to national average
In order to increase the readability we may want to separate the
Sweden columns from the county columns, one way is to use the align
option with a |. Note that in 1.0 the function continues with the same
alignment until the end, i.e. you no longer need count to have the exact
right number of columns in your alignment argument.
mx |>txtRound(digits =1) |>addHtmlTableStyle(align ="rrrr|r",spacer.celltype ="double_cell") |>htmlTable(cgroup = cgroup,n.cgroup = n.cgroup,rgroup =c("First period","Second period","Third period"),n.rgroup =rep(5, 3),tfoot =txtMergeLines("Δ<sub>int</sub> correspnds to the change since start","Δ<sub>std</sub> corresponds to the change compared to national average"))
Sweden
Stockholm county
Uppsala county
Norrbotten county
Men
Women
Men
Women
Men
Women
Men
Women
Age
Δint
Age
Δint
Age
Δint
Δstd
Age
Δint
Δstd
Age
Δint
Δstd
Age
Δint
Δstd
Age
Δint
Δstd
Age
Δint
Δstd
First period
1
38.9
0.0
41.5
0.0
37.3
0.0
-1.6
40.1
0.0
-1.4
37.2
0.0
-1.7
39.3
0.0
-2.2
39.7
0.0
0.8
41.9
0.0
0.4
2
39.0
0.1
41.6
0.1
37.4
0.1
-1.6
40.1
0.0
-1.5
37.5
0.3
-1.5
39.4
0.1
-2.2
40.0
0.3
1.0
42.2
0.3
0.6
3
39.2
0.3
41.7
0.2
37.5
0.2
-1.7
40.1
0.0
-1.6
37.6
0.4
-1.6
39.6
0.3
-2.1
40.2
0.5
1.0
42.5
0.6
0.8
4
39.3
0.4
41.8
0.3
37.6
0.3
-1.7
40.2
0.1
-1.6
37.8
0.6
-1.5
39.7
0.4
-2.1
40.5
0.8
1.2
42.8
0.9
1.0
5
39.4
0.5
41.9
0.4
37.7
0.4
-1.7
40.2
0.1
-1.7
38.0
0.8
-1.4
39.8
0.5
-2.1
40.7
1.0
1.3
43.0
1.1
1.1
Second period
6
39.6
0.7
42.0
0.5
37.8
0.5
-1.8
40.3
0.2
-1.7
38.1
0.9
-1.5
40.0
0.7
-2.0
40.9
1.2
1.3
43.1
1.2
1.1
7
39.7
0.8
42.0
0.5
37.9
0.6
-1.8
40.3
0.2
-1.7
38.3
1.1
-1.4
40.1
0.8
-1.9
41.1
1.4
1.4
43.4
1.5
1.4
8
39.8
0.9
42.1
0.6
37.9
0.6
-1.9
40.2
0.1
-1.9
38.5
1.3
-1.3
40.4
1.1
-1.7
41.3
1.6
1.5
43.5
1.6
1.4
9
39.8
0.9
42.1
0.6
37.8
0.5
-2.0
40.1
0.0
-2.0
38.6
1.4
-1.2
40.5
1.2
-1.6
41.5
1.8
1.7
43.8
1.9
1.7
10
39.9
1.0
42.1
0.6
37.8
0.5
-2.1
40.1
0.0
-2.0
38.7
1.5
-1.2
40.5
1.2
-1.6
41.7
2.0
1.8
44.0
2.1
1.9
Third period
11
39.9
1.0
42.1
0.6
37.8
0.5
-2.1
40.0
-0.1
-2.1
38.8
1.6
-1.1
40.6
1.3
-1.5
41.9
2.2
2.0
44.2
2.3
2.1
12
40.0
1.1
42.1
0.6
37.8
0.5
-2.2
40.0
-0.1
-2.1
38.9
1.7
-1.1
40.6
1.3
-1.5
42.1
2.4
2.1
44.4
2.5
2.3
13
40.1
1.2
42.2
0.7
37.9
0.6
-2.2
39.9
-0.2
-2.3
39.0
1.8
-1.1
40.7
1.4
-1.5
42.3
2.6
2.2
44.5
2.6
2.3
14
40.2
1.3
42.2
0.7
37.9
0.6
-2.3
39.9
-0.2
-2.3
39.1
1.9
-1.1
40.8
1.5
-1.4
42.4
2.7
2.2
44.6
2.7
2.4
15
40.2
1.3
42.2
0.7
38.0
0.7
-2.2
39.9
-0.2
-2.3
39.2
2.0
-1.0
40.9
1.6
-1.3
42.4
2.7
2.2
44.7
2.8
2.5
Δint correspnds to the change since start
Δstd corresponds to the change compared to national average
If we still feel that we want more separation it is always possible
to add colors.
mx |>txtRound(digits =1) |>addHtmlTableStyle(align ="rrrr|r",align.header ="c",col.columns =c(rep("#E6E6F0", 4),rep("none", ncol(mx) -4))) |>htmlTable(cgroup = cgroup,n.cgroup = n.cgroup,rgroup =c("First period","Second period","Third period"),n.rgroup =rep(5, 3),tfoot =txtMergeLines("Δ<sub>int</sub> correspnds to the change since start","Δ<sub>std</sub> corresponds to the change compared to national average"))
Sweden
Stockholm county
Uppsala county
Norrbotten county
Men
Women
Men
Women
Men
Women
Men
Women
Age
Δint
Age
Δint
Age
Δint
Δstd
Age
Δint
Δstd
Age
Δint
Δstd
Age
Δint
Δstd
Age
Δint
Δstd
Age
Δint
Δstd
First period
1
38.9
0.0
41.5
0.0
37.3
0.0
-1.6
40.1
0.0
-1.4
37.2
0.0
-1.7
39.3
0.0
-2.2
39.7
0.0
0.8
41.9
0.0
0.4
2
39.0
0.1
41.6
0.1
37.4
0.1
-1.6
40.1
0.0
-1.5
37.5
0.3
-1.5
39.4
0.1
-2.2
40.0
0.3
1.0
42.2
0.3
0.6
3
39.2
0.3
41.7
0.2
37.5
0.2
-1.7
40.1
0.0
-1.6
37.6
0.4
-1.6
39.6
0.3
-2.1
40.2
0.5
1.0
42.5
0.6
0.8
4
39.3
0.4
41.8
0.3
37.6
0.3
-1.7
40.2
0.1
-1.6
37.8
0.6
-1.5
39.7
0.4
-2.1
40.5
0.8
1.2
42.8
0.9
1.0
5
39.4
0.5
41.9
0.4
37.7
0.4
-1.7
40.2
0.1
-1.7
38.0
0.8
-1.4
39.8
0.5
-2.1
40.7
1.0
1.3
43.0
1.1
1.1
Second period
6
39.6
0.7
42.0
0.5
37.8
0.5
-1.8
40.3
0.2
-1.7
38.1
0.9
-1.5
40.0
0.7
-2.0
40.9
1.2
1.3
43.1
1.2
1.1
7
39.7
0.8
42.0
0.5
37.9
0.6
-1.8
40.3
0.2
-1.7
38.3
1.1
-1.4
40.1
0.8
-1.9
41.1
1.4
1.4
43.4
1.5
1.4
8
39.8
0.9
42.1
0.6
37.9
0.6
-1.9
40.2
0.1
-1.9
38.5
1.3
-1.3
40.4
1.1
-1.7
41.3
1.6
1.5
43.5
1.6
1.4
9
39.8
0.9
42.1
0.6
37.8
0.5
-2.0
40.1
0.0
-2.0
38.6
1.4
-1.2
40.5
1.2
-1.6
41.5
1.8
1.7
43.8
1.9
1.7
10
39.9
1.0
42.1
0.6
37.8
0.5
-2.1
40.1
0.0
-2.0
38.7
1.5
-1.2
40.5
1.2
-1.6
41.7
2.0
1.8
44.0
2.1
1.9
Third period
11
39.9
1.0
42.1
0.6
37.8
0.5
-2.1
40.0
-0.1
-2.1
38.8
1.6
-1.1
40.6
1.3
-1.5
41.9
2.2
2.0
44.2
2.3
2.1
12
40.0
1.1
42.1
0.6
37.8
0.5
-2.2
40.0
-0.1
-2.1
38.9
1.7
-1.1
40.6
1.3
-1.5
42.1
2.4
2.1
44.4
2.5
2.3
13
40.1
1.2
42.2
0.7
37.9
0.6
-2.2
39.9
-0.2
-2.3
39.0
1.8
-1.1
40.7
1.4
-1.5
42.3
2.6
2.2
44.5
2.6
2.3
14
40.2
1.3
42.2
0.7
37.9
0.6
-2.3
39.9
-0.2
-2.3
39.1
1.9
-1.1
40.8
1.5
-1.4
42.4
2.7
2.2
44.6
2.7
2.4
15
40.2
1.3
42.2
0.7
38.0
0.7
-2.2
39.9
-0.2
-2.3
39.2
2.0
-1.0
40.9
1.6
-1.3
42.4
2.7
2.2
44.7
2.8
2.5
Δint correspnds to the change since start
Δstd corresponds to the change compared to national average
If we add a color to the row group and restrict the rgroup spanner we
may even have a more visual aid.
mx |>txtRound(digits =1) |>addHtmlTableStyle(align ="rrrr|r",align.header ="c",col.columns =c(rep("#E6E6F0", 4),rep("none", ncol(mx) -4)),col.rgroup =c("none", "#FFFFCC")) |>htmlTable(cgroup = cgroup,n.cgroup = n.cgroup,# I use the - the no breaking space as I don't want to have a# row break in the row group. This adds a little space in the table# when used together with the cspan.rgroup=1.rgroup =c("1st period","2nd period","3rd period"),n.rgroup =rep(5, 3),tfoot =txtMergeLines("Δ<sub>int</sub> correspnds to the change since start","Δ<sub>std</sub> corresponds to the change compared to national average"),cspan.rgroup =1)
Sweden
Stockholm county
Uppsala county
Norrbotten county
Men
Women
Men
Women
Men
Women
Men
Women
Age
Δint
Age
Δint
Age
Δint
Δstd
Age
Δint
Δstd
Age
Δint
Δstd
Age
Δint
Δstd
Age
Δint
Δstd
Age
Δint
Δstd
1st period
1
38.9
0.0
41.5
0.0
37.3
0.0
-1.6
40.1
0.0
-1.4
37.2
0.0
-1.7
39.3
0.0
-2.2
39.7
0.0
0.8
41.9
0.0
0.4
2
39.0
0.1
41.6
0.1
37.4
0.1
-1.6
40.1
0.0
-1.5
37.5
0.3
-1.5
39.4
0.1
-2.2
40.0
0.3
1.0
42.2
0.3
0.6
3
39.2
0.3
41.7
0.2
37.5
0.2
-1.7
40.1
0.0
-1.6
37.6
0.4
-1.6
39.6
0.3
-2.1
40.2
0.5
1.0
42.5
0.6
0.8
4
39.3
0.4
41.8
0.3
37.6
0.3
-1.7
40.2
0.1
-1.6
37.8
0.6
-1.5
39.7
0.4
-2.1
40.5
0.8
1.2
42.8
0.9
1.0
5
39.4
0.5
41.9
0.4
37.7
0.4
-1.7
40.2
0.1
-1.7
38.0
0.8
-1.4
39.8
0.5
-2.1
40.7
1.0
1.3
43.0
1.1
1.1
2nd period
6
39.6
0.7
42.0
0.5
37.8
0.5
-1.8
40.3
0.2
-1.7
38.1
0.9
-1.5
40.0
0.7
-2.0
40.9
1.2
1.3
43.1
1.2
1.1
7
39.7
0.8
42.0
0.5
37.9
0.6
-1.8
40.3
0.2
-1.7
38.3
1.1
-1.4
40.1
0.8
-1.9
41.1
1.4
1.4
43.4
1.5
1.4
8
39.8
0.9
42.1
0.6
37.9
0.6
-1.9
40.2
0.1
-1.9
38.5
1.3
-1.3
40.4
1.1
-1.7
41.3
1.6
1.5
43.5
1.6
1.4
9
39.8
0.9
42.1
0.6
37.8
0.5
-2.0
40.1
0.0
-2.0
38.6
1.4
-1.2
40.5
1.2
-1.6
41.5
1.8
1.7
43.8
1.9
1.7
10
39.9
1.0
42.1
0.6
37.8
0.5
-2.1
40.1
0.0
-2.0
38.7
1.5
-1.2
40.5
1.2
-1.6
41.7
2.0
1.8
44.0
2.1
1.9
3rd period
11
39.9
1.0
42.1
0.6
37.8
0.5
-2.1
40.0
-0.1
-2.1
38.8
1.6
-1.1
40.6
1.3
-1.5
41.9
2.2
2.0
44.2
2.3
2.1
12
40.0
1.1
42.1
0.6
37.8
0.5
-2.2
40.0
-0.1
-2.1
38.9
1.7
-1.1
40.6
1.3
-1.5
42.1
2.4
2.1
44.4
2.5
2.3
13
40.1
1.2
42.2
0.7
37.9
0.6
-2.2
39.9
-0.2
-2.3
39.0
1.8
-1.1
40.7
1.4
-1.5
42.3
2.6
2.2
44.5
2.6
2.3
14
40.2
1.3
42.2
0.7
37.9
0.6
-2.3
39.9
-0.2
-2.3
39.1
1.9
-1.1
40.8
1.5
-1.4
42.4
2.7
2.2
44.6
2.7
2.4
15
40.2
1.3
42.2
0.7
38.0
0.7
-2.2
39.9
-0.2
-2.3
39.2
2.0
-1.0
40.9
1.6
-1.3
42.4
2.7
2.2
44.7
2.8
2.5
Δint correspnds to the change since start
Δstd corresponds to the change compared to national average
If you want to further add to the visual hints you can use specific
HTML-code and insert it into the cells. Here we will color the
Δstd according to color. By default htmlTable does not escape
HTML characters.
cols_2_clr <-grep("Δ<sub>std</sub>", colnames(mx))# We need a copy as the formatting causes the matrix to loos# its numerical propertyout_mx <-txtRound(mx, 1)min_delta <-min(mx[,cols_2_clr])span_delta <-max(mx[,cols_2_clr]) -min(mx[,cols_2_clr])for (col in cols_2_clr) { out_mx[, col] <-mapply(function(val, strength)paste0("<span style='font-weight: 900; color: ",colorRampPalette(c("#009900", "#000000", "#990033"))(101)[strength],"'>", val, "</span>"),val = out_mx[,col],strength =round((mx[,col] - min_delta)/span_delta*100+1),USE.NAMES =FALSE)}out_mx |>addHtmlTableStyle(align ="rrrr|r",align.header ="cccc|c",pos.rowlabel ="bottom",col.rgroup =c("none", "#FFFFCC"),col.columns =c(rep("#EFEFF0", 4),rep("none", ncol(mx) -4))) |>htmlTable(caption ="Average age in Sweden counties over a period of 15 years. The Norbotten county is typically known for having a negative migration pattern compared to Stockholm, while Uppsala has a proportionally large population of students.",rowlabel ="Year",cgroup = cgroup,n.cgroup = n.cgroup,rgroup =c("1st period","2nd period","3rd period"),n.rgroup =rep(5, 3),tfoot =txtMergeLines("Δ<sub>int</sub> corresponds to the change since start","Δ<sub>std</sub> corresponds to the change compared to national average"),cspan.rgroup =1)
Sweden
Stockholm county
Uppsala county
Norrbotten county
Men
Women
Men
Women
Men
Women
Men
Women
Year
Age
Δint
Age
Δint
Age
Δint
Δstd
Age
Δint
Δstd
Age
Δint
Δstd
Age
Δint
Δstd
Age
Δint
Δstd
Age
Δint
Δstd
1st period
1
38.9
0.0
41.5
0.0
37.3
0.0
-1.6
40.1
0.0
-1.4
37.2
0.0
-1.7
39.3
0.0
-2.2
39.7
0.0
0.8
41.9
0.0
0.4
2
39.0
0.1
41.6
0.1
37.4
0.1
-1.6
40.1
0.0
-1.5
37.5
0.3
-1.5
39.4
0.1
-2.2
40.0
0.3
1.0
42.2
0.3
0.6
3
39.2
0.3
41.7
0.2
37.5
0.2
-1.7
40.1
0.0
-1.6
37.6
0.4
-1.6
39.6
0.3
-2.1
40.2
0.5
1.0
42.5
0.6
0.8
4
39.3
0.4
41.8
0.3
37.6
0.3
-1.7
40.2
0.1
-1.6
37.8
0.6
-1.5
39.7
0.4
-2.1
40.5
0.8
1.2
42.8
0.9
1.0
5
39.4
0.5
41.9
0.4
37.7
0.4
-1.7
40.2
0.1
-1.7
38.0
0.8
-1.4
39.8
0.5
-2.1
40.7
1.0
1.3
43.0
1.1
1.1
2nd period
6
39.6
0.7
42.0
0.5
37.8
0.5
-1.8
40.3
0.2
-1.7
38.1
0.9
-1.5
40.0
0.7
-2.0
40.9
1.2
1.3
43.1
1.2
1.1
7
39.7
0.8
42.0
0.5
37.9
0.6
-1.8
40.3
0.2
-1.7
38.3
1.1
-1.4
40.1
0.8
-1.9
41.1
1.4
1.4
43.4
1.5
1.4
8
39.8
0.9
42.1
0.6
37.9
0.6
-1.9
40.2
0.1
-1.9
38.5
1.3
-1.3
40.4
1.1
-1.7
41.3
1.6
1.5
43.5
1.6
1.4
9
39.8
0.9
42.1
0.6
37.8
0.5
-2.0
40.1
0.0
-2.0
38.6
1.4
-1.2
40.5
1.2
-1.6
41.5
1.8
1.7
43.8
1.9
1.7
10
39.9
1.0
42.1
0.6
37.8
0.5
-2.1
40.1
0.0
-2.0
38.7
1.5
-1.2
40.5
1.2
-1.6
41.7
2.0
1.8
44.0
2.1
1.9
3rd period
11
39.9
1.0
42.1
0.6
37.8
0.5
-2.1
40.0
-0.1
-2.1
38.8
1.6
-1.1
40.6
1.3
-1.5
41.9
2.2
2.0
44.2
2.3
2.1
12
40.0
1.1
42.1
0.6
37.8
0.5
-2.2
40.0
-0.1
-2.1
38.9
1.7
-1.1
40.6
1.3
-1.5
42.1
2.4
2.1
44.4
2.5
2.3
13
40.1
1.2
42.2
0.7
37.9
0.6
-2.2
39.9
-0.2
-2.3
39.0
1.8
-1.1
40.7
1.4
-1.5
42.3
2.6
2.2
44.5
2.6
2.3
14
40.2
1.3
42.2
0.7
37.9
0.6
-2.3
39.9
-0.2
-2.3
39.1
1.9
-1.1
40.8
1.5
-1.4
42.4
2.7
2.2
44.6
2.7
2.4
15
40.2
1.3
42.2
0.7
38.0
0.7
-2.2
39.9
-0.2
-2.3
39.2
2.0
-1.0
40.9
1.6
-1.3
42.4
2.7
2.2
44.7
2.8
2.5
Average age in Sweden counties over a period of 15 years. The Norbotten
county is typically known for having a negative migration pattern
compared to Stockholm, while Uppsala has a proportionally large
population of students.
Δint corresponds to the change since start
Δstd corresponds to the change compared to national average
Although a graph most likely does the visualization task better,
tables are good at conveying detailed information. It is in my mind
without doubt easier in the latest version to find the pattern in the
data.
htmlTable/inst/doc/tidyHtmlTable.Rmd 0000644 0001762 0000144 00000004702 13701421460 017123 0 ustar ligges users ---
title: "Using tidyHtmlTable"
author: "Stephen Gragg"
date: "`r Sys.Date()`"
output: rmarkdown::html_vignette
vignette: >
%\VignetteIndexEntry{Using tidyHtmlTable}
%\VignetteEncoding{UTF-8}
%\VignetteEngine{knitr::rmarkdown}
editor_options:
chunk_output_type: console
---
# Introduction
`tidyHtmlTable` acts as a wrapper function for the `htmlTable`
function allowing columns to be mapped from the input data to specific htmlTable
parameters in a manner similar to ggplot2.
# Some Examples
## Prepare Data
We'll begin by turning the `mtcars` data into a tidy dataset. The
`pivot_longer` function is called to collect 3 performance metrics into a pair
of key and value columns.
```{r, message=FALSE}
library(magrittr)
library(tidyr)
library(dplyr)
library(htmlTable)
library(tibble)
td <- mtcars %>%
as_tibble(rownames = "rnames") %>%
pivot_longer(names_to = "per_metric",
cols = c(hp, mpg, qsec))
```
Now we will compute 4 summary statistics for each of the 3 performance metrics.
This will be further grouped by number of cylinders and gears.
```{r}
tidy_summary <- td %>%
group_by(cyl, gear, per_metric) %>%
summarise(Mean = round(mean(value), 1),
SD = round(sd(value), 1),
Min = round(min(value), 1),
Max = round(max(value), 1),
.groups = 'drop') %>%
pivot_longer(names_to = "summary_stat",
cols = c(Mean, SD, Min, Max)) %>%
ungroup() %>%
mutate(gear = paste(gear, "Gears"),
cyl = paste(cyl, "Cylinders"))
```
At this point, we are ready to implement the `htmlTable` function.
Essentially, this constructs an html table using arguments similar to the
`htmlTable` function. However, whereas `htmlTable` required the user to manually
arrange the data and specify the column groups, headers, row names, row-groups,
etc., each of these components of the table is mapped to a column within the
input data.
## Output html table
### Example 1
```{r, warning=FALSE}
tidy_summary %>%
arrange(per_metric, summary_stat) %>%
addHtmlTableStyle(align = "r") %>%
tidyHtmlTable(header = gear,
cgroup = cyl,
rnames = summary_stat,
rgroup = per_metric)
```
### Example 2
```{r, warning=FALSE}
tidy_summary %>%
arrange(cyl, gear) %>%
addHtmlTableStyle(align = "r") %>%
tidyHtmlTable(header = summary_stat,
cgroup = per_metric,
rnames = gear,
rgroup = cyl)
```
htmlTable/inst/doc/tidyHtmlTable.R 0000644 0001762 0000144 00000002647 14517464237 016627 0 ustar ligges users ## ----message=FALSE------------------------------------------------------------
library(magrittr)
library(tidyr)
library(dplyr)
library(htmlTable)
library(tibble)
td <- mtcars %>%
as_tibble(rownames = "rnames") %>%
pivot_longer(names_to = "per_metric",
cols = c(hp, mpg, qsec))
## -----------------------------------------------------------------------------
tidy_summary <- td %>%
group_by(cyl, gear, per_metric) %>%
summarise(Mean = round(mean(value), 1),
SD = round(sd(value), 1),
Min = round(min(value), 1),
Max = round(max(value), 1),
.groups = 'drop') %>%
pivot_longer(names_to = "summary_stat",
cols = c(Mean, SD, Min, Max)) %>%
ungroup() %>%
mutate(gear = paste(gear, "Gears"),
cyl = paste(cyl, "Cylinders"))
## ----warning=FALSE------------------------------------------------------------
tidy_summary %>%
arrange(per_metric, summary_stat) %>%
addHtmlTableStyle(align = "r") %>%
tidyHtmlTable(header = gear,
cgroup = cyl,
rnames = summary_stat,
rgroup = per_metric)
## ----warning=FALSE------------------------------------------------------------
tidy_summary %>%
arrange(cyl, gear) %>%
addHtmlTableStyle(align = "r") %>%
tidyHtmlTable(header = summary_stat,
cgroup = per_metric,
rnames = gear,
rgroup = cyl)
htmlTable/inst/doc/complex_tables.R 0000644 0001762 0000144 00000017501 14517464231 017047 0 ustar ligges users ## -----------------------------------------------------------------------------
library(htmlTable)
setHtmlTableTheme(theme = "Google docs")
output <-
matrix(paste("Content", LETTERS[1:16]),
ncol = 4, byrow = TRUE)
output |>
htmlTable(header = paste(c("1st", "2nd", "3rd", "4th"), "header"),
rnames = paste(c("1st", "2nd", "3rd", "4th"), "row"),
rgroup = c("Group A", "Group B"),
n.rgroup = c(2, 2),
cgroup = c("Cgroup 1", "Cgroup 2†"),
n.cgroup = c(2, 2),
caption = "Basic table with both column spanners (groups) and row groups",
tfoot = "† A table footer commment")
## -----------------------------------------------------------------------------
setHtmlTableTheme(pos.caption = "bottom")
output |>
addHtmlTableStyle(css.rgroup = "font-style: italic") |>
htmlTable(header = paste(c("1st", "2nd", "3rd", "4th"), "header"),
rnames = paste(c("1st", "2nd", "3rd", "4th"), "row"),
rgroup = c("Group A", "Group B", ""),
n.rgroup = c(1, 2),
cgroup = c("Cgroup 1", "Cgroup 2†"),
n.cgroup = 3,
caption = "A slightly differnt table with a bottom caption",
tfoot = "† A table footer commment")
## ----results='markup', message=FALSE, warning=FALSE---------------------------
data(SCB)
# The SCB has three other columns and one value column
prepped_scb <- SCB |>
dplyr::mutate(region = relevel(SCB$region, "Sweden")) |>
dplyr::select(year, region, sex, values) |>
tidyr::pivot_wider(names_from = c(region, sex), values_from = values)
# Set rownames to be year
rownames(prepped_scb) <- prepped_scb$year
prepped_scb$year <- NULL
# The dataset now has the rows
names(prepped_scb)
# and the dimensions
dim(prepped_scb)
## -----------------------------------------------------------------------------
mx <- NULL
for (n in names(prepped_scb)) {
tmp <- paste0("Sweden_", strsplit(n, "_")[[1]][2])
mx <- cbind(mx,
cbind(prepped_scb[[n]],
prepped_scb[[n]] - prepped_scb[[n]][1],
prepped_scb[[n]] - prepped_scb[[tmp]]))
}
rownames(mx) <- rownames(prepped_scb)
colnames(mx) <- rep(c("Age",
"Δint",
"Δstd"),
times = ncol(prepped_scb))
mx <- mx[,c(-3, -6)]
# This automated generation of cgroup elements is
# somewhat of an overkill
cgroup <-
unique(sapply(names(prepped_scb),
function(x) strsplit(x, "_")[[1]][1],
USE.NAMES = FALSE))
n.cgroup <-
sapply(cgroup,
function(x) sum(grepl(paste0("^", x), names(prepped_scb))),
USE.NAMES = FALSE)*3
n.cgroup[cgroup == "Sweden"] <-
n.cgroup[cgroup == "Sweden"] - 2
cgroup <-
rbind(c(cgroup, rep(NA, ncol(prepped_scb) - length(cgroup))),
Hmisc::capitalize(
sapply(names(prepped_scb),
function(x) strsplit(x, "_")[[1]][2],
USE.NAMES = FALSE)))
n.cgroup <-
rbind(c(n.cgroup, rep(NA, ncol(prepped_scb) - length(n.cgroup))),
c(2,2, rep(3, ncol(cgroup) - 2)))
print(cgroup)
print(n.cgroup)
## -----------------------------------------------------------------------------
htmlTable(txtRound(mx, 1),
cgroup = cgroup,
n.cgroup = n.cgroup,
rgroup = c("First period",
"Second period",
"Third period"),
n.rgroup = rep(5, 3),
tfoot = txtMergeLines("Δint correspnds to the change since start",
"Δstd corresponds to the change compared to national average"))
## -----------------------------------------------------------------------------
mx |>
txtRound(digits = 1) |>
addHtmlTableStyle(align = "rrrr|r",
spacer.celltype = "double_cell") |>
htmlTable(cgroup = cgroup,
n.cgroup = n.cgroup,
rgroup = c("First period",
"Second period",
"Third period"),
n.rgroup = rep(5, 3),
tfoot = txtMergeLines("Δint correspnds to the change since start",
"Δstd corresponds to the change compared to national average"))
## -----------------------------------------------------------------------------
mx |>
txtRound(digits = 1) |>
addHtmlTableStyle(align = "rrrr|r",
align.header = "c",
col.columns = c(rep("#E6E6F0", 4),
rep("none", ncol(mx) - 4))) |>
htmlTable(cgroup = cgroup,
n.cgroup = n.cgroup,
rgroup = c("First period",
"Second period",
"Third period"),
n.rgroup = rep(5, 3),
tfoot = txtMergeLines("Δint correspnds to the change since start",
"Δstd corresponds to the change compared to national average"))
## -----------------------------------------------------------------------------
mx |>
txtRound(digits = 1) |>
addHtmlTableStyle(align = "rrrr|r",
align.header = "c",
col.columns = c(rep("#E6E6F0", 4),
rep("none", ncol(mx) - 4)),
col.rgroup = c("none", "#FFFFCC")) |>
htmlTable(cgroup = cgroup,
n.cgroup = n.cgroup,
# I use the - the no breaking space as I don't want to have a
# row break in the row group. This adds a little space in the table
# when used together with the cspan.rgroup=1.
rgroup = c("1st period",
"2nd period",
"3rd period"),
n.rgroup = rep(5, 3),
tfoot = txtMergeLines("Δint correspnds to the change since start",
"Δstd corresponds to the change compared to national average"),
cspan.rgroup = 1)
## -----------------------------------------------------------------------------
cols_2_clr <- grep("Δstd", colnames(mx))
# We need a copy as the formatting causes the matrix to loos
# its numerical property
out_mx <- txtRound(mx, 1)
min_delta <- min(mx[,cols_2_clr])
span_delta <- max(mx[,cols_2_clr]) - min(mx[,cols_2_clr])
for (col in cols_2_clr) {
out_mx[, col] <- mapply(function(val, strength)
paste0("",
val, ""),
val = out_mx[,col],
strength = round((mx[,col] - min_delta)/span_delta*100 + 1),
USE.NAMES = FALSE)
}
out_mx |>
addHtmlTableStyle(align = "rrrr|r",
align.header = "cccc|c",
pos.rowlabel = "bottom",
col.rgroup = c("none", "#FFFFCC"),
col.columns = c(rep("#EFEFF0", 4),
rep("none", ncol(mx) - 4))) |>
htmlTable(caption = "Average age in Sweden counties over a period of
15 years. The Norbotten county is typically known
for having a negative migration pattern compared to
Stockholm, while Uppsala has a proportionally large
population of students.",
rowlabel = "Year",
cgroup = cgroup,
n.cgroup = n.cgroup,
rgroup = c("1st period",
"2nd period",
"3rd period"),
n.rgroup = rep(5, 3),
tfoot = txtMergeLines("Δint corresponds to the change since start",
"Δstd corresponds to the change compared to national average"),
cspan.rgroup = 1)
htmlTable/inst/doc/general.R 0000644 0001762 0000144 00000017317 14517464235 015474 0 ustar ligges users ## -----------------------------------------------------------------------------
library(htmlTable)
library(magrittr)
# A simple output
matrix(1:4,
ncol = 2,
dimnames = list(c("Row 1", "Row 2"),
c("Column 1", "Column 2"))) %>%
htmlTable
## -----------------------------------------------------------------------------
# A simple output
matrix(1:4,
ncol = 2,
dimnames = list(rows = c("Row 1", "Row 2"),
cols = c("Column 1", "Column 2"))) %>%
htmlTable
## -----------------------------------------------------------------------------
data("mtcars")
with(mtcars,
table(cyl, gear)) %>%
addmargins %>%
htmlTable
## ----ctable_example-----------------------------------------------------------
output <- matrix(1:4,
ncol = 2,
dimnames = list(c("Row 1", "Row 2"),
c("Column 1", "Column 2")))
htmlTable(output,
ctable = c("solid", "double"),
caption = "A table caption above and ctable borders")
## ----table_with_caption_below-------------------------------------------------
output %>%
addHtmlTableStyle(pos.caption = "bottom") %>%
htmlTable(caption = "A table caption below")
## -----------------------------------------------------------------------------
1:3 %>%
addHtmlTableStyle(align = "lcr") %>%
htmlTable(rnames = "Row 1",
header = c("'l' = left", "'c' = center", "'r' = right"),
caption = "The alignment is set through the align options. Available alternatives are l, r, c as designated by the below table.")
## -----------------------------------------------------------------------------
1:3 %>%
addHtmlTableStyle(align = "clcr",
align.header = "lcr") %>%
htmlTable(rnames = "Row 1",
header = c("'l' = left", "'c' = center", "'r' = right"),
caption = "The alignment is set through the align options. Available alternatives are l, r, c as designated by the below table.")
## -----------------------------------------------------------------------------
mx <- matrix(ncol = 6, nrow = 8)
rownames(mx) <- paste(c("1st", "2nd",
"3rd",
paste0(4:8, "th")),
"row")
colnames(mx) <- paste(c("1st", "2nd",
"3rd",
paste0(4:6, "th")),
"hdr")
for (nr in 1:nrow(mx)) {
for (nc in 1:ncol(mx)) {
mx[nr, nc] <-
paste0(nr, ":", nc)
}
}
## -----------------------------------------------------------------------------
htmlTable(mx,
rgroup = paste("Group", LETTERS[1:3]),
n.rgroup = c(2,4,nrow(mx) - 6))
## -----------------------------------------------------------------------------
htmlTable(mx,
rgroup = c(paste("Group", LETTERS[1:2]), ""),
n.rgroup = c(2,4,nrow(mx) - 6))
## -----------------------------------------------------------------------------
mx %>%
addHtmlTableStyle(css.rgroup = "") %>%
htmlTable(rgroup = c(paste("Group", LETTERS[1:2]), ""),
n.rgroup = c(2,4,nrow(mx) - 6))
## -----------------------------------------------------------------------------
rgroup <- c(paste("Group", LETTERS[1:2]), "")
attr(rgroup, "add") <- list(`2` = "More")
htmlTable(mx,
rgroup = rgroup,
n.rgroup = c(2,4,nrow(mx) - 6))
## -----------------------------------------------------------------------------
htmlTable(mx,
cgroup = c("Cgroup 1", "Cgroup 2"),
n.cgroup = c(2,4))
## -----------------------------------------------------------------------------
htmlTable(mx,
cgroup = rbind(c("", "Column spanners", NA),
c("", "Cgroup 1", "Cgroup 2")),
n.cgroup = rbind(c(1,2,NA),
c(2,2,2)))
## -----------------------------------------------------------------------------
htmlTable(mx,
cgroup = list(c("Super column spanner", ""),
c("", "Another cgroup"),
c("", "Cgroup 1", "Cgroup 2")),
n.cgroup = list(c(5,1),
c(1,2),
c(2,2,2)))
## -----------------------------------------------------------------------------
htmlTable(mx,
tspanner = paste("Spanner", LETTERS[1:3]),
n.tspanner = c(2,4,nrow(mx) - 6))
## -----------------------------------------------------------------------------
htmlTable(mx,
tspanner = paste("Spanner", LETTERS[1:3]),
n.tspanner = c(2,4))
## -----------------------------------------------------------------------------
htmlTable(mx[1:3,], total = TRUE)
## -----------------------------------------------------------------------------
mx %>%
addHtmlTableStyle(css.total = c("border-top: 1px dashed grey;",
"border-top: 1px dashed grey;",
"border-top: 1px solid grey; font-weight: 900")) %>%
htmlTable(total = "tspanner",
tspanner = paste("Spanner", LETTERS[1:3]),
n.tspanner = c(2,4,nrow(mx) - 6))
## -----------------------------------------------------------------------------
options(table_counter = TRUE)
## -----------------------------------------------------------------------------
htmlTable(mx[1:2,1:2],
caption = "A table caption with a numbering")
## -----------------------------------------------------------------------------
tblNoLast()
tblNoNext()
## -----------------------------------------------------------------------------
htmlTable(mx[1:2,1:2],
caption = "Another table with numbering")
## -----------------------------------------------------------------------------
options(table_counter = FALSE)
## -----------------------------------------------------------------------------
htmlTable(mx[1:2,1:2],
tfoot = "A table footer")
## -----------------------------------------------------------------------------
mx %>%
addHtmlTableStyle(col.rgroup = c("none", "#F7F7F7")) %>%
htmlTable
## -----------------------------------------------------------------------------
mx %>%
addHtmlTableStyle(col.rgroup = c("none", "#F7F7F7")) %>%
htmlTable(rgroup = c(paste("Group", LETTERS[1:2]), ""),
n.rgroup = c(2,2,nrow(mx) - 4))
## -----------------------------------------------------------------------------
mx %>%
addHtmlTableStyle(col.columns = c("none", "#F7F7F7")) %>%
htmlTable
## -----------------------------------------------------------------------------
mx %>%
addHtmlTableStyle(col.rgroup = c("none", "#F9FAF0"),
col.columns = c("none", "#F1F0FA")) %>%
htmlTable
## -----------------------------------------------------------------------------
rgroup = paste("Group", LETTERS[1:3])
attr(rgroup, "add") <- list(`3` = "Group p-value < 0.001")
mx %>%
addHtmlTableStyle(align = "rr|r",
align.header = "cc|c",
spacer.celltype = "double_cell",
col.columns = c(rep("none", 2),
rep("#F5FBFF", 4)),
col.rgroup = c("none", "#F7F7F7"),
css.cell = "padding-left: .5em; padding-right: .2em;",
css.header = "font-weight: normal") %>%
htmlTable(rgroup = rgroup,
n.rgroup = c(2,4),
tspanner = paste("Spanner", LETTERS[1:2]),
n.tspanner = c(1),
cgroup = list(c("", "Column spanners"),
c("", "Cgroup 1", "Cgroup 2†")),
n.cgroup = list(c(1,5),
c(2,2,2)),
caption = "A table with column spanners, row groups, and zebra striping",
tfoot = "† A table footer commment",
cspan.rgroup = 2)
htmlTable/inst/doc/text_formatters.R 0000644 0001762 0000144 00000005633 14517464236 017310 0 ustar ligges users ## ----message=FALSE------------------------------------------------------------
library(htmlTable)
library(dplyr)
library(magrittr)
data("mtcars")
mtcars %<>%
mutate(am = factor(am, levels = 0:1, labels = c("Automatic", "Manual")),
vs = factor(vs, levels = 0:1, labels = c("V-shaped", "straight")))
mtcars %>%
head(3) %>%
select(Transmission = am, Gas = mpg, Weight = wt) %>%
htmlTable()
## -----------------------------------------------------------------------------
mtcars %>%
head(3) %>%
select(Transmission = am, Gas = mpg, Weight = wt) %>%
txtRound(digits = 1) %>%
htmlTable()
## -----------------------------------------------------------------------------
txtRound(c(1, 1.1034), digits = 2)
# Use a character to convert
txtRound("1.2333", digits = 2)
## -----------------------------------------------------------------------------
# Large numbers can be combined with the txtInt option
txtRound(12345.12, digits = 1, txtInt_args = TRUE)
txtRound(12345.12, digits = 1, txtInt_args = list(language = "se", html = FALSE))
## -----------------------------------------------------------------------------
mtcars %>%
head(3) %>%
select(mpg, wt) %>%
txtRound(mpg, wt_txt = wt, digits = 1)
## -----------------------------------------------------------------------------
mtcars %>%
head(3) %>%
select(mpg, qsec, wt) %>%
txtRound(digits = list(wt = 2, .default = 1))
## -----------------------------------------------------------------------------
mtcars_matrix <- mtcars %>%
select(mpg, qsec, wt) %>%
head(3) %>%
as.matrix()
mtcars_matrix %>%
txtRound(digits = 1)
## -----------------------------------------------------------------------------
mtcars_matrix %>%
txtRound(excl.cols = "^wt$",
excl.rows = "^Mazda RX4$",
digits = 1)
## -----------------------------------------------------------------------------
mtcars_matrix %>%
txtRound(digits = list(mpg = 0, wt = 2, .default = 1))
## -----------------------------------------------------------------------------
txtInt(1e7)
## -----------------------------------------------------------------------------
txtInt(1e7, language = "SI", html = FALSE)
txtInt(1e7, language = "SI", html = TRUE)
## -----------------------------------------------------------------------------
txtPval(c(0.1233213, 0.035, 0.001, 0.000001), html = FALSE)
# The < sign is less-than in html code '<'
txtPval(c(0.05, 0.001, 0.000001), html = TRUE)
## -----------------------------------------------------------------------------
txtMergeLines("Line 1",
"Line 2",
"Line 3")
## -----------------------------------------------------------------------------
txtMergeLines("Line 1
Line 2
Line 3")
## -----------------------------------------------------------------------------
txtMergeLines("Line 1
Line 2
Line 3",
html = FALSE)
htmlTable/inst/doc/tidyHtmlTable.html 0000644 0001762 0000144 00000127077 14517464237 017377 0 ustar ligges users
Using tidyHtmlTable
Using tidyHtmlTable
Stephen Gragg
2023-10-29
Introduction
tidyHtmlTable acts as a wrapper function for the
htmlTable function allowing columns to be mapped from the
input data to specific htmlTable parameters in a manner similar to
ggplot2.
Some Examples
Prepare Data
We’ll begin by turning the mtcars data into a tidy
dataset. The pivot_longer function is called to collect 3
performance metrics into a pair of key and value columns.
At this point, we are ready to implement the htmlTable
function. Essentially, this constructs an html table using arguments
similar to the htmlTable function. However, whereas
htmlTable required the user to manually arrange the data
and specify the column groups, headers, row names, row-groups, etc.,
each of these components of the table is mapped to a column within the
input data.
The htmlTable package is intended for generating
tables using HTML
formatting. This format is compatible with Markdown when used for
HTML-output. The most basic table can easily be created by just passing
a matrix or a data.frame to the
htmlTable-function:
As of version 1.1 you no longer need to specify
results='asis' for each knitr chunk.
Tip: If you are working a lot with
dplyr and the tidyverse approach to exploring
data you can make your life much easier using the
tidyHtmlTable() function included in this package that
automatically calculates the rgroup, cgroup
and other parameters that make htmlTable so useful.
Table caption
The table caption is simply the table description and can be either
located above or below:
Cell alignment is specified through the align,
align.header, align.cgroup arguments. For
aligning the cell values just use align. The argument can
accept either a vector or a string, although supplying it with a string
is the simplest option as in the example below:
1:3%>%addHtmlTableStyle(align ="lcr") %>%htmlTable(rnames ="Row 1",header =c("'l' = left", "'c' = center", "'r' = right"),caption ="The alignment is set through the align options. Available alternatives are l, r, c as designated by the below table.")
‘l’ = left
‘c’ = center
‘r’ = right
Row 1
1
2
3
The alignment is set through the align options. Available alternatives
are l, r, c as designated by the below table.
Note that you can specify a string shorter than the number of
columns. This can be useful if you have plenty of columns and you simply
want all remaining columns to keep the alignment of the last column. To
align the row name you can just add another letter to the string while
the header is aligned through the align.header
argument:
1:3%>%addHtmlTableStyle(align ="clcr",align.header ="lcr") %>%htmlTable(rnames ="Row 1",header =c("'l' = left", "'c' = center", "'r' = right"),caption ="The alignment is set through the align options. Available alternatives are l, r, c as designated by the below table.")
‘l’ = left
‘c’ = center
‘r’ = right
Row 1
1
2
3
The alignment is set through the align options. Available alternatives
are l, r, c as designated by the below table.
Advanced
While it may be sufficient for basic tables a more advanced layout is
often needed in medical articles with elements such as:
row groups
column spanners
table spanners
total row
table footer
zebra coloring (also known as banding):
rows
columns
As many journals require that a MS Word-document is submitted it is
furthermore also important that the table imports correctly to a word
processor, i.e. that the table also looks nice in the final document not
only in the browser. The htmlTable-function is written for
all these purposes.
For demonstration purposes we will setup a basic matrix:
The purpose of the row groups is to group variables that belong to
the same group, e.g. a factored variable with more than two levels often
benefit from grouping variables together.
The rgroup is most commonly a single row without any
additional cells but sometimes you may want to have a p-value or similar
at the end of the row. This can be achieved by setting the ‘add’
attribute to the rgroup:
Above example allows the column spanner to be a sum of the underlying
cgroups (see n.cgroup), this is not required by the function and you can
also provide a list with elements that allows you to skip
the NA at the end of the matrix:
Similarly you can use the number rgroups included in each tspanner
instead of actual rows. This is convenient as the tspannners must align
with underlying rgroups.
Total row
Many financial tables use the concept of a total row at the end that
sums the above elements:
The htmlTable has built-in numbering, initialized by:
options(table_counter =TRUE)
htmlTable(mx[1:2,1:2], caption ="A table caption with a numbering")
1st hdr
2nd hdr
1st row
1:1
1:2
2nd row
2:1
2:2
Table 1: A table caption with a numbering
As we often want to reference the table number in the text there are
two associated functions:
tblNoLast()
## [1] 1
tblNoNext()
## [1] 2
htmlTable(mx[1:2,1:2], caption ="Another table with numbering")
1st hdr
2nd hdr
1st row
1:1
1:2
2nd row
2:1
2:2
Table 2: Another table with numbering
If you want to start the counter at 2 you can instead of setting
table_counter to TRUE set it to 1. Note that you need to
set the value to one less as each time the table is called the counter
is incremented by one. You can also turn off the feature by:
options(table_counter =FALSE)
Zebra coloring (or banded colors)
Zebra coloring is also know as an alternating color pattern or row
shading. It is most commonly applied to rows:
The zebra coloring in htmlTable is unique in that it
follows the rgroups. The zebra striping is centered around the rgroup
although rows with no set rgroup, i.e. “” will have alternating colors
event though they programatically are within the same group:
Bundled with this package are some text formatting functions. The
purpose of these is to convert numeric values into character/text that
is more pleasent in publication tables.
txtRound
While base::round() is an excellent function in most
cases we often want a table to retain trailing 0:s. E.g.
While scientific format is useful if familiar with the syntax it can
be difficult to grasp for scholars with a less mathematical background.
Therefore the thousand separator style can be quite useful, also known
as digital
grouping:
txtInt(1e7)
## [1] "10,000,000"
As Swedish and many other languages rely on space (SI-standard) we
can specify language as a parameter. Note that as we don’t want to have
line breaks within a digit we can use non-breaking
space for keeping the number intact (the html-code is
):
txtInt(1e7, language ="SI", html =FALSE)
## [1] "10 000 000"
txtInt(1e7, language ="SI", html =TRUE)
## [1] "10 000 000"
Note that there are the option htmlTable.language and
htmlTable.html that you can use for the input of these
parameters.
txtPval
The p-value is perhaps the most controversial of statistical output,
nevertheless it is still needed and used correctly it has it’s use.
P-values are frequently rounded as the decimals are not as important.
The txtPval is a convenient function with some defaults
that correspond to typical uses in medical publications.
txtPval(c(0.1233213, 0.035, 0.001, 0.000001), html =FALSE)
## [1] "0.12" "0.035" "0.001" "< 0.0001"
# The < sign is less-than in html code '<'txtPval(c(0.05, 0.001, 0.000001), html =TRUE)
## [1] "0.050" "0.001" "< 0.0001"
txtMergeLines
In html we indicate new line using <br /> while the
latex style uses hbox. To help with these two there is the
txtMergeLines that merges lines into one properly formatted
unit:
txtMergeLines("Line 1","Line 2","Line 3")
Line 1 Line 2 Line 3
Note that you can also use a single multi-line string:
txtMergeLines("Line 1 Line 2 Line 3")
Line 1 Line 2 Line 3
txtMergeLines("Line 1 Line 2 Line 3",html =FALSE)
## [1] "\\vbox{\\hbox{\\strut Line 1}\\hbox{\\strut Line 2}\\hbox{\\strut Line 3}}"
htmlTable/inst/doc/general.Rmd 0000644 0001762 0000144 00000026133 13730477224 016007 0 ustar ligges users ---
title: "How-to use htmlTable"
author: "Max Gordon"
date: "`r Sys.Date()`"
output:
rmarkdown::html_vignette:
css: custom.css
keep_md: true
toc: true
vignette: >
%\VignetteIndexEntry{How-to use htmlTable}
%\VignetteEngine{knitr::rmarkdown}
%\usepackage[utf8]{inputenc}
---
Basics
======
The **htmlTable** package is intended for generating tables using [HTML](https://en.wikipedia.org/wiki/HTML) formatting. This format is compatible with [Markdown](https://rmarkdown.rstudio.com/) when used for HTML-output. The most basic table can easily be created by just passing a `matrix` or a `data.frame` to the `htmlTable`-function:
```{r}
library(htmlTable)
library(magrittr)
# A simple output
matrix(1:4,
ncol = 2,
dimnames = list(c("Row 1", "Row 2"),
c("Column 1", "Column 2"))) %>%
htmlTable
```
The function is also aware of the dimnames:
```{r}
# A simple output
matrix(1:4,
ncol = 2,
dimnames = list(rows = c("Row 1", "Row 2"),
cols = c("Column 1", "Column 2"))) %>%
htmlTable
```
This can be convenient when working with the `base::table` function:
```{r}
data("mtcars")
with(mtcars,
table(cyl, gear)) %>%
addmargins %>%
htmlTable
```
As of version 1.1 you **no longer need** to specify `results='asis'` for each `knitr` chunk.
**Tip**: If you are working a lot with `dplyr` and the `tidyverse` approach to exploring data you can make your life much easier using the `tidyHtmlTable()` function included in this package that automatically calculates the `rgroup`, `cgroup` and other parameters that make `htmlTable` so useful.
Table caption
-------------
The table caption is simply the table description and can be either located above or below:
```{r ctable_example}
output <- matrix(1:4,
ncol = 2,
dimnames = list(c("Row 1", "Row 2"),
c("Column 1", "Column 2")))
htmlTable(output,
ctable = c("solid", "double"),
caption = "A table caption above and ctable borders")
```
The caption defaults to above but by setting the `pos.caption` argument to "bottom" it appears below the table.
```{r table_with_caption_below}
output %>%
addHtmlTableStyle(pos.caption = "bottom") %>%
htmlTable(caption = "A table caption below")
```
Cell alignment
--------------
Cell alignment is specified through the `align`, `align.header`, `align.cgroup` arguments. For aligning the cell values just use `align`. The argument can accept either a vector or a string, although supplying it with a string is the simplest option as in the example below:
```{r}
1:3 %>%
addHtmlTableStyle(align = "lcr") %>%
htmlTable(rnames = "Row 1",
header = c("'l' = left", "'c' = center", "'r' = right"),
caption = "The alignment is set through the align options. Available alternatives are l, r, c as designated by the below table.")
```
Note that you can specify a string shorter than the number of columns. This can be useful if you have plenty of columns and you simply want all remaining columns to keep the alignment of the last column. To align the row name you can just add another letter to the string while the header is aligned through the `align.header` argument:
```{r}
1:3 %>%
addHtmlTableStyle(align = "clcr",
align.header = "lcr") %>%
htmlTable(rnames = "Row 1",
header = c("'l' = left", "'c' = center", "'r' = right"),
caption = "The alignment is set through the align options. Available alternatives are l, r, c as designated by the below table.")
```
Advanced
========
While it may be sufficient for basic tables a more advanced layout is often needed in medical articles with elements such as:
* row groups
* column spanners
* table spanners
* total row
* table footer
* zebra coloring (also known as *banding*):
+ rows
+ columns
As many journals require that a MS Word-document is submitted it is furthermore also important that the table imports correctly to a word processor, i.e. that the table also looks nice in the final document not only in the browser. The `htmlTable`-function is written for all these purposes.
For demonstration purposes we will setup a basic matrix:
```{r}
mx <- matrix(ncol = 6, nrow = 8)
rownames(mx) <- paste(c("1st", "2nd",
"3rd",
paste0(4:8, "th")),
"row")
colnames(mx) <- paste(c("1st", "2nd",
"3rd",
paste0(4:6, "th")),
"hdr")
for (nr in 1:nrow(mx)) {
for (nc in 1:ncol(mx)) {
mx[nr, nc] <-
paste0(nr, ":", nc)
}
}
```
Row groups
----------
The purpose of the row groups is to group variables that belong to the same group, e.g. a factored variable with more than two levels often benefit from grouping variables together.
```{r}
htmlTable(mx,
rgroup = paste("Group", LETTERS[1:3]),
n.rgroup = c(2,4,nrow(mx) - 6))
```
We can easily mix row groups with regular variables by having an empty row group name `""`:
```{r}
htmlTable(mx,
rgroup = c(paste("Group", LETTERS[1:2]), ""),
n.rgroup = c(2,4,nrow(mx) - 6))
```
When mixing row groups with variables without row groups we may want to omit the bold formatting of the row group label:
```{r}
mx %>%
addHtmlTableStyle(css.rgroup = "") %>%
htmlTable(rgroup = c(paste("Group", LETTERS[1:2]), ""),
n.rgroup = c(2,4,nrow(mx) - 6))
```
The `rgroup` is most commonly a single row without any additional cells but sometimes you may want to have a p-value or similar at the end of the row. This can be achieved by setting the 'add' attribute to the `rgroup`:
```{r}
rgroup <- c(paste("Group", LETTERS[1:2]), "")
attr(rgroup, "add") <- list(`2` = "More")
htmlTable(mx,
rgroup = rgroup,
n.rgroup = c(2,4,nrow(mx) - 6))
```
Column spanners
---------------
A column spanner spans 2 or more columns:
```{r}
htmlTable(mx,
cgroup = c("Cgroup 1", "Cgroup 2"),
n.cgroup = c(2,4))
```
It can sometimes be convenient to have column spanners in multiple levels:
```{r}
htmlTable(mx,
cgroup = rbind(c("", "Column spanners", NA),
c("", "Cgroup 1", "Cgroup 2")),
n.cgroup = rbind(c(1,2,NA),
c(2,2,2)))
```
Above example allows the column spanner to be a sum of the underlying cgroups (see n.cgroup), this is not required by the function and you can also provide a `list` with elements that allows you to skip the `NA` at the end of the matrix:
```{r}
htmlTable(mx,
cgroup = list(c("Super column spanner", ""),
c("", "Another cgroup"),
c("", "Cgroup 1", "Cgroup 2")),
n.cgroup = list(c(5,1),
c(1,2),
c(2,2,2)))
```
Table spanners
--------------
A table spanner is similar to rgroup but has the primary purpose of combining 2 or more tables with the same columns into one:
```{r}
htmlTable(mx,
tspanner = paste("Spanner", LETTERS[1:3]),
n.tspanner = c(2,4,nrow(mx) - 6))
```
Note that you actually don't need the last `n.tspanner`, i.e. you can simplify the above to:
```{r}
htmlTable(mx,
tspanner = paste("Spanner", LETTERS[1:3]),
n.tspanner = c(2,4))
```
Similarly you can use the number rgroups included in each tspanner instead of actual rows. This is convenient as the tspannners must align with underlying rgroups.
Total row
---------
Many financial tables use the concept of a total row at the end that sums the above elements:
```{r}
htmlTable(mx[1:3,], total = TRUE)
```
This can also be combined with table spanners:
```{r}
mx %>%
addHtmlTableStyle(css.total = c("border-top: 1px dashed grey;",
"border-top: 1px dashed grey;",
"border-top: 1px solid grey; font-weight: 900")) %>%
htmlTable(total = "tspanner",
tspanner = paste("Spanner", LETTERS[1:3]),
n.tspanner = c(2,4,nrow(mx) - 6))
```
Table numbering
---------------
The htmlTable has built-in numbering, initialized by:
```{r}
options(table_counter = TRUE)
```
```{r}
htmlTable(mx[1:2,1:2],
caption = "A table caption with a numbering")
```
As we often want to reference the table number in the text there are two associated functions:
```{r}
tblNoLast()
tblNoNext()
```
```{r}
htmlTable(mx[1:2,1:2],
caption = "Another table with numbering")
```
If you want to start the counter at 2 you can instead of setting table_counter to `TRUE` set it to 1. Note that you need to set the value to one less as each time the table is called the counter is incremented by one. You can also turn off the feature by:
```{r}
options(table_counter = FALSE)
```
Table footer
------------
The footer usually contains specifics regarding variables and is always located at the foot of the table:
```{r}
htmlTable(mx[1:2,1:2],
tfoot = "A table footer")
```
Zebra coloring (or banded colors)
------------------------------------
Zebra coloring is also know as an alternating color pattern or row shading. It is most commonly applied to rows:
```{r}
mx %>%
addHtmlTableStyle(col.rgroup = c("none", "#F7F7F7")) %>%
htmlTable
```
The zebra coloring in `htmlTable` is unique in that it follows the rgroups. The zebra striping is centered around the rgroup although rows with no set rgroup, i.e. "" will have alternating colors event though they programatically are within the same group:
```{r}
mx %>%
addHtmlTableStyle(col.rgroup = c("none", "#F7F7F7")) %>%
htmlTable(rgroup = c(paste("Group", LETTERS[1:2]), ""),
n.rgroup = c(2,2,nrow(mx) - 4))
```
We can also color the columns:
```{r}
mx %>%
addHtmlTableStyle(col.columns = c("none", "#F7F7F7")) %>%
htmlTable
```
Or do both (note that the colors blend at the intersections):
```{r}
mx %>%
addHtmlTableStyle(col.rgroup = c("none", "#F9FAF0"),
col.columns = c("none", "#F1F0FA")) %>%
htmlTable
```
Putting it all together
-----------------------
Now if we want to do everything in one table it may look like this:
```{r}
rgroup = paste("Group", LETTERS[1:3])
attr(rgroup, "add") <- list(`3` = "Group p-value < 0.001")
mx %>%
addHtmlTableStyle(align = "rr|r",
align.header = "cc|c",
spacer.celltype = "double_cell",
col.columns = c(rep("none", 2),
rep("#F5FBFF", 4)),
col.rgroup = c("none", "#F7F7F7"),
css.cell = "padding-left: .5em; padding-right: .2em;",
css.header = "font-weight: normal") %>%
htmlTable(rgroup = rgroup,
n.rgroup = c(2,4),
tspanner = paste("Spanner", LETTERS[1:2]),
n.tspanner = c(1),
cgroup = list(c("", "Column spanners"),
c("", "Cgroup 1", "Cgroup 2†")),
n.cgroup = list(c(1,5),
c(2,2,2)),
caption = "A table with column spanners, row groups, and zebra striping",
tfoot = "† A table footer commment",
cspan.rgroup = 2)
```
htmlTable/inst/doc/complex_tables.Rmd 0000644 0001762 0000144 00000027611 14517434555 017401 0 ustar ligges users ---
title: "Building a complex table"
author: "Max Gordon"
date: "`r Sys.Date()`"
output:
rmarkdown::html_vignette:
toc: true
css: custom.css
vignette: >
%\VignetteIndexEntry{Building a complex table}
%\VignetteEngine{knitr::rmarkdown}
%\usepackage[utf8]{inputenc}
---
# Introduction
Tables are an essential part of publishing, well... anything. I therefore want to explore the options available for generating these in knitr. It is important to remember that there are two ways of generating tables in markdown:
1. Markdown tables
2. HTML tables
As the `htmlTable`-package is all about [HTML](https://en.wikipedia.org/wiki/HTML) tables we will work only with that output option. The core idea is that HTML is ubiquitous and that most word-processors will have to support copy-pasting tables and by providing simple simple CSS-formatting we are able to maximize this compatibility. _Note_ CSS is today an extremely complex topic and it is no surprise that word-processors may have difficulty importing tables that have lots of advanced syntax, htmlTable tries to avoid all of that by putting the style close to each element, often at the cell-level.
# Basics
I developed the `htmlTable` in order to get tables matching those available in top medical journals. After finding no HTML-alternative to the `Hmisc::latex` function on [Stack Overflow](https://stackoverflow.com/questions/11950703/html-with-multicolumn-table-in-markdown-using-knitr) I wrote a basic function allowing column spanners and row groups. Below is a basic example on these two:
```{r}
library(htmlTable)
setHtmlTableTheme(theme = "Google docs")
output <-
matrix(paste("Content", LETTERS[1:16]),
ncol = 4, byrow = TRUE)
output |>
htmlTable(header = paste(c("1st", "2nd", "3rd", "4th"), "header"),
rnames = paste(c("1st", "2nd", "3rd", "4th"), "row"),
rgroup = c("Group A", "Group B"),
n.rgroup = c(2, 2),
cgroup = c("Cgroup 1", "Cgroup 2†"),
n.cgroup = c(2, 2),
caption = "Basic table with both column spanners (groups) and row groups",
tfoot = "† A table footer commment")
```
We can modify all our tables by using the `setHtmlTableTemplate()` and we also don't have to set the exact span of each group as it can be assumed from the data.
```{r}
setHtmlTableTheme(pos.caption = "bottom")
output |>
addHtmlTableStyle(css.rgroup = "font-style: italic") |>
htmlTable(header = paste(c("1st", "2nd", "3rd", "4th"), "header"),
rnames = paste(c("1st", "2nd", "3rd", "4th"), "row"),
rgroup = c("Group A", "Group B", ""),
n.rgroup = c(1, 2),
cgroup = c("Cgroup 1", "Cgroup 2†"),
n.cgroup = 3,
caption = "A slightly differnt table with a bottom caption",
tfoot = "† A table footer commment")
```
The basic principles are:
- use the `|>` pipe as much as possible
- build complexity stepwise through passing `addHtmlTableStyle()` function
- keep arguments to a minimum through templating and autocalculation
# Example based upon Swedish statistics
In order to make a more interesting example we will try to look at how the average age changes between Swedish counties the last 15 years. **Goal: visualize migration patterns**.
The dataset has been downloaded from Statistics Sweden and is attached to the htmlTable-package. We will start by reshaping our tidy dataset into a more table adapted format.
```{r, results='markup', message=FALSE, warning=FALSE}
data(SCB)
# The SCB has three other columns and one value column
prepped_scb <- SCB |>
dplyr::mutate(region = relevel(SCB$region, "Sweden")) |>
dplyr::select(year, region, sex, values) |>
tidyr::pivot_wider(names_from = c(region, sex), values_from = values)
# Set rownames to be year
rownames(prepped_scb) <- prepped_scb$year
prepped_scb$year <- NULL
# The dataset now has the rows
names(prepped_scb)
# and the dimensions
dim(prepped_scb)
```
The next step is to calculate two new columns:
- Δint = The change within each group since the start of the observation.
- Δstd = The change in relation to the overall age change in Sweden.
To convey all these layers of information will create a table with multiple levels of column spanners:
County
Men
Women
Age
Δint.
Δext.
Age
Δint.
Δext.
```{r}
mx <- NULL
for (n in names(prepped_scb)) {
tmp <- paste0("Sweden_", strsplit(n, "_")[[1]][2])
mx <- cbind(mx,
cbind(prepped_scb[[n]],
prepped_scb[[n]] - prepped_scb[[n]][1],
prepped_scb[[n]] - prepped_scb[[tmp]]))
}
rownames(mx) <- rownames(prepped_scb)
colnames(mx) <- rep(c("Age",
"Δint",
"Δstd"),
times = ncol(prepped_scb))
mx <- mx[,c(-3, -6)]
# This automated generation of cgroup elements is
# somewhat of an overkill
cgroup <-
unique(sapply(names(prepped_scb),
function(x) strsplit(x, "_")[[1]][1],
USE.NAMES = FALSE))
n.cgroup <-
sapply(cgroup,
function(x) sum(grepl(paste0("^", x), names(prepped_scb))),
USE.NAMES = FALSE)*3
n.cgroup[cgroup == "Sweden"] <-
n.cgroup[cgroup == "Sweden"] - 2
cgroup <-
rbind(c(cgroup, rep(NA, ncol(prepped_scb) - length(cgroup))),
Hmisc::capitalize(
sapply(names(prepped_scb),
function(x) strsplit(x, "_")[[1]][2],
USE.NAMES = FALSE)))
n.cgroup <-
rbind(c(n.cgroup, rep(NA, ncol(prepped_scb) - length(n.cgroup))),
c(2,2, rep(3, ncol(cgroup) - 2)))
print(cgroup)
print(n.cgroup)
```
Next step is to output the table after rounding to the correct number of decimals. The `txtRound` function helps with this, as it uses the `sprintf` function instead of the `round` the resulting strings have the correct number of decimals, i.e. 1.02 will by round become 1 while we want it to retain the last decimal, i.e. be shown as 1.0.
```{r}
htmlTable(txtRound(mx, 1),
cgroup = cgroup,
n.cgroup = n.cgroup,
rgroup = c("First period",
"Second period",
"Third period"),
n.rgroup = rep(5, 3),
tfoot = txtMergeLines("Δint correspnds to the change since start",
"Δstd corresponds to the change compared to national average"))
```
In order to increase the readability we may want to separate the Sweden columns from the county columns, one way is to use the align option with a |. Note that in 1.0 the function continues with the same alignment until the end, i.e. you no longer need count to have the exact right number of columns in your alignment argument.
```{r}
mx |>
txtRound(digits = 1) |>
addHtmlTableStyle(align = "rrrr|r",
spacer.celltype = "double_cell") |>
htmlTable(cgroup = cgroup,
n.cgroup = n.cgroup,
rgroup = c("First period",
"Second period",
"Third period"),
n.rgroup = rep(5, 3),
tfoot = txtMergeLines("Δint correspnds to the change since start",
"Δstd corresponds to the change compared to national average"))
```
If we still feel that we want more separation it is always possible to add colors.
```{r}
mx |>
txtRound(digits = 1) |>
addHtmlTableStyle(align = "rrrr|r",
align.header = "c",
col.columns = c(rep("#E6E6F0", 4),
rep("none", ncol(mx) - 4))) |>
htmlTable(cgroup = cgroup,
n.cgroup = n.cgroup,
rgroup = c("First period",
"Second period",
"Third period"),
n.rgroup = rep(5, 3),
tfoot = txtMergeLines("Δint correspnds to the change since start",
"Δstd corresponds to the change compared to national average"))
```
If we add a color to the row group and restrict the rgroup spanner we may even have a more visual aid.
```{r}
mx |>
txtRound(digits = 1) |>
addHtmlTableStyle(align = "rrrr|r",
align.header = "c",
col.columns = c(rep("#E6E6F0", 4),
rep("none", ncol(mx) - 4)),
col.rgroup = c("none", "#FFFFCC")) |>
htmlTable(cgroup = cgroup,
n.cgroup = n.cgroup,
# I use the - the no breaking space as I don't want to have a
# row break in the row group. This adds a little space in the table
# when used together with the cspan.rgroup=1.
rgroup = c("1st period",
"2nd period",
"3rd period"),
n.rgroup = rep(5, 3),
tfoot = txtMergeLines("Δint correspnds to the change since start",
"Δstd corresponds to the change compared to national average"),
cspan.rgroup = 1)
```
If you want to further add to the visual hints you can use specific HTML-code and insert it into the cells. Here we will color the Δstd according to color. By default htmlTable does not escape HTML characters.
```{r}
cols_2_clr <- grep("Δstd", colnames(mx))
# We need a copy as the formatting causes the matrix to loos
# its numerical property
out_mx <- txtRound(mx, 1)
min_delta <- min(mx[,cols_2_clr])
span_delta <- max(mx[,cols_2_clr]) - min(mx[,cols_2_clr])
for (col in cols_2_clr) {
out_mx[, col] <- mapply(function(val, strength)
paste0("",
val, ""),
val = out_mx[,col],
strength = round((mx[,col] - min_delta)/span_delta*100 + 1),
USE.NAMES = FALSE)
}
out_mx |>
addHtmlTableStyle(align = "rrrr|r",
align.header = "cccc|c",
pos.rowlabel = "bottom",
col.rgroup = c("none", "#FFFFCC"),
col.columns = c(rep("#EFEFF0", 4),
rep("none", ncol(mx) - 4))) |>
htmlTable(caption = "Average age in Sweden counties over a period of
15 years. The Norbotten county is typically known
for having a negative migration pattern compared to
Stockholm, while Uppsala has a proportionally large
population of students.",
rowlabel = "Year",
cgroup = cgroup,
n.cgroup = n.cgroup,
rgroup = c("1st period",
"2nd period",
"3rd period"),
n.rgroup = rep(5, 3),
tfoot = txtMergeLines("Δint corresponds to the change since start",
"Δstd corresponds to the change compared to national average"),
cspan.rgroup = 1)
```
Although a graph most likely does the visualization task better, tables are good at conveying detailed information. It is in my mind without doubt easier in the latest version to find the pattern in the data.
Lastly I would like to thank [Stephen Few](https://www.amazon.com/Show-Me-Numbers-Designing-Enlighten/dp/0970601999), [ThinkUI](http://www.thinkui.co.uk/resources/effective-design-of-data-tables/), and [LabWrite](https://labwrite.ncsu.edu/res/gh/gh-tables.html) for inspiration.
htmlTable/inst/doc/text_formatters.Rmd 0000644 0001762 0000144 00000011145 14165130172 017610 0 ustar ligges users ---
title: "Text formatters"
author: "Max Gordon"
date: "`r Sys.Date()`"
VignetteBuilder: knitr, rmarkdown
output:
rmarkdown::html_vignette:
css: custom.css
keep_md: true
toc: true
vignette: >
%\VignetteIndexEntry{Text formatters}
%\usepackage[utf8]{inputenc}
%\VignetteEngine{knitr::rmarkdown}
editor_options:
chunk_output_type: inline
---
Text formatters
===============
Bundled with this package are some text formatting functions. The purpose of these is to convert numeric values into character/text that is more pleasent in publication tables.
txtRound
--------
While `base::round()` is an excellent function in most cases we often want a table to retain trailing 0:s. E.g.
```{r message=FALSE}
library(htmlTable)
library(dplyr)
library(magrittr)
data("mtcars")
mtcars %<>%
mutate(am = factor(am, levels = 0:1, labels = c("Automatic", "Manual")),
vs = factor(vs, levels = 0:1, labels = c("V-shaped", "straight")))
mtcars %>%
head(3) %>%
select(Transmission = am, Gas = mpg, Weight = wt) %>%
htmlTable()
```
doesn't look visually that great, instead we would prefer to have something like this:
```{r}
mtcars %>%
head(3) %>%
select(Transmission = am, Gas = mpg, Weight = wt) %>%
txtRound(digits = 1) %>%
htmlTable()
```
### Single/vector values
At the core of the `txtRound` is the single/vector value conversion:
```{r}
txtRound(c(1, 1.1034), digits = 2)
# Use a character to convert
txtRound("1.2333", digits = 2)
```
If you have some values that need thousand separation you can also add `txtInt_args`.
```{r}
# Large numbers can be combined with the txtInt option
txtRound(12345.12, digits = 1, txtInt_args = TRUE)
txtRound(12345.12, digits = 1, txtInt_args = list(language = "se", html = FALSE))
```
### Data frames
As seen in the introduction we can use data frames for input. We can here rename the converted columns:
```{r}
mtcars %>%
head(3) %>%
select(mpg, wt) %>%
txtRound(mpg, wt_txt = wt, digits = 1)
```
And we can specify the number of decimals that we're interested in per column:
```{r}
mtcars %>%
head(3) %>%
select(mpg, qsec, wt) %>%
txtRound(digits = list(wt = 2, .default = 1))
```
### Matrix
We can also feed a matrix into the `txtRound`:
```{r}
mtcars_matrix <- mtcars %>%
select(mpg, qsec, wt) %>%
head(3) %>%
as.matrix()
mtcars_matrix %>%
txtRound(digits = 1)
```
Here we have some options of excluding columns/rows using regular expressions:
```{r}
mtcars_matrix %>%
txtRound(excl.cols = "^wt$",
excl.rows = "^Mazda RX4$",
digits = 1)
```
Similarly to the data.frame we can use the same syntax to pick column specific digits:
```{r}
mtcars_matrix %>%
txtRound(digits = list(mpg = 0, wt = 2, .default = 1))
```
txtInt
------
While scientific format is useful if familiar with the syntax it can be difficult to grasp for scholars with a less mathematical background. Therefore the thousand separator style can be quite useful, also known as [digital grouping](https://en.wikipedia.org/wiki/Decimal_separator#Digit_grouping):
```{r}
txtInt(1e7)
```
As Swedish and many other languages rely on space (SI-standard) we can specify language as a parameter. Note that as we don't want to have line breaks within a digit we can use [non-breaking space](https://en.wikipedia.org/wiki/Non-breaking_space) for keeping the number intact (the html-code is ` `):
```{r}
txtInt(1e7, language = "SI", html = FALSE)
txtInt(1e7, language = "SI", html = TRUE)
```
Note that there are the option `htmlTable.language` and `htmlTable.html` that you can use for the input of these parameters.
txtPval
-------
The p-value is perhaps the most controversial of statistical output, nevertheless it is still needed and used correctly it has it's use. P-values are frequently rounded as the decimals are not as important. The `txtPval` is a convenient function with some defaults that correspond to typical uses in medical publications.
```{r}
txtPval(c(0.1233213, 0.035, 0.001, 0.000001), html = FALSE)
# The < sign is less-than in html code '<'
txtPval(c(0.05, 0.001, 0.000001), html = TRUE)
```
txtMergeLines
-------------
In html we indicate new line using *<br />* while the latex style uses *hbox*. To help with these two there is the `txtMergeLines` that merges lines into one properly formatted unit:
```{r}
txtMergeLines("Line 1",
"Line 2",
"Line 3")
```
Note that you can also use a single multi-line string:
```{r}
txtMergeLines("Line 1
Line 2
Line 3")
```
```{r}
txtMergeLines("Line 1
Line 2
Line 3",
html = FALSE)
```
htmlTable/inst/javascript/ 0000755 0001762 0000144 00000000000 13407215301 015305 5 ustar ligges users htmlTable/inst/javascript/toggler.js 0000644 0001762 0000144 00000002371 13407215301 017311 0 ustar ligges users $(document).ready(function(){
$(".gmisc_table td .hidden").map(function(index, el){
el.parentNode.style["original-color"] = el.parentNode.style["background-color"];
el.parentNode.style["background-color"] = "#DDD";
});
getSelected = function(){
var t = '';
if(window.getSelection){
t = window.getSelection();
}else if(document.getSelection){
t = document.getSelection();
}else if(document.selection){
t = document.selection.createRange().text;
}
return t.toString();
};
$(".gmisc_table td").map(function(index, el){
this.style.cursor = "pointer";
el.onmouseup = function(e){
if (getSelected().length > 0)
return;
var hidden = this.getElementsByClassName("hidden");
if (hidden.length > 0){
this.innerHTML = hidden[0].textContent;
this.style["background-color"] = this.style["original-color"];
}else{
$(this).append("" +
this.innerHTML + "");
this.childNodes[0].data = this.childNodes[0].data.substr(0, 20) + "... ";
this.style["original-color"] = this.style["background-color"];
this.style["background-color"] = "#DDD";
}
};
});
});
htmlTable/inst/javascript/button.js 0000644 0001762 0000144 00000001556 13407215301 017165 0 ustar ligges users $(document).ready(function(){
// Placeholder for button
btn = "%btn%";
// Ad the button to each element
$(".gmisc_table td").map(function(index, el){
if (el.innerHTML.length > %txt.maxlen% && el.getElementsByClassName("btn").length == 0)
el.innerHTML += btn;
})
$(".gmisc_table td .btn").map(function(index, el){
el.onclick = function(e){
var hidden = this.parentNode.getElementsByClassName("hidden");
if (this.textContent === "+"){
this.parentNode.childNodes[0].data = hidden[0].textContent;
this.textContent = "-";
}else{
$(this.parentNode).append("" + this.parentNode.childNodes[0].data + "")
this.parentNode.childNodes[0].data = this.parentNode.textContent.substr(0, %txt.maxlen%) + "... ";
this.textContent = "+";
}
}
})
})
htmlTable/inst/htmlwidgets/ 0000755 0001762 0000144 00000000000 14261642754 015511 5 ustar ligges users htmlTable/inst/htmlwidgets/lib/ 0000755 0001762 0000144 00000000000 13407215301 016240 5 ustar ligges users htmlTable/inst/htmlwidgets/lib/jquery/ 0000755 0001762 0000144 00000000000 14517434555 017600 5 ustar ligges users htmlTable/inst/htmlwidgets/lib/jquery/jquery.min.js 0000644 0001762 0000144 00000252755 14517434555 022257 0 ustar ligges users /*! jQuery v3.7.1 | (c) OpenJS Foundation and other contributors | jquery.org/license */
!function(e,t){"use strict";"object"==typeof module&&"object"==typeof module.exports?module.exports=e.document?t(e,!0):function(e){if(!e.document)throw new Error("jQuery requires a window with a document");return t(e)}:t(e)}("undefined"!=typeof window?window:this,function(ie,e){"use strict";var oe=[],r=Object.getPrototypeOf,ae=oe.slice,g=oe.flat?function(e){return oe.flat.call(e)}:function(e){return oe.concat.apply([],e)},s=oe.push,se=oe.indexOf,n={},i=n.toString,ue=n.hasOwnProperty,o=ue.toString,a=o.call(Object),le={},v=function(e){return"function"==typeof e&&"number"!=typeof e.nodeType&&"function"!=typeof e.item},y=function(e){return null!=e&&e===e.window},C=ie.document,u={type:!0,src:!0,nonce:!0,noModule:!0};function m(e,t,n){var r,i,o=(n=n||C).createElement("script");if(o.text=e,t)for(r in u)(i=t[r]||t.getAttribute&&t.getAttribute(r))&&o.setAttribute(r,i);n.head.appendChild(o).parentNode.removeChild(o)}function x(e){return null==e?e+"":"object"==typeof e||"function"==typeof e?n[i.call(e)]||"object":typeof e}var t="3.7.1",l=/HTML$/i,ce=function(e,t){return new ce.fn.init(e,t)};function c(e){var t=!!e&&"length"in e&&e.length,n=x(e);return!v(e)&&!y(e)&&("array"===n||0===t||"number"==typeof t&&0+~]|"+ge+")"+ge+"*"),x=new RegExp(ge+"|>"),j=new RegExp(g),A=new RegExp("^"+t+"$"),D={ID:new RegExp("^#("+t+")"),CLASS:new RegExp("^\\.("+t+")"),TAG:new RegExp("^("+t+"|[*])"),ATTR:new RegExp("^"+p),PSEUDO:new RegExp("^"+g),CHILD:new RegExp("^:(only|first|last|nth|nth-last)-(child|of-type)(?:\\("+ge+"*(even|odd|(([+-]|)(\\d*)n|)"+ge+"*(?:([+-]|)"+ge+"*(\\d+)|))"+ge+"*\\)|)","i"),bool:new RegExp("^(?:"+f+")$","i"),needsContext:new RegExp("^"+ge+"*[>+~]|:(even|odd|eq|gt|lt|nth|first|last)(?:\\("+ge+"*((?:-\\d)?\\d*)"+ge+"*\\)|)(?=[^-]|$)","i")},N=/^(?:input|select|textarea|button)$/i,q=/^h\d$/i,L=/^(?:#([\w-]+)|(\w+)|\.([\w-]+))$/,H=/[+~]/,O=new RegExp("\\\\[\\da-fA-F]{1,6}"+ge+"?|\\\\([^\\r\\n\\f])","g"),P=function(e,t){var n="0x"+e.slice(1)-65536;return t||(n<0?String.fromCharCode(n+65536):String.fromCharCode(n>>10|55296,1023&n|56320))},M=function(){V()},R=J(function(e){return!0===e.disabled&&fe(e,"fieldset")},{dir:"parentNode",next:"legend"});try{k.apply(oe=ae.call(ye.childNodes),ye.childNodes),oe[ye.childNodes.length].nodeType}catch(e){k={apply:function(e,t){me.apply(e,ae.call(t))},call:function(e){me.apply(e,ae.call(arguments,1))}}}function I(t,e,n,r){var i,o,a,s,u,l,c,f=e&&e.ownerDocument,p=e?e.nodeType:9;if(n=n||[],"string"!=typeof t||!t||1!==p&&9!==p&&11!==p)return n;if(!r&&(V(e),e=e||T,C)){if(11!==p&&(u=L.exec(t)))if(i=u[1]){if(9===p){if(!(a=e.getElementById(i)))return n;if(a.id===i)return k.call(n,a),n}else if(f&&(a=f.getElementById(i))&&I.contains(e,a)&&a.id===i)return k.call(n,a),n}else{if(u[2])return k.apply(n,e.getElementsByTagName(t)),n;if((i=u[3])&&e.getElementsByClassName)return k.apply(n,e.getElementsByClassName(i)),n}if(!(h[t+" "]||d&&d.test(t))){if(c=t,f=e,1===p&&(x.test(t)||m.test(t))){(f=H.test(t)&&U(e.parentNode)||e)==e&&le.scope||((s=e.getAttribute("id"))?s=ce.escapeSelector(s):e.setAttribute("id",s=S)),o=(l=Y(t)).length;while(o--)l[o]=(s?"#"+s:":scope")+" "+Q(l[o]);c=l.join(",")}try{return k.apply(n,f.querySelectorAll(c)),n}catch(e){h(t,!0)}finally{s===S&&e.removeAttribute("id")}}}return re(t.replace(ve,"$1"),e,n,r)}function W(){var r=[];return function e(t,n){return r.push(t+" ")>b.cacheLength&&delete e[r.shift()],e[t+" "]=n}}function F(e){return e[S]=!0,e}function $(e){var t=T.createElement("fieldset");try{return!!e(t)}catch(e){return!1}finally{t.parentNode&&t.parentNode.removeChild(t),t=null}}function B(t){return function(e){return fe(e,"input")&&e.type===t}}function _(t){return function(e){return(fe(e,"input")||fe(e,"button"))&&e.type===t}}function z(t){return function(e){return"form"in e?e.parentNode&&!1===e.disabled?"label"in e?"label"in e.parentNode?e.parentNode.disabled===t:e.disabled===t:e.isDisabled===t||e.isDisabled!==!t&&R(e)===t:e.disabled===t:"label"in e&&e.disabled===t}}function X(a){return F(function(o){return o=+o,F(function(e,t){var n,r=a([],e.length,o),i=r.length;while(i--)e[n=r[i]]&&(e[n]=!(t[n]=e[n]))})})}function U(e){return e&&"undefined"!=typeof e.getElementsByTagName&&e}function V(e){var t,n=e?e.ownerDocument||e:ye;return n!=T&&9===n.nodeType&&n.documentElement&&(r=(T=n).documentElement,C=!ce.isXMLDoc(T),i=r.matches||r.webkitMatchesSelector||r.msMatchesSelector,r.msMatchesSelector&&ye!=T&&(t=T.defaultView)&&t.top!==t&&t.addEventListener("unload",M),le.getById=$(function(e){return r.appendChild(e).id=ce.expando,!T.getElementsByName||!T.getElementsByName(ce.expando).length}),le.disconnectedMatch=$(function(e){return i.call(e,"*")}),le.scope=$(function(){return T.querySelectorAll(":scope")}),le.cssHas=$(function(){try{return T.querySelector(":has(*,:jqfake)"),!1}catch(e){return!0}}),le.getById?(b.filter.ID=function(e){var t=e.replace(O,P);return function(e){return e.getAttribute("id")===t}},b.find.ID=function(e,t){if("undefined"!=typeof t.getElementById&&C){var n=t.getElementById(e);return n?[n]:[]}}):(b.filter.ID=function(e){var n=e.replace(O,P);return function(e){var t="undefined"!=typeof e.getAttributeNode&&e.getAttributeNode("id");return t&&t.value===n}},b.find.ID=function(e,t){if("undefined"!=typeof t.getElementById&&C){var n,r,i,o=t.getElementById(e);if(o){if((n=o.getAttributeNode("id"))&&n.value===e)return[o];i=t.getElementsByName(e),r=0;while(o=i[r++])if((n=o.getAttributeNode("id"))&&n.value===e)return[o]}return[]}}),b.find.TAG=function(e,t){return"undefined"!=typeof t.getElementsByTagName?t.getElementsByTagName(e):t.querySelectorAll(e)},b.find.CLASS=function(e,t){if("undefined"!=typeof t.getElementsByClassName&&C)return t.getElementsByClassName(e)},d=[],$(function(e){var t;r.appendChild(e).innerHTML="",e.querySelectorAll("[selected]").length||d.push("\\["+ge+"*(?:value|"+f+")"),e.querySelectorAll("[id~="+S+"-]").length||d.push("~="),e.querySelectorAll("a#"+S+"+*").length||d.push(".#.+[+~]"),e.querySelectorAll(":checked").length||d.push(":checked"),(t=T.createElement("input")).setAttribute("type","hidden"),e.appendChild(t).setAttribute("name","D"),r.appendChild(e).disabled=!0,2!==e.querySelectorAll(":disabled").length&&d.push(":enabled",":disabled"),(t=T.createElement("input")).setAttribute("name",""),e.appendChild(t),e.querySelectorAll("[name='']").length||d.push("\\["+ge+"*name"+ge+"*="+ge+"*(?:''|\"\")")}),le.cssHas||d.push(":has"),d=d.length&&new RegExp(d.join("|")),l=function(e,t){if(e===t)return a=!0,0;var n=!e.compareDocumentPosition-!t.compareDocumentPosition;return n||(1&(n=(e.ownerDocument||e)==(t.ownerDocument||t)?e.compareDocumentPosition(t):1)||!le.sortDetached&&t.compareDocumentPosition(e)===n?e===T||e.ownerDocument==ye&&I.contains(ye,e)?-1:t===T||t.ownerDocument==ye&&I.contains(ye,t)?1:o?se.call(o,e)-se.call(o,t):0:4&n?-1:1)}),T}for(e in I.matches=function(e,t){return I(e,null,null,t)},I.matchesSelector=function(e,t){if(V(e),C&&!h[t+" "]&&(!d||!d.test(t)))try{var n=i.call(e,t);if(n||le.disconnectedMatch||e.document&&11!==e.document.nodeType)return n}catch(e){h(t,!0)}return 0":{dir:"parentNode",first:!0}," ":{dir:"parentNode"},"+":{dir:"previousSibling",first:!0},"~":{dir:"previousSibling"}},preFilter:{ATTR:function(e){return e[1]=e[1].replace(O,P),e[3]=(e[3]||e[4]||e[5]||"").replace(O,P),"~="===e[2]&&(e[3]=" "+e[3]+" "),e.slice(0,4)},CHILD:function(e){return e[1]=e[1].toLowerCase(),"nth"===e[1].slice(0,3)?(e[3]||I.error(e[0]),e[4]=+(e[4]?e[5]+(e[6]||1):2*("even"===e[3]||"odd"===e[3])),e[5]=+(e[7]+e[8]||"odd"===e[3])):e[3]&&I.error(e[0]),e},PSEUDO:function(e){var t,n=!e[6]&&e[2];return D.CHILD.test(e[0])?null:(e[3]?e[2]=e[4]||e[5]||"":n&&j.test(n)&&(t=Y(n,!0))&&(t=n.indexOf(")",n.length-t)-n.length)&&(e[0]=e[0].slice(0,t),e[2]=n.slice(0,t)),e.slice(0,3))}},filter:{TAG:function(e){var t=e.replace(O,P).toLowerCase();return"*"===e?function(){return!0}:function(e){return fe(e,t)}},CLASS:function(e){var t=s[e+" "];return t||(t=new RegExp("(^|"+ge+")"+e+"("+ge+"|$)"))&&s(e,function(e){return t.test("string"==typeof e.className&&e.className||"undefined"!=typeof e.getAttribute&&e.getAttribute("class")||"")})},ATTR:function(n,r,i){return function(e){var t=I.attr(e,n);return null==t?"!="===r:!r||(t+="","="===r?t===i:"!="===r?t!==i:"^="===r?i&&0===t.indexOf(i):"*="===r?i&&-1:\x20\t\r\n\f]*)[\x20\t\r\n\f]*\/?>(?:<\/\1>|)$/i;function T(e,n,r){return v(n)?ce.grep(e,function(e,t){return!!n.call(e,t,e)!==r}):n.nodeType?ce.grep(e,function(e){return e===n!==r}):"string"!=typeof n?ce.grep(e,function(e){return-1)[^>]*|#([\w-]+))$/;(ce.fn.init=function(e,t,n){var r,i;if(!e)return this;if(n=n||k,"string"==typeof e){if(!(r="<"===e[0]&&">"===e[e.length-1]&&3<=e.length?[null,e,null]:S.exec(e))||!r[1]&&t)return!t||t.jquery?(t||n).find(e):this.constructor(t).find(e);if(r[1]){if(t=t instanceof ce?t[0]:t,ce.merge(this,ce.parseHTML(r[1],t&&t.nodeType?t.ownerDocument||t:C,!0)),w.test(r[1])&&ce.isPlainObject(t))for(r in t)v(this[r])?this[r](t[r]):this.attr(r,t[r]);return this}return(i=C.getElementById(r[2]))&&(this[0]=i,this.length=1),this}return e.nodeType?(this[0]=e,this.length=1,this):v(e)?void 0!==n.ready?n.ready(e):e(ce):ce.makeArray(e,this)}).prototype=ce.fn,k=ce(C);var E=/^(?:parents|prev(?:Until|All))/,j={children:!0,contents:!0,next:!0,prev:!0};function A(e,t){while((e=e[t])&&1!==e.nodeType);return e}ce.fn.extend({has:function(e){var t=ce(e,this),n=t.length;return this.filter(function(){for(var e=0;e\x20\t\r\n\f]*)/i,Ce=/^$|^module$|\/(?:java|ecma)script/i;xe=C.createDocumentFragment().appendChild(C.createElement("div")),(be=C.createElement("input")).setAttribute("type","radio"),be.setAttribute("checked","checked"),be.setAttribute("name","t"),xe.appendChild(be),le.checkClone=xe.cloneNode(!0).cloneNode(!0).lastChild.checked,xe.innerHTML="",le.noCloneChecked=!!xe.cloneNode(!0).lastChild.defaultValue,xe.innerHTML="",le.option=!!xe.lastChild;var ke={thead:[1,"
","
"],col:[2,"
","
"],tr:[2,"
","
"],td:[3,"
","
"],_default:[0,"",""]};function Se(e,t){var n;return n="undefined"!=typeof e.getElementsByTagName?e.getElementsByTagName(t||"*"):"undefined"!=typeof e.querySelectorAll?e.querySelectorAll(t||"*"):[],void 0===t||t&&fe(e,t)?ce.merge([e],n):n}function Ee(e,t){for(var n=0,r=e.length;n",""]);var je=/<|&#?\w+;/;function Ae(e,t,n,r,i){for(var o,a,s,u,l,c,f=t.createDocumentFragment(),p=[],d=0,h=e.length;d\s*$/g;function Re(e,t){return fe(e,"table")&&fe(11!==t.nodeType?t:t.firstChild,"tr")&&ce(e).children("tbody")[0]||e}function Ie(e){return e.type=(null!==e.getAttribute("type"))+"/"+e.type,e}function We(e){return"true/"===(e.type||"").slice(0,5)?e.type=e.type.slice(5):e.removeAttribute("type"),e}function Fe(e,t){var n,r,i,o,a,s;if(1===t.nodeType){if(_.hasData(e)&&(s=_.get(e).events))for(i in _.remove(t,"handle events"),s)for(n=0,r=s[i].length;n").attr(n.scriptAttrs||{}).prop({charset:n.scriptCharset,src:n.url}).on("load error",i=function(e){r.remove(),i=null,e&&t("error"===e.type?404:200,e.type)}),C.head.appendChild(r[0])},abort:function(){i&&i()}}});var Jt,Kt=[],Zt=/(=)\?(?=&|$)|\?\?/;ce.ajaxSetup({jsonp:"callback",jsonpCallback:function(){var e=Kt.pop()||ce.expando+"_"+jt.guid++;return this[e]=!0,e}}),ce.ajaxPrefilter("json jsonp",function(e,t,n){var r,i,o,a=!1!==e.jsonp&&(Zt.test(e.url)?"url":"string"==typeof e.data&&0===(e.contentType||"").indexOf("application/x-www-form-urlencoded")&&Zt.test(e.data)&&"data");if(a||"jsonp"===e.dataTypes[0])return r=e.jsonpCallback=v(e.jsonpCallback)?e.jsonpCallback():e.jsonpCallback,a?e[a]=e[a].replace(Zt,"$1"+r):!1!==e.jsonp&&(e.url+=(At.test(e.url)?"&":"?")+e.jsonp+"="+r),e.converters["script json"]=function(){return o||ce.error(r+" was not called"),o[0]},e.dataTypes[0]="json",i=ie[r],ie[r]=function(){o=arguments},n.always(function(){void 0===i?ce(ie).removeProp(r):ie[r]=i,e[r]&&(e.jsonpCallback=t.jsonpCallback,Kt.push(r)),o&&v(i)&&i(o[0]),o=i=void 0}),"script"}),le.createHTMLDocument=((Jt=C.implementation.createHTMLDocument("").body).innerHTML="",2===Jt.childNodes.length),ce.parseHTML=function(e,t,n){return"string"!=typeof e?[]:("boolean"==typeof t&&(n=t,t=!1),t||(le.createHTMLDocument?((r=(t=C.implementation.createHTMLDocument("")).createElement("base")).href=C.location.href,t.head.appendChild(r)):t=C),o=!n&&[],(i=w.exec(e))?[t.createElement(i[1])]:(i=Ae([e],t,o),o&&o.length&&ce(o).remove(),ce.merge([],i.childNodes)));var r,i,o},ce.fn.load=function(e,t,n){var r,i,o,a=this,s=e.indexOf(" ");return-1").append(ce.parseHTML(e)).find(r):e)}).always(n&&function(e,t){a.each(function(){n.apply(this,o||[e.responseText,t,e])})}),this},ce.expr.pseudos.animated=function(t){return ce.grep(ce.timers,function(e){return t===e.elem}).length},ce.offset={setOffset:function(e,t,n){var r,i,o,a,s,u,l=ce.css(e,"position"),c=ce(e),f={};"static"===l&&(e.style.position="relative"),s=c.offset(),o=ce.css(e,"top"),u=ce.css(e,"left"),("absolute"===l||"fixed"===l)&&-1<(o+u).indexOf("auto")?(a=(r=c.position()).top,i=r.left):(a=parseFloat(o)||0,i=parseFloat(u)||0),v(t)&&(t=t.call(e,n,ce.extend({},s))),null!=t.top&&(f.top=t.top-s.top+a),null!=t.left&&(f.left=t.left-s.left+i),"using"in t?t.using.call(e,f):c.css(f)}},ce.fn.extend({offset:function(t){if(arguments.length)return void 0===t?this:this.each(function(e){ce.offset.setOffset(this,t,e)});var e,n,r=this[0];return r?r.getClientRects().length?(e=r.getBoundingClientRect(),n=r.ownerDocument.defaultView,{top:e.top+n.pageYOffset,left:e.left+n.pageXOffset}):{top:0,left:0}:void 0},position:function(){if(this[0]){var e,t,n,r=this[0],i={top:0,left:0};if("fixed"===ce.css(r,"position"))t=r.getBoundingClientRect();else{t=this.offset(),n=r.ownerDocument,e=r.offsetParent||n.documentElement;while(e&&(e===n.body||e===n.documentElement)&&"static"===ce.css(e,"position"))e=e.parentNode;e&&e!==r&&1===e.nodeType&&((i=ce(e).offset()).top+=ce.css(e,"borderTopWidth",!0),i.left+=ce.css(e,"borderLeftWidth",!0))}return{top:t.top-i.top-ce.css(r,"marginTop",!0),left:t.left-i.left-ce.css(r,"marginLeft",!0)}}},offsetParent:function(){return this.map(function(){var e=this.offsetParent;while(e&&"static"===ce.css(e,"position"))e=e.offsetParent;return e||J})}}),ce.each({scrollLeft:"pageXOffset",scrollTop:"pageYOffset"},function(t,i){var o="pageYOffset"===i;ce.fn[t]=function(e){return M(this,function(e,t,n){var r;if(y(e)?r=e:9===e.nodeType&&(r=e.defaultView),void 0===n)return r?r[i]:e[t];r?r.scrollTo(o?r.pageXOffset:n,o?n:r.pageYOffset):e[t]=n},t,e,arguments.length)}}),ce.each(["top","left"],function(e,n){ce.cssHooks[n]=Ye(le.pixelPosition,function(e,t){if(t)return t=Ge(e,n),_e.test(t)?ce(e).position()[n]+"px":t})}),ce.each({Height:"height",Width:"width"},function(a,s){ce.each({padding:"inner"+a,content:s,"":"outer"+a},function(r,o){ce.fn[o]=function(e,t){var n=arguments.length&&(r||"boolean"!=typeof e),i=r||(!0===e||!0===t?"margin":"border");return M(this,function(e,t,n){var r;return y(e)?0===o.indexOf("outer")?e["inner"+a]:e.document.documentElement["client"+a]:9===e.nodeType?(r=e.documentElement,Math.max(e.body["scroll"+a],r["scroll"+a],e.body["offset"+a],r["offset"+a],r["client"+a])):void 0===n?ce.css(e,t,i):ce.style(e,t,n,i)},s,n?e:void 0,n)}})}),ce.each(["ajaxStart","ajaxStop","ajaxComplete","ajaxError","ajaxSuccess","ajaxSend"],function(e,t){ce.fn[t]=function(e){return this.on(t,e)}}),ce.fn.extend({bind:function(e,t,n){return this.on(e,null,t,n)},unbind:function(e,t){return this.off(e,null,t)},delegate:function(e,t,n,r){return this.on(t,e,n,r)},undelegate:function(e,t,n){return 1===arguments.length?this.off(e,"**"):this.off(t,e||"**",n)},hover:function(e,t){return this.on("mouseenter",e).on("mouseleave",t||e)}}),ce.each("blur focus focusin focusout resize scroll click dblclick mousedown mouseup mousemove mouseover mouseout mouseenter mouseleave change select submit keydown keypress keyup contextmenu".split(" "),function(e,n){ce.fn[n]=function(e,t){return 0
Gilles van den Hoven
Michael Geary
Stefan Petre
Yehuda Katz
Corey Jewett
Klaus Hartl
Franck Marcia
Jörn Zaefferer
Paul Bakaus
Brandon Aaron
Mike Alsup
Dave Methvin
Ed Engelhardt
Sean Catchpole
Paul Mclanahan
David Serduke
Richard D. Worth
Scott González
Ariel Flesler
Cheah Chu Yeow
Andrew Chalkley
Fabio Buffoni
Stefan Bauckmeier
Jon Evans
TJ Holowaychuk
Riccardo De Agostini
Michael Bensoussan
Louis-Rémi Babé
Robert Katić
Damian Janowski
Anton Kovalyov
Dušan B. Jovanovic
Earle Castledine
Rich Dougherty
Kim Dalsgaard
Andrea Giammarchi
Fabian Jakobs
Mark Gibson
Karl Swedberg
Justin Meyer
Ben Alman
James Padolsey
David Petersen
Batiste Bieler
Jake Archibald
Alexander Farkas
Filipe Fortes
Rick Waldron
Neeraj Singh
Paul Irish
Iraê Carvalho
Matt Curry
Michael Monteleone
Noah Sloan
Tom Viner
J. Ryan Stinnett
Douglas Neiner
Adam J. Sontag
Heungsub Lee
Dave Reed
Carl Fürstenberg
Jacob Wright
Ralph Whitbeck
unknown
temp01
Colin Snover
Jared Grippe
Ryan W Tenney
Alex Sexton
Pinhook
Ron Otten
Jephte Clain
Anton Matzneller
Dan Heberden
Henri Wiechers
Russell Holbrook
Julian Aubourg
Gianni Alessandro Chiappetta
Scott Jehl
James Burke
Jonas Pfenniger
Xavi Ramirez
Sylvester Keil
Brandon Sterne
Mathias Bynens
Lee Carpenter
Timmy Willison <4timmywil@gmail.com>
Corey Frang
Digitalxero
David Murdoch
Josh Varner
Charles McNulty
Jordan Boesch
Jess Thrysoee
Michael Murray
Alexis Abril
Rob Morgan
John Firebaugh
Sam Bisbee
Gilmore Davidson
Brian Brennan
Xavier Montillet
Daniel Pihlstrom
Sahab Yazdani
avaly
Scott Hughes
Mike Sherov
Greg Hazel
Schalk Neethling
Denis Knauf
Timo Tijhof
Steen Nielsen
Anton Ryzhov
Shi Chuan
Matt Mueller
Berker Peksag
Toby Brain
Justin
Daniel Herman
Oleg Gaidarenko
Rock Hymas
Richard Gibson
Rafaël Blais Masson
cmc3cn <59194618@qq.com>
Joe Presbrey
Sindre Sorhus
Arne de Bree
Vladislav Zarakovsky
Andrew E Monat
Oskari
Joao Henrique de Andrade Bruni
tsinha
Dominik D. Geyer
Matt Farmer
Trey Hunner
Jason Moon
Jeffery To
Kris Borchers
Vladimir Zhuravlev
Jacob Thornton
Chad Killingsworth
Vitya Muhachev
Nowres Rafid
David Benjamin
Alan Plum
Uri Gilad
Chris Faulkner
Marcel Greter
Elijah Manor
Daniel Chatfield
Daniel Gálvez
Nikita Govorov
Wesley Walser
Mike Pennisi
Matthias Jäggli
Devin Cooper
Markus Staab
Dave Riddle
Callum Macrae
Jonathan Sampson
Benjamin Truyman
Jay Merrifield
James Huston
Sai Lung Wong
Erick Ruiz de Chávez
David Bonner
Allen J Schmidt Jr
Akintayo Akinwunmi
MORGAN
Ismail Khair
Carl Danley
Mike Petrovich
Greg Lavallee