Skip to content

Instantly share code, notes, and snippets.

@hadley
Created May 14, 2013 14:18
Show Gist options
  • Star 2 You must be signed in to star a gist
  • Fork 1 You must be signed in to fork a gist
  • Save hadley/5576263 to your computer and use it in GitHub Desktop.
Save hadley/5576263 to your computer and use it in GitHub Desktop.
A partial implementation of a R expression -> latex math converter
# 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 <- function(x) {
to_math_q(substitute(x))
}
to_math_q <- function(x) {
if (is.integer(x) || is.numeric(x)) return(x)
if (is.name(x)) {
x2 <- as.character(x)
x3 <- if (x2 %in% names(symbols)) symbols[[x2]] else x2
return(x3)
}
eval(x, lenv)
}
lenv <- new.env(parent = emptyenv())
dots <- function(...) {
eval(substitute(alist(...)))
}
# Convert a function into a fexpr: the function recieves only unevaluated args
fexpr <- function(f) {
stopifnot(is.function(f))
function(...) {
args <- dots(...)
do.call(f, args, quote = TRUE)
}
}
# Helper functions
unary_op <- function(left, right) {
fexpr(function(e1, e2) {
paste0(left, to_math_q(e1), right)
})
}
binary_op <- function(sep) {
fexpr(function(e1, e2) {
paste0(to_math_q(e1), " ", sep, " ", to_math_q(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("{", "}")
lenv$"(" <- unary_op("(", ")")
lenv$paste <- fexpr(function(...) {
paste0(unlist(lapply(list(...), to_math_q)), collapse = " ")
})
# Other math functions
lenv$sqrt <- unary_op("\\sqrt{", "}")
lenv$log <- unary_op("\\log{", "}")
lenv$inf <- unary_op("\\inf{", "}")
lenv$sup <- unary_op("\\sup{", "}")
lenv$frac <- fexpr(function(a, b) {
paste0("\\frac{", to_math_q(a), "}{", to_math_q(b), "}")
})
# Labelling
lenv$hat <- unary_op("\\hat{", "}")
lenv$tilde <- unary_op("\\tilde{", "}")
lenv$dot <- unary_op("\\dot{", "}")
lenv$ring <- unary_op("\\ring{", "}")
@cboettig
Copy link

Very cool! Could something like this get implemented in ROxygen in place of having to write out LaTeX and plain-txt version with \deqn{}{}? I suppose one could also consider the reverse parser (LaTeX to R), but that might be asking for trouble..

@GegznaV
Copy link

GegznaV commented Mar 2, 2016

There is a bug in the function, as it does not evaluate negative numbers: to_math(-1), to_math_q(expression(-1)), to_math_q(expression(x^-x)). These lines result in error.
Is it possible to fix this bug?

@acguidoum
Copy link

acguidoum commented Sep 8, 2018

We can fix the bug in the function, to evaluate negative numbers, by:

binary_op <- function(sep) {
force(sep)
function(e1, e2) {
if(missing(e2)){ paste0(" - ", e1) }else{ paste0(e1,sep,e2)}
}
}

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment