Skip to main content

Advanced R Solutions

17 Translating R code

Prerequisites

In this chapter we combine R’s metaprogramming and functional programming capabilities and therefore load both the rlang and the purrr package.

17.1 HTML

Q1: The escaping rules for <script> tags are different because they contain JavaScript, not HTML. Instead of escaping angle brackets or ampersands, you need to escape </script> so that the tag isn’t closed too early. For example, script("'</script>'"), shouldn’t generate this:

<script>'</script>'</script>

But

<script>'<\/script>'</script>

Adapt the escape() to follow these rules when a new argument script is set to TRUE.

A: We are asked to implement a special case of escaping for the <script> tag. At first we will revisit the relevant functions provided in Advanced R and confirm that our code reliably escapes for tags like <p> and <b> but doesn’t escape correctly for the <script> tag. Then we modify the escape() and tag() functions to redefine the <script> tag and confirm that all defined tags now escape correctly.

Note that the <style> tag, which contains styling information in CSS, follows the same escaping rules as the <script> tag. We therefore implement the desired escaping for the <style> tag function also.

Let’s start by loading the relevant code from Advanced R first.

# Escaping
html <- function(x) structure(x, class = "advr_html")

print.advr_html <- function(x, ...) {
  out <- paste0("<HTML> ", x)
  cat(paste(strwrap(out), collapse = "\n"), "\n", sep = "")
}

escape <- function(x) UseMethod("escape")

escape.character <- function(x) {
  x <- gsub("&", "&amp;", x)
  x <- gsub("<", "&lt;", x)
  x <- gsub(">", "&gt;", x)
  
  html(x)
}

escape.advr_html <- function(x) x

# Basic tag functions
dots_partition <- function(...) {
  dots <- list2(...)
  
  if (is.null(names(dots))) {
    is_named <- rep(FALSE, length(dots))
  } else {
    is_named <- names(dots) != ""
  }
  
  list(
    named = dots[is_named],
    unnamed = dots[!is_named]
  )
}

# html_attributes() function from the GitHub repository of Advanced R
# https://github.com/hadley/adv-r/blob/master/dsl-html-attributes.r

html_attributes <- function(list) {
  if (length(list) == 0) return("")
  
  attr <- map2_chr(names(list), list, html_attribute)
  paste0(" ", unlist(attr), collapse = "")
}

html_attribute <- function(name, value = NULL) {
  if (length(value) == 0) return(name) # for attributes with no value
  if (length(value) != 1) stop("`value` must be NULL or length 1")
  if (is.logical(value)) {
    # Convert T and F to true and false
    value <- tolower(value)
  } else {
    value <- escape_attr(value)
  }
  paste0(name, "='", value, "'")
}

escape_attr <- function(x) {
  x <- escape.character(x)
  x <- gsub("\'", '&#39;', x)
  x <- gsub("\"", '&quot;', x)
  x <- gsub("\r", '&#13;', x)
  x <- gsub("\n", '&#10;', x)
  x
}

# Tag functions
tag <- function(tag) {
  new_function(
    exprs(... = ),
    expr({
      dots <- dots_partition(...)
      attribs <- html_attributes(dots$named)
      children <- map_chr(dots$unnamed, escape)
      
      html(paste0(
        !!paste0("<", tag), attribs, ">",
        paste(children, collapse = ""),
        !!paste0("</", tag, ">")
      ))
    }),
    caller_env()
  )
}

This code escapes the <p> and <b> tags correctly, but doesn’t achieve the desired behaviour for the <script> tag yet:

p <- tag("p")
b <- tag("b")

identical(
  p("&","and <", b("& > will be escaped")) %>% 
    as.character(),
  "<p>&amp;and &lt;<b>&amp; &gt; will be escaped</b></p>"
)
#> [1] TRUE

script <- tag("script")

identical(
  script("Don't escape &, <, > - escape </script> and </style>") %>%
    as.character(),
  paste("<script>Don't escape &, <, >",
        "- escape <\\/script> and <\\/style></script>")
)
#> [1] FALSE

