Added add_indent_html;
Added group_rows_html;
diff --git a/NAMESPACE b/NAMESPACE
index 8d5aace..37f140c 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -4,6 +4,7 @@
export(add_footnote)
export(add_header_above)
export(add_indent)
+export(group_rows)
export(kable_styling)
export(landscape)
export(magic_mirror)
@@ -25,6 +26,7 @@
importFrom(stringr,str_trim)
importFrom(utils,read.csv)
importFrom(xml2,"xml_attr<-")
+importFrom(xml2,"xml_text<-")
importFrom(xml2,read_html)
importFrom(xml2,read_xml)
importFrom(xml2,xml_add_child)
diff --git a/R/add_header_above.R b/R/add_header_above.R
index 5a3c31a..e50261e 100644
--- a/R/add_header_above.R
+++ b/R/add_header_above.R
@@ -32,11 +32,7 @@
if (is.null(header)) return(kable_input)
table_info <- magic_mirror(kable_input)
kable_xml <- read_xml(as.character(kable_input), options = c("COMPACT"))
- # somehow xml2 cannot directly search by name here (it will result in a crash)
- kable_xml_thead <- xml_child(kable_xml, 1)
- if (xml_name(kable_xml_thead) != "thead") {
- kable_xml_thead <- xml_child(kable_xml, 2)
- }
+ kable_xml_thead <- xml_tpart(kable_xml, "thead")
header <- standardize_header_input(header)
diff --git a/R/add_indent.R b/R/add_indent.R
index c88b33d..18fdcd1 100644
--- a/R/add_indent.R
+++ b/R/add_indent.R
@@ -7,13 +7,14 @@
return(kable_input)
}
if (kable_format == "html") {
- return(kable_input)
+ return(add_indent_html(kable_input, positions))
}
if (kable_format == "latex") {
return(add_indent_latex(kable_input, positions))
}
}
+# Add indentation for LaTeX
add_indent_latex <- function(kable_input, positions) {
table_info <- attr(kable_input, "original_kable_meta")
if (is.null(table_info)) {
@@ -39,3 +40,38 @@
latex_indent_unit <- function(rowtext) {
paste0("\\\\hspace{1em}", rowtext)
}
+
+# Add indentation for HTML
+add_indent_html <- function(kable_input, positions) {
+ kable_attrs <- attributes(kable_input)
+
+ kable_xml <- read_xml(as.character(kable_input), options = "COMPACT")
+ kable_tbody <- xml_tpart(kable_xml, "tbody")
+
+ group_header_rows <- attr(kable_input, "group_header_rows")
+ if (!is.null(group_header_rows)) {
+ positions <- positions_corrector(positions, group_header_rows,
+ length(xml_children(kable_tbody)))
+ }
+ for (i in positions) {
+ node_to_edit <- xml_child(xml_children(kable_tbody)[[i]], 1)
+ if (!xml_has_attr(node_to_edit, "indentLevel")) {
+ xml_attr(node_to_edit, "style") <- paste(
+ xml_attr(node_to_edit, "style"), "padding-left: 2em;"
+ )
+ xml_attr(node_to_edit, "indentLevel") <- 1
+ } else {
+ indentLevel <- as.numeric(xml_attr(node_to_edit, "indentLevel"))
+ xml_attr(node_to_edit, "style") <- sub(
+ paste0("padding-left: ", indentLevel * 2, "em;"),
+ paste0("padding-left: ", (indentLevel + 1) * 2, "em;"),
+ xml_attr(node_to_edit, "style")
+ )
+ xml_attr(node_to_edit, "indentLevel") <- indentLevel + 1
+ }
+ }
+ out <- structure(as.character(kable_xml), format = "html",
+ class = "knitr_kable")
+ attributes(out) <- kable_attrs
+ return(out)
+}
diff --git a/R/group_rows.R b/R/group_rows.R
new file mode 100644
index 0000000..9827811
--- /dev/null
+++ b/R/group_rows.R
@@ -0,0 +1,51 @@
+#' Put a few rows of a table into one category
+#'
+#' @export
+group_rows <- function(kable_input, group_label, start_row, end_row) {
+ kable_format <- attr(kable_input, "format")
+ if (!kable_format %in% c("html", "latex")) {
+ message("Currently generic markdown table using pandoc is not supported.")
+ return(kable_input)
+ }
+ if (kable_format == "html") {
+ return(group_rows_html(kable_input, group_label, start_row, end_row))
+ }
+ if (kable_format == "latex") {
+ return(group_rows_latex(kable_input, group_label, start_row, end_row))
+ }
+}
+
+group_rows_html <- function(kable_input, group_label, start_row, end_row) {
+ if (!is.numeric(c(start_row, end_row))) {
+ stop("Start_row and end_row must be numeric position of rows (excluding",
+ "header rows and other group-title rows). ")
+ }
+ kable_attrs <- attributes(kable_input)
+ kable_xml <- read_xml(as.character(kable_input), options = "COMPACT")
+ kable_tbody <- xml_tpart(kable_xml, "tbody")
+
+ group_header_rows <- attr(kable_input, "group_header_rows")
+ group_seq <- seq(start_row, end_row)
+ if (!is.null(group_header_rows)) {
+ group_seq <- positions_corrector(group_seq, group_header_rows,
+ length(xml_children(kable_tbody)))
+ }
+
+ # Insert a group header row
+ starting_node <- xml_child(kable_tbody, group_seq[1])
+ kable_ncol <- length(xml_children(starting_node))
+ group_header_row_text <- paste0(
+ '<tr groupLength="', length(group_seq), '"><td colspan="',
+ kable_ncol, '"><strong>', group_label, "</strong></td></tr>"
+ )
+ group_header_row <- read_xml(group_header_row_text, options = "COMPACT")
+ xml_add_sibling(starting_node, group_header_row, .where = "before")
+
+ # add indentations to items
+ out <- structure(as.character(kable_xml), format = "html",
+ class = "knitr_kable")
+ attributes(out) <- kable_attrs
+ attr(out, "group_header_rows") <- c(attr(out, "group_header_rows"), group_seq[1])
+ out <- add_indent(out, positions = seq(start_row, end_row))
+ return(out)
+}
diff --git a/R/kableExtra-package.R b/R/kableExtra-package.R
index 904c032..79f77e5 100644
--- a/R/kableExtra-package.R
+++ b/R/kableExtra-package.R
@@ -4,6 +4,7 @@
#' 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_text
+#' xml_text<-
#' @importFrom rvest html_table
#' @importFrom knitr knit_meta_add
#' @importFrom rmarkdown latex_dependency
diff --git a/R/util.R b/R/util.R
index 9023f4b..50129a7 100644
--- a/R/util.R
+++ b/R/util.R
@@ -30,3 +30,21 @@
usepackage_latex <- function(name, options = NULL) {
invisible(knit_meta_add(list(latex_dependency(name, options))))
}
+
+# Find the right xml section. Since xml_child + search name will result in a
+# crash (at least on my machine), here is a helper function.
+xml_tpart <- function(x, part) {
+ xchildren <- xml_children(x)
+ children_names <- xml_name(xchildren)
+ return(xchildren[[which(children_names == part)]])
+}
+
+positions_corrector <- function(positions, group_header_rows, n_row) {
+ pc_matrix <- data.frame(row_id = 1:n_row)
+ pc_matrix$group_header <- pc_matrix$row_id %in% group_header_rows
+ pc_matrix$adj <- cumsum(pc_matrix$group_header)
+ pc_matrix$old_id <- cumsum(!pc_matrix$group_header)
+ pc_matrix$old_id[duplicated(pc_matrix$old_id)] <- NA
+ adjust_numbers <- pc_matrix$adj[pc_matrix$old_id %in% positions]
+ return(adjust_numbers + positions)
+}
diff --git a/man/group_rows.Rd b/man/group_rows.Rd
new file mode 100644
index 0000000..9785839
--- /dev/null
+++ b/man/group_rows.Rd
@@ -0,0 +1,11 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/group_rows.R
+\name{group_rows}
+\alias{group_rows}
+\title{Put a few rows of a table into one category}
+\usage{
+group_rows(kable_input, group_name, start_row, end_row)
+}
+\description{
+Put a few rows of a table into one category
+}
diff --git a/tests/visual_tests/add_indent_and_group_rows_html.Rmd b/tests/visual_tests/add_indent_and_group_rows_html.Rmd
new file mode 100644
index 0000000..77be4ce
--- /dev/null
+++ b/tests/visual_tests/add_indent_and_group_rows_html.Rmd
@@ -0,0 +1,29 @@
+---
+title: "indents & row_group"
+output: html_document
+---
+
+# Introduction
+Nam non libero ut felis euismod efficitur. Maecenas ligula nisi, rutrum eu turpis quis, semper ultricies nibh. Quisque vehicula cursus erat. Donec aliquam augue ut magna vehicula lacinia. Quisque efficitur, arcu condimentum mollis scelerisque, tellus libero accumsan elit, in eleifend lorem lectus ut erat. Ut sit amet nulla quis turpis semper mattis. Ut rhoncus vitae nulla sit amet ultrices. Nulla justo ligula, rhoncus et interdum vel, cursus ut sem. Nullam elementum ullamcorper neque, imperdiet tempus sapien tincidunt et. Nulla diam nulla, varius ut nisi quis, hendrerit fringilla mi. In volutpat tincidunt faucibus. Donec luctus, mauris vitae consectetur placerat, elit velit tristique mauris, sed malesuada nisl sem eu justo. Nunc enim quam, pharetra vitae velit vel, posuere lacinia turpis. Proin volutpat porttitor ligula.
+
+```{r}
+library(knitr)
+library(kableExtra)
+dt <- mtcars[1:10, 1:8]
+```
+
+```{r}
+kable(dt[1:5,], format = "html") %>%
+ kable_styling(c("striped")) %>%
+ add_indent(c(3, 5)) %>%
+ add_indent(5)
+```
+
+```{r}
+kable(dt, format = "html") %>%
+ kable_styling("striped") %>%
+ group_rows("Group 1", 2, 4) %>%
+ group_rows("Group 2", 6, 7) %>%
+ group_rows("Group 3", 9, 10)
+```
+