Update readme and documentations
diff --git a/.DS_Store b/.DS_Store
index 75c822a..4b76368 100644
--- a/.DS_Store
+++ b/.DS_Store
Binary files differ
diff --git a/.Rbuildignore b/.Rbuildignore
index 99feece..91114bf 100644
--- a/.Rbuildignore
+++ b/.Rbuildignore
@@ -1,3 +1,2 @@
^.*\.Rproj$
^\.Rproj\.user$
-^README.Rmd$
diff --git a/NAMESPACE b/NAMESPACE
index 1adb487..de8dd30 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -7,13 +7,21 @@
export(magic_mirror)
export(rmd_format)
export(usepackage_latex)
-import(stringr)
importFrom(knitr,knit_meta_add)
+importFrom(magrittr,"%>%")
importFrom(rmarkdown,latex_dependency)
importFrom(rmarkdown,metadata)
importFrom(rvest,html_table)
importFrom(stringr,str_count)
+importFrom(stringr,str_detect)
+importFrom(stringr,str_extract)
+importFrom(stringr,str_extract_all)
+importFrom(stringr,str_match)
+importFrom(stringr,str_match_all)
+importFrom(stringr,str_replace_all)
importFrom(stringr,str_split)
+importFrom(stringr,str_trim)
+importFrom(utils,read.csv)
importFrom(xml2,"xml_attr<-")
importFrom(xml2,read_html)
importFrom(xml2,read_xml)
@@ -24,3 +32,4 @@
importFrom(xml2,xml_children)
importFrom(xml2,xml_has_attr)
importFrom(xml2,xml_name)
+importFrom(xml2,xml_text)
diff --git a/R/add_footnote.R b/R/add_footnote.R
index 5db0778..5977104 100644
--- a/R/add_footnote.R
+++ b/R/add_footnote.R
@@ -12,7 +12,8 @@
#' notations in your notes.
#' @param notation You can select the format of your footnote notation from
#' "number", "alphabet" and "symbol".
-#' @param threeparttable Boolean value indicating if a \href{https://www.ctan.org/pkg/threeparttable}{threeparttable} scheme should be used.
+#' @param threeparttable Boolean value indicating if a
+#' \href{https://www.ctan.org/pkg/threeparttable}{threeparttable} scheme should be used.
#'
#' @export
add_footnote <- function(input, label = NULL,
@@ -149,6 +150,7 @@
}
if (threeparttable == T) {
# generate footer with appropriate symbol
+ usepackage_latex("threeparttable")
footer <- ""
for (i in 1:count.label) {
footer <- paste0(footer,"\\\\item [", ids[i], "] ", label[i], "\n")
diff --git a/R/add_header_above.R b/R/add_header_above.R
index 4c83a8e..baba605 100644
--- a/R/add_header_above.R
+++ b/R/add_header_above.R
@@ -1,4 +1,17 @@
-#' Add an extra header row above the current header
+#' Add a header row on top of current header
+#'
+#' @description Tables with multiple rows of header rows are extremely useful
+#' to demonstrate grouped data. This function takes the output of a `kable()`
+#' function and adds an header row on top of it. This function can work with
+#' both `HTML` and `LaTeX` outputs
+#'
+#' @param kable_input Output of `knitr::kable()` with `format` specified
+#' @param header A (named) character vector with `colspan` as values. For
+#' example, `c(" " = 1, "title" = 2)` can be used to create a new header row
+#' for a 3-column table with "title" spanning across column 2 and 3. For
+#' convenience, when `colspan` equals to 1, users can drop the ` = 1` part.
+#' As a result, `c(" ", "title" = 2)` is the same as `c(" " = 1, "title" = 2)`.
+#'
#' @export
add_header_above <- function(kable_input, header = NULL) {
kable_format <- attr(kable_input, "format")
diff --git a/R/from_knitr.R b/R/from_knitr.R
index f782a19..1948795 100644
--- a/R/from_knitr.R
+++ b/R/from_knitr.R
@@ -1,8 +1,8 @@
# These functions are imported from knitr/highr as `:::` is not recommended by
# CRAN
-#' escape special LaTeX characters
-#' @author Yihui Xie
+# escape special LaTeX characters
+# @author Yihui Xie
escape_latex <- function(x, newlines = FALSE, spaces = FALSE) {
x = gsub('\\\\', '\\\\textbackslash', x)
x = gsub('([#$%&_{}])', '\\\\\\1', x)
@@ -14,8 +14,8 @@
x
}
-#' escape special HTML characters
-#' @author Yihui Xie
+# escape special HTML characters
+# @author Yihui Xie
escape_html <- function(x) {
x = gsub('&', '&', x)
x = gsub('<', '<', x)
diff --git a/R/kableExtra-package.R b/R/kableExtra-package.R
index 11528b5..904c032 100644
--- a/R/kableExtra-package.R
+++ b/R/kableExtra-package.R
@@ -1,11 +1,14 @@
#' kableExtra
#'
-#' @importFrom stringr str_count str_split
+#' @importFrom stringr str_count str_split str_match str_detect str_match_all
+#' str_extract str_replace_all str_trim str_extract_all
#' @importFrom xml2 read_xml xml_attr xml_has_attr xml_attr<- read_html
-#' xml_child xml_children xml_name xml_add_sibling xml_add_child
+#' xml_child xml_children xml_name xml_add_sibling xml_add_child xml_text
#' @importFrom rvest html_table
#' @importFrom knitr knit_meta_add
#' @importFrom rmarkdown latex_dependency
+#' @importFrom magrittr %>%
+#' @importFrom utils read.csv
#' @name kableExtra-package
#' @aliases kableExtra
#' @docType package
diff --git a/R/kable_styling.R b/R/kable_styling.R
index 2d4d148..33027a0 100644
--- a/R/kable_styling.R
+++ b/R/kable_styling.R
@@ -4,15 +4,32 @@
#' of HTML tables other than using the `table.attr` option in `knitr::kable()`.
#' Currenly, it assumes the HTML document has boot
#'
-#' @param bootstrap_options A character vector for bootstrap table options. For
-#' detailed information, please check the package vignette or visit the
-#' w3schools' \href{https://www.w3schools.com/bootstrap/bootstrap_tables.asp}{Bootstrap Page}
-#' . Possible options include "basic", "striped", "bordered", "hover",
-#' "condensed" and "responsive".
+#' @param kable_input Output of `knitr::kable()` with `format` specified
+#' @param bootstrap_options A character vector for bootstrap table options.
+#' Please see package documentation site or visit the w3schools'
+#' \href{https://www.w3schools.com/bootstrap/bootstrap_tables.asp}{Bootstrap Page}
+#' for more information. Possible options include `basic`, `striped`,
+#' `bordered`, `hover`, `condensed` and `responsive`.
+#' @param latex_options A character vector for LaTeX table options. Please see
+#' package documentation site for more information. Possible options include
+#' `basic`, `striped`, `hold_position`, `scale_down`. `striped` will add
+#' alternative row colors to the table. It will imports `LaTeX` package `xcolor`
+#' if enabled. `hold_position` will "hold" the floating table to the exact
+#' position. It is useful when the `LaTeX` table is contained in a `table`
+#' environment after you specified captions in `kable()`. It will force the
+#' table to stay in the position where it was created in the document.
+#' `scale_down` is useful for super wide table. It will automatically adjust
+#' the table to page width.
#' @param full_width A `TRUE` or `FALSE` variable controlling whether the HTML
-#' table should have 100\% width.
-#' @param position A character string determining whether and how the HTML table
-#' should float on the page. Values could be "left", "center", "right"
+#' table should have 100\% width. Since HTML and pdf have different flavors on
+#' the preferable format for `full_width`. If not specified, a HTML table will
+#' have full width by default but this option will be set to `FALSE` for a
+#' LaTeX table
+#' @param position A character string determining how to position the table
+#' on a page. Possible values include `left`, `center`, `right`, `float_left`
+#' and `float_right`. Please see the package doc site for demonstrations. For
+#' a `LaTeX` table, if `float_*` is selected, `LaTeX` package `wrapfig` will be
+#' imported.
#' @param font_size A numeric input for table font size
#'
#' @export
@@ -214,11 +231,7 @@
styling_latex_position_center <- function(x, table_info, hold_position) {
if (!table_info$table_env & table_info$tabular == "tabular") {
- table_env_setup <- "\\begin{table}"
- if (hold_position) {
- table_env_setup <- paste0(table_env_setup, "[!h]")
- }
- return(paste0(table_env_setup, "\n\\centering", x, "\n\\end{table}"))
+ return(paste0("\\begin{table}[!h]\n\\centering", x, "\n\\end{table}"))
}
return(x)
}
@@ -242,17 +255,21 @@
if (option == "l") return(styling_latex_position_left(x, table_info))
if (option == "r") return(styling_latex_position_right(x, table_info, F))
}
+ usepackage_latex("wrapfig")
+ size_matrix <- sapply(sapply(table_info$contents, str_split, " & "), nchar)
+ col_max_length <- apply(size_matrix, 1, max) + 4
if (table_info$table_env) {
- usepackage_latex("wrapfig")
- size_matrix <- sapply(sapply(table_info$contents, str_split, " & "), nchar)
- col_max_length <- apply(size_matrix, 1, max) + 4
option <- sprintf("\\\\begin\\{wraptable\\}\\{%s\\}", option)
option <- paste0(option, "\\{",sum(col_max_length) * 0.15, "cm\\}")
x <- sub("\\\\begin\\{table\\}\\[\\!h\\]", "\\\\begin\\{table\\}", x)
x <- sub("\\\\begin\\{table\\}", option, x)
x <- sub("\\\\end\\{table\\}", "\\\\end\\{wraptable\\}", x)
- return(x)
+ } else {
+ option <- sprintf("\\begin{wraptable}{%s}", option)
+ option <- paste0(option, "{",sum(col_max_length) * 0.15, "cm}")
+ x <- paste0(option, x, "\\end{wraptable}")
}
+ return(x)
}
styling_latex_font_size <- function(x, table_info, font_size) {
diff --git a/R/magic_mirror.R b/R/magic_mirror.R
index 28be804..9b88457 100644
--- a/R/magic_mirror.R
+++ b/R/magic_mirror.R
@@ -1,60 +1,61 @@
#' Magic mirror that returns kable's attributes
#'
-#' @param input The output of kable
-#' @import stringr
+#' @description Mirror mirror tell me, how does this kable look like?
+#'
+#' @param kable_input The output of kable
#' @export
-magic_mirror <- function(input){
- if(!"knitr_kable" %in% attr(input, "class")){
+magic_mirror <- function(kable_input){
+ if (!"knitr_kable" %in% attr(kable_input, "class")) {
warning("magic_mirror may not be able to produce correct result if the",
" input table is not rendered by knitr::kable. ")
}
- kable_format <- attr(input, "format")
- if (kable_format == "latex"){
- kable_info <- magic_mirror_latex(input)
+ kable_format <- attr(kable_input, "format")
+ if (kable_format == "latex") {
+ kable_info <- magic_mirror_latex(kable_input)
}
- if (kable_format == "html"){
- kable_info <- magic_mirror_html(input)
+ if (kable_format == "html") {
+ kable_info <- magic_mirror_html(kable_input)
}
return(kable_info)
}
#' Magic mirror for latex tables --------------
-#' @param input The output of kable
-magic_mirror_latex <- function(input){
+#' @param kable_input The output of kable
+magic_mirror_latex <- function(kable_input){
kable_info <- list(tabular = NULL, booktabs = FALSE, align = NULL,
valign = NULL, ncol = NULL, nrow = NULL, colnames = NULL,
rownames = NULL, caption = NULL, contents = NULL,
centering = FALSE, table_env = FALSE)
# Tabular
kable_info$tabular <- ifelse(
- grepl("\\\\begin\\{tabular\\}", input),
+ grepl("\\\\begin\\{tabular\\}", kable_input),
"tabular", "longtable"
)
# Booktabs
- kable_info$booktabs <- grepl("\\\\toprule", input)
+ kable_info$booktabs <- grepl("\\\\toprule", kable_input)
# Align
kable_info$align <- gsub("\\|", "", str_match(
- input, paste0("\\\\begin\\{", kable_info$tabular,"\\}.*\\{(.*?)\\}"))[2])
+ kable_input, paste0("\\\\begin\\{", kable_info$tabular,"\\}.*\\{(.*?)\\}"))[2])
# valign
kable_info$valign <- gsub("\\|", "", str_match(
- input, paste0("\\\\begin\\{", kable_info$tabular,"\\}(.*)\\{.*?\\}"))[2])
+ kable_input, paste0("\\\\begin\\{", kable_info$tabular,"\\}(.*)\\{.*?\\}"))[2])
# N of columns
kable_info$ncol <- nchar(kable_info$align)
# Caption
- kable_info$caption <- str_match(input, "caption\\{(.*?)\\n")[2]
+ kable_info$caption <- str_match(kable_input, "caption\\{(.*?)\\n")[2]
# N of rows
- kable_info$nrow <- str_count(input, "\\\\\n") -
+ kable_info$nrow <- str_count(kable_input, "\\\\\n") -
# in the dev version (currently as of 11.2015) of knitr, when longtable is
# enabled, caption is moved inside the tabular environment. As a result,
# the number of rows should be adjusted.
ifelse(
kable_info$tabular == "longtable" & !is.na(kable_info$caption) &
- !str_detect(input, "\\\\begin\\{table\\}\\n\\n\\\\caption"),
+ !str_detect(kable_input, "\\\\begin\\{table\\}\\n\\n\\\\caption"),
1,0
)
# Contents
- kable_info$contents <- str_match_all(input, "\n(.*)\\\\\\\\")[[1]][,2]
+ kable_info$contents <- str_match_all(kable_input, "\n(.*)\\\\\\\\")[[1]][,2]
if (kable_info$tabular == "longtable" & !is.na(kable_info$caption)) {
kable_info$contents <- kable_info$contents[-1]
}
@@ -63,7 +64,7 @@
# Row names
kable_info$rownames <- str_extract(kable_info$contents, "^[^ &]*")
- kable_info$centering <- grepl("\\\\centering", input)
+ kable_info$centering <- grepl("\\\\centering", kable_input)
kable_info$table_env <- (!is.na(kable_info$caption) &
kable_info$tabular != "longtable")
@@ -72,38 +73,24 @@
#' Magic Mirror for html table --------
#'
-#' @param input The output of kable
-magic_mirror_html <- function(input){
- kable_info <- list(table.attr = NULL, align = NULL,
- ncol = NULL, nrow = NULL, colnames = NULL, rownames = NULL,
- caption = NULL, contents = NULL)
- kable_data <- html_table(read_html(input))
+#' @param kable_input The output of kable
+magic_mirror_html <- function(kable_input){
+ kable_info <- list()
+ kable_xml <- read_xml(as.character(kable_input))
# Caption
- kable_info$caption <- names(kable_data)
+ kable_info$caption <- xml_text(xml_child(kable_xml, "caption"))
# Contents
- kable_info$contents <- kable_data[[1]]
+ kable_info$contents <- html_table(read_html(as.character(kable_input)))[[1]]
# colnames
- kable_info$colnames <- str_replace_all(
- str_trim(names(kable_data[[1]])), "V[0-9]{1,2}", ""
- )
- # rownames
- kable_info$rownames <- as.character(kable_data[[1]][,1])
- if(str_trim(names(kable_data[[1]])[1]) != "V1"){
- kable_info$rownames <- c(str_trim(names(kable_data[[1]])[1]),
- kable_info$rownames)}
- # ncol
+ kable_info$colnames <- lapply(xml_children(xml_child(kable_xml, "thead")),
+ xml_children)
+ kable_info$colnames <- kable_info$colnames[[length(kable_info$colnames)]]
+ kable_info$colnames <- trimws(xml_text(kable_info$colnames))
kable_info$ncol <- length(kable_info$colnames)
- # nrow
- kable_info$nrow <- length(kable_info$rownames)
- # table.attr
- kable_info$table.attr <- str_match(input, "<table class = '(.*)'>")[2]
- # align
- kable_info$align <- str_match_all(
- input, 'style=\\"text-align:([^;]*);'
- )[[1]][,2]
- kable_info$align <- paste0(
- str_extract(tail(kable_info$align, kable_info$ncol), "."), collapse = ""
- )
+ kable_info$nrow_header <- length(xml_children(xml_child(kable_xml, "thead")))
+ kable_info$nrow_body <- nrow(kable_info$contents)
+ kable_info$table_class <- xml_attr(kable_xml, "class")
+ kable_info$table_style <- xml_attr(kable_xml, "style")
return(kable_info)
}
diff --git a/R/zzz.R b/R/zzz.R
index fe9dd91..848679b 100644
--- a/R/zzz.R
+++ b/R/zzz.R
@@ -1,5 +1,4 @@
.onLoad <- function(libname = find.package("kableExtra"), pkgname = "kableExtra") {
usepackage_latex("booktabs")
usepackage_latex("longtable")
- message("LaTeX package booktabs and longtable will be loaded by default.")
}
diff --git a/README.Rmd b/README.Rmd
deleted file mode 100644
index 1ef6784..0000000
--- a/README.Rmd
+++ /dev/null
@@ -1,52 +0,0 @@
----
-output:
- md_document:
- variant: markdown_github
----
-<!-- README.md is generated from README.Rmd. Please edit that file -->
-
-This package is still in an "as-is" state. You can save a lot of finger-typing time by using it but you still need to understand what is really going on behind the hood, which is still far behind my goal. Also, since the default output format of `kable` is `markdown`, which doesn't support high-level table customization, it may not work well in many cases. I would recommend you to set the `format` option in each `kable` function or to define `options(knitr.table.format = 'html')` or `latex` somewhere in your document.
-
-#Introduction to kableExtra
-When we are talking about table generators in `R`, `knitr::kable` wins the favor of a lot of people by its ultimate simplicity. Unlike those powerful table rendering engine such as `xtable`, `tables` or even `gridExtra`, the philosophy behind `kable` is to make it easy for programmers to use. Just as it claimed in its function description,
-> This is a very simple table generator. It is simple by design. It is not intended to replace any other R packages for making tables. - Yihui
-
-However, we also see a lot of people getting frustrated online for the lack of functionality of `kable`. It is kind of unfair to `kable` as it is supposed to be "simple" by design. However, it is also understandable as people cry because they love to use this function instead of those complicated alternatives.
-
-In `kableExtra`, we are not intended to build another table generator engine as there have been a lot (actually too many in my personal opinion) in `R`. This package is an attempt to extend `knitr::kable`'s functionality without destroying the beauty of its simplicity by using the pipe syntax from `magrittr`. We will follow the literal programming practice and try to make the progress of building a table in `R` go together with the flow of logic in your mind. We will also borrow the idea of *"grammar of graphics"* from `ggplot2` and `ggvis` and implement it in the progress of table generating tasks.
-
-##Vocabulary & Grammar
-Here is a list of features that we would love to see in this package. I bolded these that have been done.
-
-- **add_footnote()**
-- add_indent()
-- col_markup()
-- row_markup()
-- add_stripe()
-- add_hover()
-- add_textcolor()
-- add_bgcolor()
-- **magic_mirror()**
-- reverse_kable()
-
-The syntax of this package is just like what you are doing in `dplyr` or `ggvis`. Here is an example of adding footnote to a `kable` object.
-```r
-library(knitr)
-library(kableExtra)
-
-cars %>%
- head() %>%
- rename("speed[note]" = speed) %>%
- kable(caption = "Head of cars [note]") %>%
- add_footnote(
- label = c("Footnote in caption",
- "Footnote in table"),
- notation = "number" # Or "alphabet"/"symbol"
- )
-```
-
-## Examples
-These two documents demonstrate the different behaviors under HTML and LaTeX (including booktabs and longtable)
-
-* [HTML demo](http://rpubs.com/haozhu233/kableExtra_footnote_html)
-* [PDF demo](https://www.dropbox.com/s/qk7msi64mndn67y/brief_demo_pdf.pdf?dl=0)
diff --git a/README.md b/README.md
index 6f548e3..a2b6198 100644
--- a/README.md
+++ b/README.md
@@ -1,49 +1,42 @@
-<!-- README.md is generated from README.Rmd. Please edit that file -->
-This package is still in an "as-is" state. You can save a lot of finger-typing time by using it but you still need to understand what is really going on behind the hood, which is still far behind my goal. Also, since the default output format of `kable` is `markdown`, which doesn't support high-level table customization, it may not work well in many cases. I would recommend you to set the `format` option in each `kable` function or to define `options(knitr.table.format = 'html')` or `latex` somewhere in your document.
+# kableExtra
+When we are talking about table generators in R, knitr::kable wins the favor of a lot of people by its ultimate simplicity. Unlike those powerful table rendering engine such as xtable, tables or even gridExtra, the philosophy behind kable is to make it easy for programmers to use. Just as it claimed in its function description,
-Introduction to kableExtra
-==========================
+> This is a very simple table generator. It is simple by design. It is not intended to replace any other R packages for making tables. - Yihui
-When we are talking about table generators in `R`, `knitr::kable` wins the favor of a lot of people by its ultimate simplicity. Unlike those powerful table rendering engine such as `xtable`, `tables` or even `gridExtra`, the philosophy behind `kable` is to make it easy for programmers to use. Just as it claimed in its function description, > This is a very simple table generator. It is simple by design. It is not intended to replace any other R packages for making tables. - Yihui
+However, the ultimate simplicity of `kable()` brought troubles to some people, especially some new R users who may not have got exposed to other table making packages in R. It is not rare to see people including experienced user asking questions like how to center/left-align a table on Stack Overflow or twitter. These are the reasons why this package `kableExtra` was created.
-However, we also see a lot of people getting frustrated online for the lack of functionality of `kable`. It is kind of unfair to `kable` as it is supposed to be "simple" by design. However, it is also understandable as people cry because they love to use this function instead of those complicated alternatives.
+I hope with `kableExtra`, you can
-In `kableExtra`, we are not intended to build another table generator engine as there have been a lot (actually too many in my personal opinion) in `R`. This package is an attempt to extend `knitr::kable`'s functionality without destroying the beauty of its simplicity by using the pipe syntax from `magrittr`. We will follow the literal programming practice and try to make the progress of building a table in `R` go together with the flow of logic in your mind. We will also borrow the idea of *"grammar of graphics"* from `ggplot2` and `ggvis` and implement it in the progress of table generating tasks.
+- Use default base `kable()` for all simple tables
+- Use `kable()` with `kableExtra` to generate 90 % of complex/advanced/self-customized/beautiful tables in either HTML or LaTeX
+- Only have to mess with raw HTML/LaTeX in the last 10% cases where `kableExtra` cannot solve the problem
-Vocabulary & Grammar
---------------------
+## Features
+### Pipable syntax
+`kableExtra` is NOT a table generating package. It is a package that can **"add features"** to a `kable()` output using a syntax that every useR loves - the pipes `%>%`. We see similar approaches to deal with plots in packages like `ggvis` and `plotly`. There is no reason why we cannot use it with tables.
-Here is a list of features that we would love to see in this package. I bolded these that have been done.
+### Unified functions for both HTML and PDF
+Most functionalities in `kableExtra` can work in both HTML and PDF. In fact, as long as you specifies format in `kable()` (which can be set globally through option `knitr.table.format`), functions in this package will pick the right way to manipulate the table be themselves. As a result, if users want to left align the table, `kable(...) %>% kable_styling(position = "left")` will work in both HTML and PDF.
-- **add\_footnote()**
-- add\_indent()
-- col\_markup()
-- row\_markup()
-- add\_stripe()
-- add\_hover()
-- add\_textcolor()
-- add\_bgcolor()
-- **magic\_mirror()**
-- reverse\_kable()
-
-The syntax of this package is just like what you are doing in `dplyr` or `ggvis`. Here is an example of adding footnote to a `kable` object.
-
-``` r
-library(knitr)
-library(kableExtra)
-
-cars %>%
- head() %>%
- rename("speed[note]" = speed) %>%
- kable(caption = "Head of cars [note]") %>%
- add_footnote(
- label = c("Footnote in caption",
- "Footnote in table"),
- notation = "number" # Or "alphabet"/"symbol"
- )
+## Install
+```r
+devtools::install_github("haozhu233/kableExtra")
```
-Examples
---------
+## Basic Usage
+```r
+library(knitr)
+library(kableExtra)
+options(knitr.table.format = "html")
+# switch to "latex" in a pdf environment
+dt <- mtcars[1:5, 1:4]
-These two documents demonstrate the different behaviors under HTML and LaTeX (including booktabs and longtable) \* HTML demo: <http://rpubs.com/haozhu233/kableExtra_footnote_html> \* PDF demo: <https://www.dropbox.com/s/qk7msi64mndn67y/brief_demo_pdf.pdf?dl=0>
+kable(dt, booktabs = T, caption = "Demo Table") %>%
+ kable_styling(bootstrap_options = "striped",
+ latex_options = "striped",
+ full_width = F, font_size = 9) %>%
+ add_header_above(c(" ", "Group 1" = 2, "Group 2[note]" = 2)) %>%
+ add_footnote(c("table footnote"))
+```
+<img src="http://i.imgur.com/kHFBF3H.png" style="height: 200px;"/>
+<img src="http://i.imgur.com/q46hzOR.png" style="height: 200px;"/>
diff --git a/man/add_footnote.Rd b/man/add_footnote.Rd
index e2060dd..997e941 100644
--- a/man/add_footnote.Rd
+++ b/man/add_footnote.Rd
@@ -17,7 +17,8 @@
\item{notation}{You can select the format of your footnote notation from
"number", "alphabet" and "symbol".}
-\item{threeparttable}{Boolean value indicating if a \href{https://www.ctan.org/pkg/threeparttable}{threeparttable} scheme should be used.}
+\item{threeparttable}{Boolean value indicating if a
+\href{https://www.ctan.org/pkg/threeparttable}{threeparttable} scheme should be used.}
}
\description{
Add footnote to your favorite kable output. So far this function
diff --git a/man/add_header_above.Rd b/man/add_header_above.Rd
index 54d6884..b65516f 100644
--- a/man/add_header_above.Rd
+++ b/man/add_header_above.Rd
@@ -2,10 +2,22 @@
% Please edit documentation in R/add_header_above.R
\name{add_header_above}
\alias{add_header_above}
-\title{Add an extra header row above the current header}
+\title{Add a header row on top of current header}
\usage{
add_header_above(kable_input, header = NULL)
}
+\arguments{
+\item{kable_input}{Output of `knitr::kable()` with `format` specified}
+
+\item{header}{A (named) character vector with `colspan` as values. For
+example, `c(" " = 1, "title" = 2)` can be used to create a new header row
+for a 3-column table with "title" spanning across column 2 and 3. For
+convenience, when `colspan` equals to 1, users can drop the ` = 1` part.
+As a result, `c(" ", "title" = 2)` is the same as `c(" " = 1, "title" = 2)`.}
+}
\description{
-Add an extra header row above the current header
+Tables with multiple rows of header rows are extremely useful
+to demonstrate grouped data. This function takes the output of a `kable()`
+function and adds an header row on top of it. This function can work with
+both `HTML` and `LaTeX` outputs
}
diff --git a/man/escape_html.Rd b/man/escape_html.Rd
deleted file mode 100644
index b920921..0000000
--- a/man/escape_html.Rd
+++ /dev/null
@@ -1,14 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/from_knitr.R
-\name{escape_html}
-\alias{escape_html}
-\title{escape special HTML characters}
-\usage{
-escape_html(x)
-}
-\description{
-escape special HTML characters
-}
-\author{
-Yihui Xie
-}
diff --git a/man/escape_latex.Rd b/man/escape_latex.Rd
deleted file mode 100644
index baaa185..0000000
--- a/man/escape_latex.Rd
+++ /dev/null
@@ -1,14 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/from_knitr.R
-\name{escape_latex}
-\alias{escape_latex}
-\title{escape special LaTeX characters}
-\usage{
-escape_latex(x, newlines = FALSE, spaces = FALSE)
-}
-\description{
-escape special LaTeX characters
-}
-\author{
-Yihui Xie
-}
diff --git a/man/kable_styling.Rd b/man/kable_styling.Rd
index 5330f97..08c0e54 100644
--- a/man/kable_styling.Rd
+++ b/man/kable_styling.Rd
@@ -9,17 +9,36 @@
"left", "right", "float_left", "float_right"), font_size = NULL)
}
\arguments{
-\item{bootstrap_options}{A character vector for bootstrap table options. For
-detailed information, please check the package vignette or visit the
-w3schools' \href{https://www.w3schools.com/bootstrap/bootstrap_tables.asp}{Bootstrap Page}
-. Possible options include "basic", "striped", "bordered", "hover",
-"condensed" and "responsive".}
+\item{kable_input}{Output of `knitr::kable()` with `format` specified}
+
+\item{bootstrap_options}{A character vector for bootstrap table options.
+Please see package documentation site or visit the w3schools'
+\href{https://www.w3schools.com/bootstrap/bootstrap_tables.asp}{Bootstrap Page}
+for more information. Possible options include `basic`, `striped`,
+`bordered`, `hover`, `condensed` and `responsive`.}
+
+\item{latex_options}{A character vector for LaTeX table options. Please see
+package documentation site for more information. Possible options include
+`basic`, `striped`, `hold_position`, `scale_down`. `striped` will add
+alternative row colors to the table. It will imports `LaTeX` package `xcolor`
+if enabled. `hold_position` will "hold" the floating table to the exact
+position. It is useful when the `LaTeX` table is contained in a `table`
+environment after you specified captions in `kable()`. It will force the
+table to stay in the position where it was created in the document.
+`scale_down` is useful for super wide table. It will automatically adjust
+the table to page width.}
\item{full_width}{A `TRUE` or `FALSE` variable controlling whether the HTML
-table should have 100\% width.}
+table should have 100\% width. Since HTML and pdf have different flavors on
+the preferable format for `full_width`. If not specified, a HTML table will
+have full width by default but this option will be set to `FALSE` for a
+LaTeX table}
-\item{position}{A character string determining whether and how the HTML table
-should float on the page. Values could be "left", "center", "right"}
+\item{position}{A character string determining how to position the table
+on a page. Possible values include `left`, `center`, `right`, `float_left`
+and `float_right`. Please see the package doc site for demonstrations. For
+a `LaTeX` table, if `float_*` is selected, `LaTeX` package `wrapfig` will be
+imported.}
\item{font_size}{A numeric input for table font size}
}
diff --git a/man/magic_mirror.Rd b/man/magic_mirror.Rd
index 1d468b8..56b3f79 100644
--- a/man/magic_mirror.Rd
+++ b/man/magic_mirror.Rd
@@ -4,11 +4,11 @@
\alias{magic_mirror}
\title{Magic mirror that returns kable's attributes}
\usage{
-magic_mirror(input)
+magic_mirror(kable_input)
}
\arguments{
-\item{input}{The output of kable}
+\item{kable_input}{The output of kable}
}
\description{
-Magic mirror that returns kable's attributes
+Mirror mirror tell me, how does this kable look like?
}
diff --git a/man/magic_mirror_html.Rd b/man/magic_mirror_html.Rd
index 1baedfc..0c05b1c 100644
--- a/man/magic_mirror_html.Rd
+++ b/man/magic_mirror_html.Rd
@@ -4,10 +4,10 @@
\alias{magic_mirror_html}
\title{Magic Mirror for html table --------}
\usage{
-magic_mirror_html(input)
+magic_mirror_html(kable_input)
}
\arguments{
-\item{input}{The output of kable}
+\item{kable_input}{The output of kable}
}
\description{
Magic Mirror for html table --------
diff --git a/man/magic_mirror_latex.Rd b/man/magic_mirror_latex.Rd
index 0550aa1..5bc299c 100644
--- a/man/magic_mirror_latex.Rd
+++ b/man/magic_mirror_latex.Rd
@@ -4,10 +4,10 @@
\alias{magic_mirror_latex}
\title{Magic mirror for latex tables --------------}
\usage{
-magic_mirror_latex(input)
+magic_mirror_latex(kable_input)
}
\arguments{
-\item{input}{The output of kable}
+\item{kable_input}{The output of kable}
}
\description{
Magic mirror for latex tables --------------
diff --git a/test/visual_tests/add_header_above_html.Rmd b/test/visual_tests/add_header_above_html.Rmd
deleted file mode 100644
index fb41d08..0000000
--- a/test/visual_tests/add_header_above_html.Rmd
+++ /dev/null
@@ -1,24 +0,0 @@
----
-title: "add_header_above"
-output: html_document
----
-
-# Plain LaTeX
-```{r}
-library(knitr)
-library(kableExtra)
-dt <- mtcars[1:5, 1:4]
-
-kable(dt, format = "html") %>%
- add_header_above(c(" ", "a" = 2, "b" = 2)) %>%
- add_header_above(c(" ", "c" = 3, "d" = 1))
-```
-
-# Basic Bootstrap Table
-```{r}
-kable(dt, format = "html") %>%
- kable_styling(full_width = F,
- bootstrap_options = c("striped", "bordered")) %>%
- add_header_above(c(" ", "a" = 2, "b" = 2)) %>%
- add_header_above(c(" ", "c" = 3, "d" = 1))
-```
diff --git a/test/visual_tests/add_header_above_pdf.Rmd b/test/visual_tests/add_header_above_pdf.Rmd
deleted file mode 100644
index 56b4b4e..0000000
--- a/test/visual_tests/add_header_above_pdf.Rmd
+++ /dev/null
@@ -1,22 +0,0 @@
----
-title: "add_header_above"
-output: pdf_document
----
-
-# Plain LaTeX
-```{r}
-library(knitr)
-library(kableExtra)
-dt <- mtcars[1:5, 1:4]
-
-kable(dt, format = "latex") %>%
- add_header_above(c(" ", "a" = 2, "b" = 2)) %>%
- add_header_above(c(" ", "c" = 3, "d" = 1))
-```
-
-# Basic Bootstrap Table
-```{r}
-kable(dt, format = "latex", booktabs = T) %>%
- add_header_above(c(" ", "a" = 2, "b" = 2)) %>%
- add_header_above(c(" ", "c" = 3, "d" = 1))
-```
diff --git a/test/.DS_Store b/tests/.DS_Store
similarity index 100%
rename from test/.DS_Store
rename to tests/.DS_Store
Binary files differ
diff --git a/test/visual_tests/.DS_Store b/tests/visual_tests/.DS_Store
similarity index 100%
rename from test/visual_tests/.DS_Store
rename to tests/visual_tests/.DS_Store
Binary files differ
diff --git a/test/visual_tests/.gitignore b/tests/visual_tests/.gitignore
similarity index 100%
rename from test/visual_tests/.gitignore
rename to tests/visual_tests/.gitignore
diff --git a/test/visual_tests/add_footnote_html.Rmd b/tests/visual_tests/add_footnote_html.Rmd
similarity index 100%
rename from test/visual_tests/add_footnote_html.Rmd
rename to tests/visual_tests/add_footnote_html.Rmd
diff --git a/test/visual_tests/add_footnote_pdf.Rmd b/tests/visual_tests/add_footnote_pdf.Rmd
similarity index 100%
rename from test/visual_tests/add_footnote_pdf.Rmd
rename to tests/visual_tests/add_footnote_pdf.Rmd
diff --git a/tests/visual_tests/add_header_above_html.Rmd b/tests/visual_tests/add_header_above_html.Rmd
new file mode 100644
index 0000000..6ae7359
--- /dev/null
+++ b/tests/visual_tests/add_header_above_html.Rmd
@@ -0,0 +1,28 @@
+---
+title: "add_header_above"
+output: html_document
+---
+
+# Plain LaTeX
+```{r}
+library(knitr)
+library(kableExtra)
+options(knitr.table.format = "html")
+dt <- mtcars[1:5, 1:4]
+
+kable(dt, booktabs = T, caption = "Demo Table") %>%
+ kable_styling(bootstrap_options = c("striped", "condensed"),
+ latex_options = c("striped", "hold_position"),
+ full_width = F) %>%
+ add_header_above(c(" ", "Group 1" = 2, "Group 2[note]" = 2)) %>%
+ add_footnote(c("table footnote"))
+```
+
+# Basic Bootstrap Table
+```{r}
+kable(dt, format = "html") %>%
+ kable_styling(full_width = F,
+ bootstrap_options = c("striped", "bordered")) %>%
+ add_header_above(c(" ", "a" = 2, "b" = 2)) %>%
+ add_header_above(c(" ", "c" = 3, "d" = 1))
+```
diff --git a/tests/visual_tests/add_header_above_pdf.Rmd b/tests/visual_tests/add_header_above_pdf.Rmd
new file mode 100644
index 0000000..86d785f
--- /dev/null
+++ b/tests/visual_tests/add_header_above_pdf.Rmd
@@ -0,0 +1,36 @@
+---
+title: "add_header_above"
+output: pdf_document
+---
+
+```{r}
+library(knitr)
+library(kableExtra)
+options(knitr.table.format = "latex")
+# switch to "latex" in a pdf environment
+dt <- mtcars[1:5, 1:4]
+
+kable(dt, booktabs = T) %>%
+ kable_styling(bootstrap_options = "striped",
+ latex_options = "striped",
+ full_width = F) %>%
+ add_header_above(c(" ", "Group 1" = 2, "Group 2[note]" = 2)) %>%
+ add_footnote(c("table footnote"))
+```
+
+```{r}
+kable(dt, format = "latex", booktabs = T) %>%
+ add_header_above(c(" ", "a" = 2, "b" = 2))
+```
+
+
+```{r}
+kable(dt, format = "latex", booktabs = T, longtable = T, caption = "aaa") %>%
+ add_header_above(c(" ", "a" = 2, "b" = 2))
+```
+
+```{r}
+kable(dt, format = "latex", booktabs = T, caption = "aaa") %>%
+ add_header_above(c(" ", "a" = 2, "b" = 2))
+```
+
diff --git a/test/visual_tests/htmlTable_styling.Rmd b/tests/visual_tests/htmlTable_styling.Rmd
similarity index 100%
rename from test/visual_tests/htmlTable_styling.Rmd
rename to tests/visual_tests/htmlTable_styling.Rmd
diff --git a/test/visual_tests/kable_styling_pdf.Rmd b/tests/visual_tests/kable_styling_pdf.Rmd
similarity index 100%
rename from test/visual_tests/kable_styling_pdf.Rmd
rename to tests/visual_tests/kable_styling_pdf.Rmd