We implement the desired change and add the optional argument script to the escape() and the tag() functions (default: script = FALSE). The argument has to be added for all methods of the escape() generic.

escape <- function(x, script = FALSE) UseMethod("escape")

escape.character <- function(x, script = FALSE) {
  
  if (script) {
    x <- gsub("</script>", "<\\/script>", x, fixed = TRUE)
    x <- gsub("</style>",  "<\\/style>",  x, fixed = TRUE)
  } else {
    x <- gsub("&", "&amp;", x)
    x <- gsub("<", "&lt;", x)
    x <- gsub(">", "&gt;", x)
  }

  html(x)
}

escape.advr_html <- function(x, script = FALSE) x


tag <- function(tag, script = FALSE) {
  
  new_function(
    exprs(... = ),
    expr({
      dots <- dots_partition(...)
      attribs <- html_attributes(dots$named)
      children <- map_chr(dots$unnamed, escape, script = !!script)
      html(paste0(
        !!paste0("<", tag), attribs, ">",
        paste(children, collapse = ""),
        !!paste0("</", tag, ">")
      ))
    }),
    caller_env()
  )
}

Finally, we create new <p>, <b> and <script> tag functions, which now pass their escaping tests.

p <- tag("p")
b <- tag("b")

identical(
  p("&","and <", b("& > will be escaped")) %>% 
    as.character(),
  "<p>&amp;and &lt;<b>&amp; &gt; will be escaped</b></p>"
)
#> [1] TRUE

script <- tag("script", script = TRUE)
style  <- tag("style" , script = TRUE)

identical(
  script("Don't escape &, <, > - escape </script> and </style>") %>%
    as.character(),
  paste("<script>Don't escape &, <, >",
        "- escape <\\/script> and <\\/style></script>")
)
#> [1] TRUE

script("Don't escape &, <, > - escape </script> and </style>")
#> <HTML> <script>Don't escape &, <, > - escape <\/script> and
#> <\/style></script>

Q2: The use of ... for all functions has some big downsides. There’s no input validation and there will be little information in the documentation or autocomplete about how they are used in the function. Create a new function that, when given a named list of tags and their attribute names (like below), creates tag functions with named arguments.

list(
  a = c("href"),
  img = c("src", "width", "height")
)

All tags should get class and id attributes.

A: This exercise requires a function factory: The named list of attribute names will be extended (by class and id) and mapped to function arguments. These will default to NULL, so that the user isn’t forced to provide them.

When creating the tag functions itself we use check_dots_unnamed() from the ellipsis package to ensure named arguments correspond to the expected values (and are not created by some spelling mistake). After that we follow the logic from the tag() function factory above.

To keep the focus on the key ideas, we ignore special cases like <script>, <style> and void tags in this solution (even if this leads to an incorrect tag function for the <img> tag).

tag_factory <- function(tag, tag_attrs) {
  attrs <- c("class", "id", tag_attrs)
  
  attr_args <- set_names(rep(list(NULL), length(attrs)), attrs)
  attr_list <- call2("list", !!!syms(set_names(attrs)))
  
  new_function(
    exprs(... = , !!!attr_args),
    expr({
      ellipsis::check_dots_unnamed()
      
      attribs <- html_attributes(compact(!!attr_list))
      dots <- compact(list(...))
      children <- map_chr(dots, escape)
      
      html(paste0(
        !!paste0("<", tag), attribs, ">",
        paste(children, collapse = ""),
        !!paste0("</", tag, ">")
      ))
    })
  )
}

To validate our new function factory, we modify the with_html() example from Advanced R to work with our newly created a() and img() tag functions.

tag_list <- list(
  a = c("href"),
  img = c("src", "width", "height")
)

tags <- map2(names(tag_list), unname(tag_list), tag_factory) %>% 
  set_names(names(tag_list))

with_tags <- function(code) {
  code <- enquo(code)
  eval_tidy(code, tags)
}

