Merge pull request #1578 from rstudio/transform-latex-equations-html

Render LaTeX formulas in `md()` when target is HTML (standalone/JS-free via katex)

DESCRIPTION

@@ -60,6 +60,7 @@ Suggests:
     ggplot2,
     grid,
     gtable,
+    katex (>= 1.4.1),
     knitr,
     lubridate,
     magick,

R/format_data.R

@@ -11003,6 +11003,84 @@ fmt_icon <- function(
 #' `r man_get_image_tag(file = "man_fmt_markdown_1.png")`
 #' }}
 #'
+#' The `fmt_markdown()` function can also handle LaTeX math formulas enclosed
+#' in `"$..$"` (inline math) and also `"$$..$$"` (display math). The following
+#' table has body cells that contain mathematical formulas in display mode
+#' (i.e., the formulas are surrounded by `"$$"`). Further to this, math can be
+#' used within [md()] wherever there is the possibility to insert text into the
+#' table (e.g., with [cols_label()], [tab_header()], etc.).
+#'
+#' ```r
+#' dplyr::tibble(
+#'   idx = 1:5,
+#'   l_time_domain =
+#'     c(
+#'       "$$1$$",
+#'       "$${{\\bf{e}}^{a\\,t}}$$",
+#'       "$${t^n},\\,\\,\\,\\,\\,n = 1,2,3, \\ldots$$",
+#'       "$${t^p}, p > -1$$",
+#'       "$$\\sqrt t$$"
+#'     ),
+#'   l_laplace_s_domain =
+#'     c(
+#'       "$$\\frac{1}{s}$$",
+#'       "$$\\frac{1}{{s - a}}$$",
+#'       "$$\\frac{{n!}}{{{s^{n + 1}}}}$$",
+#'       "$$\\frac{{\\Gamma \\left( {p + 1} \\right)}}{{{s^{p + 1}}}}$$",
+#'       "$$\\frac{{\\sqrt \\pi }}{{2{s^{\\frac{3}{2}}}}}$$"
+#'     )
+#' ) |>
+#'   gt(rowname_col = "idx") |>
+#'   fmt_markdown() |>
+#'   cols_label(
+#'     l_time_domain = md(
+#'       "Time Domain<br/>$\\small{f\\left( t \\right) =
+#'       {\\mathcal{L}^{\\,\\, - 1}}\\left\\{ {F\\left( s \\right)} \\right\\}}$"
+#'     ),
+#'     l_laplace_s_domain = md(
+#'       "$s$ Domain<br/>$\\small{F\\left( s \\right) =
+#'       \\mathcal{L}\\left\\{ {f\\left( t \\right)} \\right\\}}$"
+#'     )
+#'   ) |>
+#'   tab_header(
+#'     title = md(
+#'       "A (Small) Table of Laplace Transforms &mdash; $\\small{{\\mathcal{L}}}$"
+#'     ),
+#'     subtitle = md(
+#'       "Five commonly used Laplace transforms and formulas.<br/><br/>"
+#'     )
+#'   ) |>
+#'   cols_align(align = "center") |>
+#'   opt_align_table_header(align = "left") |>
+#'   cols_width(
+#'     idx ~ px(50),
+#'     l_time_domain ~ px(300),
+#'     l_laplace_s_domain ~ px(600)
+#'   ) |>
+#'   opt_stylize(
+#'     style = 2,
+#'     color = "gray",
+#'     add_row_striping = FALSE
+#'   ) |>
+#'   opt_table_outline(style = "invisible") %>%
+#'   tab_style(
+#'     style = cell_fill(color = "gray95"),
+#'     locations = cells_body(columns = l_time_domain)
+#'   ) |>
+#'   tab_options(
+#'     heading.title.font.size = px(32),
+#'     heading.subtitle.font.size = px(18),
+#'     heading.padding = px(0),
+#'     footnotes.multiline = FALSE,
+#'     column_labels.border.lr.style = "solid",
+#'     column_labels.border.lr.width = px(1)
+#'   )
+#' ```
+#'
+#' \if{html}{\out{
+#' `r man_get_image_tag(file = "man_fmt_markdown_2.png")`
+#' }}
+#'
 #' @family data formatting functions
 #' @section Function ID:
 #' 3-23
@@ -11088,7 +11166,7 @@ fmt_markdown <- function(
     rows = {{ rows }},
     fns = list(
       html = function(x) {
-        md_to_html(x, md_engine = md_engine)
+        process_text(md(x), context = "html")
       },
       latex = function(x) {
         markdown_to_latex(x, md_engine = md_engine)

R/format_vec.R

@@ -3788,8 +3788,8 @@ vec_fmt_markdown <- function(
     )
 
   if (output == "html") {
-    vec_fmt_out <- gsub("^<div class='gt_from_md'>(.*)", "\\1", vec_fmt_out)
-    vec_fmt_out <- gsub("(.*)\n</div>", "\\1", vec_fmt_out)
+    vec_fmt_out <- gsub("^<span class='gt_from_md'>(.*)", "\\1", vec_fmt_out)
+    vec_fmt_out <- gsub("(.*)\n</span>", "\\1", vec_fmt_out)
   }
 
   vec_fmt_out

R/utils.R

@@ -593,23 +593,218 @@ process_text <- function(text, context = "html") {
 
     if (inherits(text, "from_markdown")) {
 
+      in_quarto <- check_quarto()
+
       md_engine_fn <-
         get_markdown_engine_fn(
           md_engine_pref = md_engine,
           context = "html"
         )
 
-      text <-
-        vapply(
-          as.character(text),
-          FUN.VALUE = character(1),
-          USE.NAMES = FALSE,
-          FUN = function(x) {
-            md_engine_fn[[1]](text = x)
-          }
+      #
+      # Markdown text handling for Quarto
+      #
+      if (in_quarto) {
+
+        non_na_text <- text[!is.na(text)]
+
+        non_na_text_processed <-
+          vapply(
+            as.character(text[!is.na(text)]),
+            FUN.VALUE = character(1),
+            USE.NAMES = FALSE,
+            FUN = function(text) {
+              md_engine_fn[[1]](text = text)
+            }
+          )
+
+        non_na_text <- tidy_gsub(non_na_text, "^", "<div data-qmd=\"")
+        non_na_text <- tidy_gsub(non_na_text, "$", "\">")
+
+        non_na_text <-
+          paste0(
+            non_na_text, "<div class='gt_from_md'>",
+            non_na_text_processed, "</div></div>"
+          )
+
+        text[!is.na(text)] <- non_na_text
+
+        return(text)
+      }
+
+      #
+      # Markdown text handling outside of Quarto
+      #
+
+      non_na_text <- text[!is.na(text)]
+
+      equation_present <-
+        any(grepl("\\$\\$.*?\\$\\$", non_na_text)) ||
+        any(grepl("\\$.*?\\$", non_na_text))
+
+      # If an equation is present, extract it and add place marker before
+      # Markdown rendering
+      if (equation_present) {
+
+        # Rendering equations to HTML (outside of Quarto) requires the katex
+        # package; if it's not present, stop with a message
+        rlang::check_installed(
+          pkg = "katex (>= 1.4.1)",
+          reason = "to render equations in HTML tables."
         )
 
-      text <- gsub("^<p>|</p>\n$", "", text)
+        for (i in seq_along(non_na_text)) {
+
+          has_display_formula <- grepl("\\$\\$.*?\\$\\$", non_na_text[i])
+
+          if (has_display_formula) {
+
+            display_j <- 1
+            formula_text_display_i <- c()
+
+            repeat {
+
+              # Extract the display formula text cleanly from the input text
+              # (the text that hasn't yet been processed)
+              formula_text_display_ij <-
+                sub(
+                  "(.*\\$\\$)(.*?)(\\$\\$.*)",
+                  "\\2",
+                  non_na_text[i]
+                )
+
+              formula_text_display_i <-
+                c(formula_text_display_i, formula_text_display_ij)
+
+              # Replace text containing a formula with a marker for the formula
+              non_na_text[i] <-
+                sub(
+                  "\\$\\$.*?\\$\\$",
+                  paste0("|||display_formula ", display_j, "|||"),
+                  non_na_text[i]
+                )
+
+              if (!grepl("\\$\\$.*?\\$\\$", non_na_text[i])) break
+
+              display_j <- display_j + 1
+            }
+          }
+
+          has_inline_formula <- grepl("\\$.*?\\$", non_na_text[i])
+
+          if (has_inline_formula) {
+
+            inline_j <- 1
+            formula_text_inline_i <- c()
+
+            repeat {
+
+              # Extract the inline formula text cleanly from the input text
+              # (the text that hasn't yet been processed)
+              formula_text_inline_ij <-
+                sub(
+                  "(.*\\$)(.*?)(\\$.*)",
+                  "\\2",
+                  non_na_text[i]
+                )
+
+              formula_text_inline_i <-
+                c(formula_text_inline_i, formula_text_inline_ij)
+
+              # Replace text containing a formula with a marker for the formula
+              non_na_text[i] <-
+                sub(
+                  "\\$.*?\\$",
+                  paste0("|||inline_formula ", inline_j, "|||"),
+                  non_na_text[i]
+                )
+
+              if (!grepl("\\$.*?\\$", non_na_text[i])) break
+
+              inline_j <- inline_j + 1
+            }
+          }
+
+          # Use Markdown renderer to process the surrounding text independent
+          # of the formula (the marker is unaffected by Markdown rendering);
+          # also strip away the surrounding '<p>' tag and trailing '\n'
+          text_md_rendered_i <- md_engine_fn[[1]](text = non_na_text[i])
+          text_md_rendered_i <- gsub("^<p>|</p>\n$", "", text_md_rendered_i)
+
+          if (has_display_formula) {
+
+            for (j in seq_along(formula_text_display_i)) {
+
+              # Render the display formula text with `katex::katex_html()`
+              formula_rendered_display_i <-
+                katex::katex_html(
+                  formula_text_display_i[j],
+                  displayMode = TRUE,
+                  include_css = TRUE,
+                  preview = FALSE
+                )
+
+              # Integrate the rendered formula text (`formula_rendered_inline_i`)
+              # into the surrounding text (`text_md_rendered_i`) that's already
+              # been processed with a Markdown renderer; the insertion should
+              # happen at the '|||display_formula #|||' marker
+              text_md_rendered_i <-
+                gsub(
+                  paste0("|||display_formula ", j, "|||"),
+                  formula_rendered_display_i,
+                  text_md_rendered_i,
+                  fixed = TRUE
+                )
+            }
+          }
+
+          if (has_inline_formula) {
+
+            for (j in seq_along(formula_text_inline_i)) {
+
+              # Render the inline formula text with `katex::katex_html()`
+              formula_rendered_inline_i <-
+                katex::katex_html(
+                  formula_text_inline_i[j],
+                  displayMode = FALSE,
+                  include_css = TRUE,
+                  preview = FALSE
+                )
+
+              # Integrate the rendered formula text (`formula_rendered_inline_i`)
+              # into the surrounding text (`text_md_rendered_i`) that's already
+              # been processed with a Markdown renderer; the insertion should
+              # happen at the '|||inline_formula #|||' marker
+              text_md_rendered_i <-
+                gsub(
+                  paste0("|||inline_formula ", j, "|||"),
+                  formula_rendered_inline_i,
+                  text_md_rendered_i,
+                  fixed = TRUE
+                )
+            }
+          }
+
+          non_na_text[i] <- text_md_rendered_i
+        }
+
+      } else {
+
+        for (i in seq_along(non_na_text)) {
+
+          text_i <- non_na_text[i]
+          text_i <- md_engine_fn[[1]](text = text_i)
+          text_i <- gsub("^<p>|</p>\n$", "", text_i)
+
+          non_na_text[i] <- text_i
+        }
+      }
+
+      non_na_text <- tidy_gsub(non_na_text, "^", "<span class='gt_from_md'>")
+      non_na_text <- tidy_gsub(non_na_text, "$", "</span>")
+
+      text[!is.na(text)] <- non_na_text
+      text <- as.character(text)
 
       return(text)
 

inst/css/gt_styles_default.scss

@@ -430,4 +430,9 @@
   .gt_indent_5 {
     text-indent: $stub_indent_length * 5;
   }
+
+  .katex-display {
+    display: inline-flex !important;
+    margin-bottom: 0.75em !important;
+  }
 }