Created
May 14, 2013 14:18
-
-
Save hadley/5576263 to your computer and use it in GitHub Desktop.
A partial implementation of a R expression -> latex math converter
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# 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{", "}") |
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?
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
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..