with_tags(
  a(
    img("Correct me if I am wrong", id = "second"),
    href = "https://github.com/Tazinho/Advanced-R-Solutions/issues",
    id = "first"
  )
)
#> <HTML> <a id='first'
#> href='https://github.com/Tazinho/Advanced-R-Solutions/issues'><img
#> id='second'>Correct me if I am wrong</img></a>

Q3: Reason about the following code that calls with_html() referencing objects from the environment. Will it work or fail? Why? Run the code to verify your predictions.

greeting <- "Hello!"
with_html(p(greeting))

p <- function() "p"
address <- "123 anywhere street"
with_html(p(address))

A: First, we rerun the relevant code from Advanced R to define with_html(). Note that we skip the code for void tags, as none of them appear in the code chunk from this exercise.

tags <- c(
  "a", "abbr", "address", "article", "aside", "audio",
  "b", "bdi", "bdo", "blockquote", "body", "button", "canvas",
  "caption", "cite", "code", "colgroup", "data", "datalist",
  "dd", "del", "details", "dfn", "div", "dl", "dt", "em",
  "eventsource", "fieldset", "figcaption", "figure", "footer",
  "form", "h1", "h2", "h3", "h4", "h5", "h6", "head", "header",
  "hgroup", "html", "i", "iframe", "ins", "kbd", "label",
  "legend", "li", "mark", "map", "menu", "meter", "nav",
  "noscript", "object", "ol", "optgroup", "option", "output",
  "p", "pre", "progress", "q", "ruby", "rp", "rt", "s", "samp",
  "script", "section", "select", "small", "span", "strong",
  "style", "sub", "summary", "sup", "table", "tbody", "td",
  "textarea", "tfoot", "th", "thead", "time", "title", "tr",
  "u", "ul", "var", "video"
)

html_tags <- tags %>% set_names() %>% map(tag)

with_html <- function(code) {
  code <- enquo(code)
  eval_tidy(code, html_tags)
}

Now, let us briefly repeat, that with_html() was introduced to evaluate tag functions from within a list. Otherwise, defining some tag functions like body(), source(), summary() etc. within the global environment would collide with base R functions with the same name. To prevent this the DSL code wrapped in with_html() is evaluated within the “context” of html_tags, which was provided as a data mask to eval_tidy(). As ?rlang::as_data_mask mentions: “Objects in the mask have precedence over objects in the environment.”

Therefore, p() refers to the tag function from html_tags within both examples from the exercise. However, as address is not only a string within the global environment, but also a tag function within html_tags (the <address> HTML tag may be used to provide contact information on an HTML page), p() operates on address() in the second example. This correctly leads to an error as we haven’t implemented an escape.function() method.

greeting <- "Hello!"
with_html(p(greeting))
#> <HTML> <p>Hello!</p>

p <- function() "p"
address <- "123 anywhere street"
with_html(p(address))
#> Error in UseMethod("escape"): no applicable method for 'escape' applied to an object of class "function"

Q4: Currently the HTML doesn’t look terribly pretty, and it’s hard to see the structure. How could you adapt tag() to do indenting and formatting? (You may need to do some research into block and inline tags.)

A: First, let us load all relevant functions from Advanced R:

tag <- function(tag) {
  new_function(
    exprs(... = ),
    expr({
      dots <- dots_partition(...)
      attribs <- html_attributes(dots$named)
      children <- map_chr(dots$unnamed, escape)
      html(paste0(
        !!paste0("<", tag), attribs, ">",
        paste(children, collapse = ""),
        !!paste0("</", tag, ">")
      ))
    }),
    
    caller_env()
  )
}

void_tag <- function(tag) {
  new_function(
    exprs(... = ), 
    expr({
      dots <- dots_partition(...)
      if (length(dots$unnamed) > 0) {
        stop(
          !!paste0("<", tag, "> must not have unnamed arguments"),
          call. = FALSE
        )
      }
      
      attribs <- html_attributes(dots$named)
      
      html(paste0(!!paste0("<", tag), attribs, " />"))
    }),
    caller_env()
  )
}

