Protect LaTeX math in the HTML format: see https://stackoverflow.com/q/54048265/2554330
diff --git a/R/kableExtra-package.R b/R/kableExtra-package.R
index a06fbcf..ea2a1da 100644
--- a/R/kableExtra-package.R
+++ b/R/kableExtra-package.R
@@ -55,7 +55,7 @@
#' vanilla rmarkdown. For customized rmarkdown templates, it is recommended to
#' load related LaTeX packages manually.
#'
-#' @importFrom stringr str_count str_split str_match str_detect str_match_all
+#' @importFrom stringr fixed str_count str_split str_match str_detect str_match_all
#' str_extract str_replace_all str_trim str_extract_all str_sub str_replace
#' @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
@@ -75,6 +75,7 @@
#' @importFrom glue glue
#' @importFrom tools file_ext file_path_sans_ext
#' @importFrom webshot webshot
+#' @importFrom digest digest
#' @import htmltools
#' @name kableExtra-package
#' @aliases kableExtra
diff --git a/R/kable_styling.R b/R/kable_styling.R
index 0a43f74..92ac60b 100644
--- a/R/kable_styling.R
+++ b/R/kable_styling.R
@@ -47,6 +47,9 @@
#' @param latex_table_env LaTeX option. A character string to define customized
#' table environment such as tabu or tabularx.You shouldn't expect all features
#' could be supported in self-defined environments.
+#' @param protect_latex If `TRUE`, LaTeX code embedded between dollar signs
+#' will be protected from escaping. Has no effect unless HTML format
+#' is chosen: this is for including complicated math in HTML output.
#'
#' @details For LaTeX, if you use other than English environment
#' - all tables are converted to 'UTF-8'. If you use, for example, Hungarian
@@ -71,7 +74,8 @@
repeat_header_method = c("append", "replace"),
repeat_header_continued = FALSE,
stripe_color = "gray!6",
- latex_table_env = NULL) {
+ latex_table_env = NULL,
+ protect_latex = TRUE) {
if (length(bootstrap_options) == 1 && bootstrap_options == "basic") {
bootstrap_options <- getOption("kable_styling_bootstrap_options", "basic")
@@ -104,7 +108,8 @@
bootstrap_options = bootstrap_options,
full_width = full_width,
position = position,
- font_size = font_size))
+ font_size = font_size,
+ protect_latex = protect_latex))
}
if (kable_format == "latex") {
if (is.null(full_width)) {
@@ -125,13 +130,41 @@
}
}
+extract_latex_from_kable <- function(kable_input) {
+ kable_attrs <- attributes(kable_input)
+ regexp <- "(^|[^\\\\])([$][^$]*[^$\\\\]+[$]|[$][$][^$]*[^$\\\\]+[$][$])"
+ latex <- character()
+ while (grepl(regexp, kable_input)) {
+ block <- str_extract(kable_input, regexp)
+ name <- paste0("latex", digest(block))
+ latex[name] <- block
+ kable_input <- str_replace(kable_input, regexp, name)
+ }
+ kable_attrs$extracted_latex <- latex
+ attributes(kable_input) <- kable_attrs
+ kable_input
+}
+
+replace_latex_in_kable <- function(kable_input, latex) {
+ kable_attrs <- attributes(kable_input)
+ for (n in names(latex)) {
+ kable_input <- str_replace_all(kable_input, fixed(n), latex[n])
+ }
+ attributes(kable_input) <- kable_attrs
+ kable_input
+}
+
# htmlTable Styling ------------
htmlTable_styling <- function(kable_input,
bootstrap_options = "basic",
full_width = T,
position = c("center", "left", "right",
"float_left", "float_right"),
- font_size = NULL) {
+ font_size = NULL,
+ protect_latex = TRUE) {
+ if (protect_latex) {
+ kable_input <- extract_latex_from_kable(kable_input)
+ }
kable_attrs <- attributes(kable_input)
kable_xml <- read_kable_as_xml(kable_input)
@@ -189,6 +222,10 @@
}
out <- as_kable_xml(kable_xml)
+ if (protect_latex) {
+ out <- replace_latex_in_kable(out, kable_attrs$extracted_latex)
+ kable_attrs$extracted_latex <- NULL
+ }
attributes(out) <- kable_attrs
if (!"kableExtra" %in% class(out)) class(out) <- c("kableExtra", class(out))
return(out)