latex-math.r

# User facing function
#
# to_math(x_1 + 1^{2 + 4} + 5 + sqrt(y) / 5 %/% 10)
# to_math(paste(x^2, y - 1, z_i))
# to_math(hat(tilde(ring(x))))
# to_math(pi*r^2)
# to_math(unknown_call(x, floor(sqrt(z))))
to_math <- function(x) {
  x <- substitute(x)
  env <- latex_env(x)
  eval(x, env)
}

latex_env <- function(expr) {
  call_env <- new.env(parent=emptyenv())
  special_calls <- copy_env(lenv, call_env)
  name_env <- new.env(parent=special_calls)
  symbol_env <- copy_env(senv, name_env)
  for (n in all.names(expr, functions=TRUE)) {
    name_env[[n]] <- n
  }
  lapply(all.names(expr, functions=TRUE), function(n) {
    call_env[[n]] <-
      function(...) paste0("\\mathtt{", n, '} \\left( ',
                           paste(as.character(list(...)), collapse=", "),
                           ' \\right )')
  })
  return(symbol_env)
}

copy_env <- function(env, parent=parent.env(env))
  list2env(as.list(env), parent=parent)

lenv <- new.env(parent = emptyenv())
senv <- new.env(parent = emptyenv())

# Helper functions
unary_op <- function(left, right) {
  function(e1) {
    paste0(left, e1, right)
  }
}

binary_op <- function(sep) {
  function(e1, e2) {
    paste(e1, sep, e2)
  }
}

# Binary operators
lenv$"+" <- binary_op("+")
lenv$"-" <- binary_op("-")
lenv$"*" <- binary_op("*")
lenv$"/" <- binary_op("/")
lenv$"%+-%" <- binary_op("\\pm")
lenv$"%/%" <- binary_op("\\")
lenv$"%*%" <- binary_op("\\times")
lenv$"%.%" <- binary_op("\\cdot")
lenv$"[" <- binary_op("_")
lenv$"^" <- binary_op("^")

# Grouping
lenv$"{" <- unary_op(" \\left{ ", " \\right} ")
lenv$"(" <- unary_op(" \\left( ", " \\right) ")
lenv$paste <- paste

# Other math functions
lenv$sqrt <- unary_op("\\sqrt{", "}")
lenv$log <- unary_op("\\log{", "}")
lenv$inf <- unary_op("\\inf{", "}")
lenv$sup <- unary_op("\\sup{", "}")
lenv$abs <- unary_op("\\left| ", "\\right| ")
lenv$floor <- unary_op("\\lfloor", " \\rfloor ")
lenv$ceil <- unary_op(" \\lceil ", " \\rceil ")
lenv$frac <- function(a, b) {
  paste0("\\frac{", a, "}{", b, "}")
}

# Labelling
lenv$hat <- unary_op("\\hat{", "}")
lenv$tilde <- unary_op("\\tilde{", "}")
lenv$dot <- unary_op("\\dot{", "}")
lenv$ring <- unary_op("\\ring{", "}")

# Symbols
for (i in c(
  "alpha", "theta", "tau", "beta", "vartheta", "pi", "upsilon", "gamma", "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")) {
  senv[[i]] <- paste0("\\", i, " ")
}