tags <- c(
  "a", "abbr", "address", "article", "aside", "audio", "b",
  "bdi", "bdo", "blockquote", "body", "button", "canvas",
  "caption", "cite", "code", "colgroup", "data", "datalist",
  "dd", "del", "details", "dfn", "div", "dl", "dt", "em",
  "eventsource", "fieldset", "figcaption", "figure", "footer",
  "form", "h1", "h2", "h3", "h4", "h5", "h6", "head", "header",
  "hgroup", "html", "i", "iframe", "ins", "kbd", "label", "legend",
  "li", "mark", "map", "menu", "meter", "nav", "noscript", "object",
  "ol", "optgroup", "option", "output", "p", "pre", "progress", "q",
  "ruby", "rp", "rt", "s", "samp", "script", "section", "select",
  "small", "span", "strong", "style", "sub", "summary", "sup",
  "table", "tbody", "td", "textarea", "tfoot", "th", "thead",
  "time", "title", "tr", "u", "ul", "var", "video"
)

void_tags <- c(
  "area", "base", "br", "col", "command", "embed", "hr", "img",
  "input", "keygen", "link", "meta", "param", "source", 
  "track", "wbr"
)

html_tags <- c(
  tags %>% set_names() %>% map(tag),
  void_tags %>% set_names() %>% map(void_tag)
)

with_html <- function(code) {
  code <- enquo(code)  
  eval_tidy(code, html_tags)
}

Now, let’s look at the example from above:

with_html(
  body(
    h1("A heading", id = "first"),
    p("Some text &", b("some bold text.")),
    img(src = "myimg.png", width = 100, height = 100)
  )
)
#> <HTML> <body><h1 id='first'>A heading</h1><p>Some text &amp;<b>some
#> bold text.</b></p><img src='myimg.png' width='100' height='100'
#> /></body>

The formatting consists of only one long line of code. This output makes it difficult to check the content of the HTML code and its correctness.

What kind of formatting would we prefer instead? Google’s HTML style guide suggests indentation by 2 spaces and new lines for every block, list, or table element. There are other recommendations, but we will keep things simple and will be satisfied with the following output.

<body>
  <h1 id='first'>A heading</h1>
  <p>Some text &amp;<b>some bold text.</b></p>
  <img src='myimg.png'width='100' height='100' />
</body>

First we adjust the print.advr_html() method, removing strwrap() function, because this will re-wrap the HTML, making it harder to understand what’s happening.

html <- function(x) structure(x, class = "advr_html")

print.advr_html <- function(x, ...) {
  cat(paste("<HTML>", x, sep = "\n"))
}

In our desired output we can see that the content of the body-function requires different formatting than the other tag-functions. We will therefore create a new format_code() function, that allows for optional indentation and line breaks.

indent <- function(x) {
  paste0("  ", gsub("\n", "\n  ", x))
}

format_code <- function(children, indent = FALSE) {
  if (indent) {
    paste0("\n", paste0(indent(children), collapse = "\n"), "\n")
  } else {
    paste(children, collapse = "") 
  }
}

We adjust the body function to include the format_code() helper. (This could also be approached programmatically in the tag function factory.)

html_tags$body <- function(...) {
  dots <- dots_partition(...)
  attribs <- html_attributes(dots$named)
  children <- map_chr(dots$unnamed, escape)
  
  html(paste0(
    "<body", attribs, ">",
    format_code(children, indent = TRUE),  
    "</body>"
  ))
}

The resulting output is much more satisfying.

with_html(
  body(
    h1("A heading", id = "first"),
    p("Some text &", b("some bold text.")),
    img(src = "myimg.png", width = 100, height = 100)
  )
)
#> <HTML>
#> <body>
#>   <h1 id='first'>A heading</h1>
#>   <p>Some text &amp;<b>some bold text.</b></p>
#>   <img src='myimg.png' width='100' height='100' />
#> </body>

17.2 LaTeX

