# R2latex

test.Routput
[1] $x_1 + 1 ^ {2 + 4} + 5 + \\sqrt{y} / 5 \\ 10$

test.Routput.errors


log, pdf

[1] $x_{1}+1^{{2+4}}+5+\\ sqrt{y}/5\\ 10$

# Intro

I want to test an r2latex function I saw on twitter, and I no longer know how to do anything except on wikis.

# Test

test.R
p_math(x_1 + 1^{2 + 4} + 5 + sqrt(y) / 5 %/% 10)

test.mk
test.Rout: r2latex.Rout test.R
test.tex: test.Routput
/bin/ln -s $<$@

# Original code

This is from a github project apparently started by Hadley Wickham https://gist.github.com/hadley/5576263. If we improve it I guess we can "fork", or "update" and be cool people.

r2latex.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))))

# This function only by JD
p_math <- function(x) {
print(paste("$", to_math_q(substitute(x)), "$"), quote=FALSE)
}

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{", "}")