Q1: Add escaping. The special symbols that should be escaped by adding a backslash in front of them are \, $, and %. Just as with HTML, you’ll need to make sure you don’t end up double-escaping. So, you’ll need to create a small S3 class and then use that in function operators. That will also allow you to embed arbitrary LaTeX if needed.

A: Currently our to_math() function generates the following output:

to_math(`$`)
#> <LATEX> \mathrm{f}($)    # instead of <LATEX> \$  
to_math(a$b)
#> <LATEX> \mathrm{$}(a b)  # instead of <LATEX> \mathrm{\$}(a b)
to_math(`\\`)
#> <LATEX> \mathrm{f}(\)    # instead of <LATEX> \\  
to_math(`%`)
#> <LATEX> \mathrm{f}(%)    # instead of <LATEX> \%

To adjust this behaviour, we need an escape function with methods for the character and advr_latex classes.

(Note that we must first repeat the underlying code from Advanced R. However, since this would be a bit verbose, and not very meaningful, we will not show this step here.)

escape_latex <- function(x) UseMethod("escape_latex")

escape_latex.character <- function(x) {
  x <- gsub("^\\\\$", "\\\\\\\\", x)
  x <- gsub("^\\$$", "\\\\$", x)
  x <- gsub("^\\%$", "\\\\%", x)
  
  latex(x)
}

escape_latex.advr_latex <- function(x) x

We apply escape_latex() within latex_env() when creating environments for unknown symbols and unknown functions. For the unknown function, we need to modify unknown_op() first.

unknown_op <- function(op) {
  new_function(
    exprs(... = ),
    expr({
      contents <- paste(..., collapse = ", ")
      paste0(
        !!paste0("\\mathrm{", escape_latex(op), "}("), contents, ")"
      )
    })
  )
}

latex_env <- function(expr) {
  calls <- all_calls(expr)
  call_list <- map(set_names(calls), unknown_op)
  call_env <- as_environment(call_list)
  
  # Known functions
  f_env <- env_clone(f_env, call_env)
  
  # Default symbols
  names <- all_names(expr)
  symbol_env <- as_environment(set_names(escape_latex(names), names),
                               parent = f_env)
  
  # Known symbols
  greek_env <- env_clone(greek_env, parent = symbol_env)
  greek_env
}

Now, we can validate to_math() on the test cases from above.

to_math(`$`)
#> <LATEX> \$
to_math(a$b)
#> <LATEX> \mathrm{\$}(a b)
to_math(`\\`)
#> <LATEX> \\
to_math(`%`)
#> <LATEX> \%

Q2: Complete the DSL to support all the functions that plotmath supports.

A: You can see all supported functions in ?plotmath. There are a lot (!) so here we choose to implement a representative sample:

to_math(x %+-% y)
to_math(x %*% y)
to_math(x %->% y) 
to_math(bold(x))
to_math(x != y)

Implementing the rest is just a mechanical application of the same principles with more LaTex expressions, which can be found on Wikipedia.

To provide these translations, we’ll follow the LaTeX section from Advanced R from the beginning. This makes it easier to keep an overview, as we just need to insert the specific changes at the relevant parts.

Let’s start and repeat the converter function to_math() from the textbook.

to_math <- function(x) {
  expr <- enexpr(x)
  out <- eval_bare(expr, latex_env(expr))
  
  latex(out)
}

latex <- function(x) structure(x, class = "advr_latex")
print.advr_latex <- function(x) {
  cat("<LATEX> ", x, "\n", sep = "")
}

One specific property in this setting is that the environment where to_math() evaluates the expression is not constant, but depends on what we already know about the expression.

Next, we start building up latex_env(), which contains a chain of all the necessary environments which to_math() checks to evaluate the expression in.

The first environment is the one for Greek letters.

greek <- c(
  "alpha", "theta", "tau", "beta", "vartheta", "pi", "upsilon",
  "gamma", "varpi", "phi", "delta", "kappa", "rho",
  "varphi", "epsilon", "lambda", "varrho", "chi", "varepsilon",
  "mu", "sigma", "psi", "zeta", "nu", "varsigma", "omega", "eta",
  "xi", "Gamma", "Lambda", "Sigma", "Psi", "Delta", "Xi",
  "Upsilon", "Omega", "Theta", "Pi", "Phi"
)
greek_list <- set_names(paste0("\\", greek), greek)
greek_env <- as_environment(greek_list)

latex_env <- function(expr) {
  greek_env
}

We already know from Advanced R that e.g. to_math(pi) now correctly converts to \\pi. So, let’s move on to the next one.

Here, it’ll become a bit more technical. Not every symbol is Greek (and not every part of an expression is a symbol). To find out which symbols are present within the expression, first, we use an approach from section 5 of the expressions chapter (walking the AST to find all symbols) where Hadley recursively walks the AST to distinguish between different expression element types.

Let’s briefly repeat the helpers defined in that section:

expr_type <- function(x) {
  if (rlang::is_syntactic_literal(x)) {
    "constant"
  } else if (is.symbol(x)) {
    "symbol"
  } else if (is.call(x)) {
    "call"
  } else if (is.pairlist(x)) {
    "pairlist"
  } else {
    typeof(x)
  }
}

switch_expr <- function(x, ...) {
  switch(expr_type(x),
         ...,
         stop("Don't know how to handle type ",
              typeof(x), call. = FALSE)
  )
}

flat_map_chr <- function(.x, .f, ...) {
  purrr::flatten_chr(purrr::map(.x, .f, ...))
}

This lets us define all_names(), which returns the desired symbols, already converted to characters.

all_names_rec <- function(x) {
  switch_expr(x,
              constant = character(),
              symbol =   as.character(x),
              call =     flat_map_chr(as.list(x[-1]), all_names)
  )
}

all_names <- function(x) {
  unique(all_names_rec(x))
}

all_names(expr(x + y + f(a, b, c, 10)))
#> [1] "x" "y" "a" "b" "c"

We use all_names() now within latex_env() to create an environment of the symbols which were found within the expression. This environment will be set as the parent environment of greek_env.

latex_env <- function(expr) {
  # Unknown symbols
  names <- all_names(expr)
  symbol_env <- as_environment(set_names(names))
  
  # Known symbols
  env_clone(greek_env, parent = symbol_env)
}

In this way, to_math() will first convert all known Greek letters (found in greek_env) and then any other symbols, which are left as is (in this implementation).

We also have to add support for functions. This will give us the opportunity to insert some specific support for plotmath functions.

To support a whole bunch of unary and binary functions within the function environment (f_env), which will be added next to latex_env, Hadley defines the following two helpers in Advanced R.

unary_op <- function(left, right) {
  new_function(
    exprs(e1 = ),
    expr(
      paste0(!!left, e1, !!right)
    ),
    caller_env()
  )
}

binary_op <- function(sep) {
  new_function(
    exprs(e1 = , e2 = ),
    expr(
      paste0(e1, !!sep, e2)
    ),
    caller_env()
  )
}

While defining the function environment, f_env, we mostly continue to copy the exact code from Advanced R. However, at the bottom we add a short section where we define some extra conversions which are part of plotmath (and selected above in our intro to this solution).

f_env <- child_env(
  # Binary operators
  .parent = empty_env(),
  `+` = binary_op(" + "),
  `-` = binary_op(" - "),
  `*` = binary_op(" * "),
  `/` = binary_op(" / "),
  `^` = binary_op("^"),
  `[` = binary_op("_"),
  
  # Grouping
  `{` = unary_op("\\left{ ", " \\right}"),
  `(` = unary_op("\\left( ", " \\right)"),
  paste = paste,
  
  # Other math functions
  sqrt = unary_op("\\sqrt{", "}"),
  sin =  unary_op("\\sin(", ")"),
  log =  unary_op("\\log(", ")"),
  abs =  unary_op("\\left| ", "\\right| "),
  frac = function(a, b) {
    paste0("\\frac{", a, "}{", b, "}")
  },
  
  # Labelling
  hat =   unary_op("\\hat{", "}"),
  tilde = unary_op("\\tilde{", "}"),
  
  # Plotmath
  `%+-%` = binary_op(" \\pm "),
  `%*%`  = binary_op(" \\times "),
  `%->%` = binary_op(" \\rightarrow "),
  bold = unary_op("\\textbf{", "}"),
  `!=` = binary_op(" \\neq ")
)

Again we extend latex_env() to include the additional environment, f_env, which must be the parent of the symbol environment (which is the parent of the Greek symbol environment).

latex_env <- function(expr) {
  # Known functions
  f_env
  
  # Default symbols
  names <- all_names(expr)
  symbol_env <- as_environment(set_names(names), parent = f_env)
  
  # Known symbols
  greek_env <- env_clone(greek_env, parent = symbol_env)
  
  greek_env
}

Now, we can finally check if our new functionality works:

# New plotmath functionality
to_math(x %+-% y)
#> <LATEX> x \pm y
to_math(x %*% y)
#> <LATEX> x \times y
to_math(x %->% y) 
#> <LATEX> x \rightarrow y
to_math(bold(x))
#> <LATEX> \textbf{x}
to_math(x != y)
#> <LATEX> x \neq y

# Other examples from Advanced R
to_math(sin(x + pi))
#> <LATEX> \sin(x + \pi)
to_math(log(x[i]^2))
#> <LATEX> \log(x_i^2)
to_math(sin(sin))
#> <LATEX> \sin(sin)

If we wanted, we could include further plotmath functions in this step. If this collides with other functions at some point, we could just create our own f_plotmath_env to support more plotmath functions. In that case we would need to add this environment also to latex_env() (as child environment of the function environment f_env).

To complete this answer, we will also add the support for unknown functions. Similarly as for the unknown symbols, we use the trick to recursively run the AST and just reuse the code from Advanced R.

all_calls_rec <- function(x) {
  switch_expr(x,
              constant = ,
              symbol =   character(),
              call = {
                fname <- as.character(x[[1]])
                children <- flat_map_chr(as.list(x[-1]), all_calls)
                c(fname, children)
              }
  )
}

all_calls <- function(x) {
  unique(all_calls_rec(x))
}

all_calls(expr(f(g + b, c, d(a))))
#> [1] "f" "+" "d"

unknown_op <- function(op) {
  new_function(
    exprs(... = ),
    expr({
      contents <- paste(..., collapse = ", ")
      paste0(!!paste0("\\mathrm{", op, "}("), contents, ")")
    })
  )
}

Of course, we need to add the new call_env also to latex_env().

latex_env <- function(expr) {
  calls <- all_calls(expr)
  call_list <- map(set_names(calls), unknown_op)
  call_env <- as_environment(call_list)
  
  # Known functions
  f_env <- env_clone(f_env, call_env)
  
  # Default symbols
  names <- all_names(expr)
  symbol_env <- as_environment(set_names(names), parent = f_env)
  
  # Known symbols
  greek_env <- env_clone(greek_env, parent = symbol_env)
  greek_env
}

Finally, we rerun our tests and double check the newly supported plotmath operators.

# New plotmath functionality
to_math(x %+-% y)
#> <LATEX> x \pm y
to_math(x %*% y)
#> <LATEX> x \times y
to_math(x %->% y) 
#> <LATEX> x \rightarrow y
to_math(bold(x))
#> <LATEX> \textbf{x}
to_math(x != y)
#> <LATEX> x \neq y

# Other examples from Advanced R
to_math(sin(x + pi))
#> <LATEX> \sin(x + \pi)
to_math(log(x[i]^2))
#> <LATEX> \log(x_i^2)
to_math(sin(sin))
#> <LATEX> \sin(sin)

# Unknown functions
to_math(f(g(x)))
#> <LATEX> \mathrm{f}(\mathrm{g}(x))