html.json (23498B)
1 { 2 "hash": "c596baeea77da01b0a3fcca05af29a1f", 3 "result": { 4 "engine": "knitr", 5 "markdown": "---\nengine: knitr\ntitle: Translating R code\n---\n\n## Learning objectives:\n\n- Build DSL (domain specific languages) to aid interoperability between R, HTML and LaTeX\n- Reinforce metaprogramming concepts (expressions, quasiquotation, evaluation)\n\n\n::: {.cell}\n::: {.cell-output-display}\n\n```{=html}\n<div class=\"DiagrammeR html-widget html-fill-item\" id=\"htmlwidget-4e2b51612b3b0cac2d87\" style=\"width:100%;height:464px;\"></div>\n<script type=\"application/json\" data-for=\"htmlwidget-4e2b51612b3b0cac2d87\">{\"x\":{\"diagram\":\"\\ngraph LR\\n\\nexpressions --> R\\nquasiquotation --> R\\nevaluation --> R\\n\\nR --> HTML\\nR --> LaTeX\\n\"},\"evals\":[],\"jsHooks\":[]}</script>\n```\n\n:::\n:::\n\n\n<details>\n<summary>Mermaid code</summary>\n\n::: {.cell}\n\n```{.r .cell-code}\nDiagrammeR::mermaid(\"\ngraph LR\n\nexpressions --> R\nquasiquotation --> R\nevaluation --> R\n\nR --> HTML\nR --> LaTeX\n\")\n```\n:::\n\n\n</details>\n\n<details>\n<summary>Session Info</summary>\n\n::: {.cell}\n\n```{.r .cell-code}\nlibrary(DiagrammeR) #for Mermaid flowchart\nlibrary(lobstr) #abstract syntax trees\nlibrary(purrr) #functional programming\nlibrary(rlang) #tidy evaluation\n\n# from section 18.5\nexpr_type <- function(x) {\n if (rlang::is_syntactic_literal(x)) {\n \"constant\"\n } else if (is.symbol(x)) {\n \"symbol\"\n } else if (is.call(x)) {\n \"call\"\n } else if (is.pairlist(x)) {\n \"pairlist\"\n } else {\n typeof(x)\n }\n}\nflat_map_chr <- function(.x, .f, ...) {\n purrr::flatten_chr(purrr::map(.x, .f, ...))\n}\nswitch_expr <- function(x, ...) {\n switch(expr_type(x),\n ...,\n stop(\"Don't know how to handle type \", typeof(x), call. = FALSE)\n )\n}\n```\n:::\n\n\n\n::: {.cell}\n\n```{.r .cell-code}\nutils::sessionInfo()\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> R version 4.5.1 (2025-06-13 ucrt)\n#> Platform: x86_64-w64-mingw32/x64\n#> Running under: Windows 11 x64 (build 26100)\n#> \n#> Matrix products: default\n#> LAPACK version 3.12.1\n#> \n#> locale:\n#> [1] LC_COLLATE=English_United States.utf8 \n#> [2] LC_CTYPE=English_United States.utf8 \n#> [3] LC_MONETARY=English_United States.utf8\n#> [4] LC_NUMERIC=C \n#> [5] LC_TIME=English_United States.utf8 \n#> \n#> time zone: America/Chicago\n#> tzcode source: internal\n#> \n#> attached base packages:\n#> [1] stats graphics grDevices utils datasets methods base \n#> \n#> other attached packages:\n#> [1] rlang_1.1.6 purrr_1.1.0 lobstr_1.1.2 DiagrammeR_1.0.11\n#> \n#> loaded via a namespace (and not attached):\n#> [1] digest_0.6.37 RColorBrewer_1.1-3 R6_2.6.1 fastmap_1.2.0 \n#> [5] xfun_0.52 magrittr_2.0.3 glue_1.8.0 knitr_1.50 \n#> [9] htmltools_0.5.8.1 rmarkdown_2.29 lifecycle_1.0.4 cli_3.6.5 \n#> [13] visNetwork_2.1.2 vctrs_0.6.5 compiler_4.5.1 tools_4.5.1 \n#> [17] evaluate_1.0.4 yaml_2.3.10 jsonlite_2.0.0 htmlwidgets_1.6.4 \n#> [21] keyring_1.4.1\n```\n\n\n:::\n:::\n\n\n</details>\n\n## Case Study: MCQ\n\nWe are going to use R code to generate HTML or LaTeX to produce multiple-choice questions such as\n\n### Pop Quiz!\n\n1. What is the **derivative** of $f(x) = 1 + 2\\cos(3\\pi x + 4)$?\n\n a. $f'(x) = 6\\pi\\sin(3\\pi x + 4)$\n b. $f'(x) = -6\\pi\\sin(3\\pi x + 4)$\n c. $f'(x) = 24\\pi\\sin(3\\pi x + 4)$\n d. $f'(x) = -24\\pi\\sin(3\\pi x + 4)$\n\n\n\n\n\n---\n\nAs developers, we may be asking ourselves:\n\n* What are the expressions?\n* What are the symbols?\n* Will we have to quote inputs from the user (math teacher)?\n\n\n## HTML\n\nWe are trying to produce\n\n```{}\n<body>\n <h1 id = 'pop_quiz'>Pop Quiz</h1>\n <ol>\n <li>What is the <b>derivative</b> of $f(x) = 1 + 2\\cos(3\\pi x + 4)$?</li>\n <ol>\n <li>$f'(x) = 6\\pi\\sin(3\\pi x + 4)$</li>\n <li>$f'(x) = -6\\pi\\sin(3\\pi x + 4)$</li>\n <li>$f'(x) = 24\\pi\\sin(3\\pi x + 4)$</li>\n <li>$f'(x) = -24\\pi\\sin(3\\pi x + 4)$</li>\n </ol>\n </ol>\n <img src = 'calculus_cat.png' width = '100' height = '100' />\n</body>\n```\n\nusing DSL\n\n\n::: {.cell}\n\n```{.r .cell-code}\nwith_html(\n body(\n h1(\"Pop quiz!\", id = \"pop_quiz\"),\n ol(\n li(\"What is the \", b(\"derivative\"), \"of $f(x) = 1 + 2cos(3pi x + 4)$?\"),\n ol(\n li(\"$f'(x) = 6pi*sin(3pi x + 4)$\"),\n li(\"$f'(x) = -6pi*sin(3pi x + 4)$\"),\n li(\"$f'(x) = 24pi*sin(3pi x + 4)$\"),\n li(\"$f'(x) = -24pi*sin(3pi x + 4)$\")\n )\n ),\n img(src = \"images/translating/calculus_cat.png\", width = 100, height = 100)\n )\n)\n```\n:::\n\n\nIn particular,\n\n* **tags** such as `<b></b>` have *attributes*\n* **void tags** such as `<img />`\n* special characters: `&`, `<`, and `>`\n\n\n<details>\n<summary>HTML verification</summary>\n\n```{=html}\n<body>\n <h1 id = 'pop_quiz'>Pop Quiz</h1>\n <ol>\n <li>What is the <b>derivative</b> of $f(x) = 1 + 2\\cos(3\\pi x + 4)$?</li>\n <ol>\n <li>$f'(x) = 6\\pi\\sin(3\\pi x + 4)$</li>\n <li>$f'(x) = -6\\pi\\sin(3\\pi x + 4)$</li>\n <li>$f'(x) = 24\\pi\\sin(3\\pi x + 4)$</li>\n <li>$f'(x) = -24\\pi\\sin(3\\pi x + 4)$</li>\n </ol>\n </ol>\n <img src = 'images/translating/calculus_cat.png' width = '100' height = '100' />\n</body>\n```\n\n</details>\n\n\n## Escaping\n\n* need to escape `&`, `<`, and `>`\n* don't \"double escape\"\n* leave HTML alone\n\n### S3 Class\n\n\n::: {.cell}\n\n```{.r .cell-code}\nhtml <- function(x) structure(x, class = \"advr_html\")\n\n#dispatch\nprint.advr_html <- function(x, ...) {\n out <- paste0(\"<HTML> \", x)\n cat(paste(strwrap(out), collapse = \"\\n\"), \"\\n\", sep = \"\")\n}\n```\n:::\n\n\n### Generic\n\n\n::: {.cell}\n\n```{.r .cell-code}\nescape <- function(x) UseMethod(\"escape\")\nescape.character <- function(x) {\n x <- gsub(\"&\", \"&\", x)\n x <- gsub(\"<\", \"<\", x)\n x <- gsub(\">\", \">\", x)\n html(x)\n}\nescape.advr_html <- function(x) x\n```\n:::\n\n\n### Checks\n\n\n::: {.cell}\n\n```{.r .cell-code}\nescape(\"This is some text.\")\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> <HTML> This is some text.\n```\n\n\n:::\n\n```{.r .cell-code}\nescape(\"x > 1 & y < 2\")\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> <HTML> x > 1 & y < 2\n```\n\n\n:::\n\n```{.r .cell-code}\nescape(escape(\"This is some text. 1 > 2\")) #double escape\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> <HTML> This is some text. 1 > 2\n```\n\n\n:::\n\n```{.r .cell-code}\nescape(html(\"<hr />\")) #already html\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> <HTML> <hr />\n```\n\n\n:::\n:::\n\n\n\n## Named Components\n\n```{}\nli(\"What is the \", b(\"derivative\"), \"of $f(x) = 1 + 2\\cos(3\\pi x + 4)$?\")\n```\n\n* aiming to classify `li` and `b` as **named components**\n\n\n::: {.cell}\n\n```{.r .cell-code}\ndots_partition <- function(...) {\n dots <- list2(...)\n \n if (is.null(names(dots))) {\n is_named <- rep(FALSE, length(dots))\n} else {\n is_named <- names(dots) != \"\"\n}\n \n list(\n named = dots[is_named],\n unnamed = dots[!is_named]\n )\n}\n```\n:::\n\n\n### Check\n\n\n::: {.cell}\n\n```{.r .cell-code}\nstr(dots_partition(company = \"Posit\",\n software = \"RStudio\",\n \"DSLC\",\n \"Cohort 9\"))\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> List of 2\n#> $ named :List of 2\n#> ..$ company : chr \"Posit\"\n#> ..$ software: chr \"RStudio\"\n#> $ unnamed:List of 2\n#> ..$ : chr \"DSLC\"\n#> ..$ : chr \"Cohort 9\"\n```\n\n\n:::\n:::\n\n\n<details>\n<summary>HTML Attributes</summary>\n\nFound among the textbook's [source code](https://github.com/hadley/adv-r/blob/master/dsl-html-attributes.r)\n\n\n::: {.cell}\n\n```{.r .cell-code}\nhtml_attributes <- function(list) {\n if (length(list) == 0) return(\"\")\n\n attr <- map2_chr(names(list), list, html_attribute)\n paste0(\" \", unlist(attr), collapse = \"\")\n}\nhtml_attribute <- function(name, value = NULL) {\n if (length(value) == 0) return(name) # for attributes with no value\n if (length(value) != 1) stop(\"`value` must be NULL or length 1\")\n\n if (is.logical(value)) {\n # Convert T and F to true and false\n value <- tolower(value)\n } else {\n value <- escape_attr(value)\n }\n paste0(name, \"='\", value, \"'\")\n}\nescape_attr <- function(x) {\n x <- escape.character(x)\n x <- gsub(\"\\'\", ''', x)\n x <- gsub(\"\\\"\", '"', x)\n x <- gsub(\"\\r\", ' ', x)\n x <- gsub(\"\\n\", ' ', x)\n x\n}\n```\n:::\n\n\n\n</details>\n\n\n## Tags (calls)\n\n\n::: {.cell}\n\n```{.r .cell-code}\ntag <- function(tag) {\n new_function(\n exprs(... = ), #arguments of new function\n expr({ #body of the new function\n \n #classify tags as named components\n dots <- dots_partition(...)\n \n #focus on named components as the tags\n attribs <- html_attributes(dots$named)\n \n # otherwise, nested code\n children <- map_chr(dots$unnamed, escape)\n\n # paste brackets, tag names, and attributes together\n # then unquote user arguments\n html(paste0(\n !!paste0(\"<\", tag), attribs, \">\",\n paste(children, collapse = \"\"),\n !!paste0(\"</\", tag, \">\")\n ))\n }),\n caller_env() #return the environment\n )\n}\n```\n:::\n\n\n<details>\n<summary>Void tags</summary>\n\n\n::: {.cell}\n\n```{.r .cell-code}\nvoid_tag <- function(tag) {\n new_function(\n exprs(... = ), #allows for missing arguments\n expr({\n dots <- dots_partition(...)\n \n # error check\n if (length(dots$unnamed) > 0) {\n abort(!!paste0(\"<\", tag, \"> must not have unnamed arguments\"))\n }\n attribs <- html_attributes(dots$named)\n\n html(paste0(!!paste0(\"<\", tag), attribs, \" />\"))\n }),\n caller_env()\n )\n}\n```\n:::\n\n\n</details>\n\n### Checks\n\n\n::: {.cell}\n\n```{.r .cell-code}\ntag(\"ol\")\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> function (...) \n#> {\n#> dots <- dots_partition(...)\n#> attribs <- html_attributes(dots$named)\n#> children <- map_chr(dots$unnamed, escape)\n#> html(paste0(\"<ol\", attribs, \">\", paste(children, collapse = \"\"), \n#> \"</ol>\"))\n#> }\n```\n\n\n:::\n:::\n\n\n\n::: {.cell}\n\n```{.r .cell-code}\nimg <- void_tag(\"img\")\n```\n:::\n\n\n\n```{.r .cell-code}\nimg()\n```\n\n<HTML> <img />\n\n\n::: {.cell}\n\n```{.r .cell-code}\nimg(src = \"images/translating/calculus_cat.png\",\n width = 100,\n height = 100)\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> <HTML> <img src='images/translating/calculus_cat.png' width='100'\n#> height='100' />\n```\n\n\n:::\n:::\n\n\n\n## Tags (processing)\n\n<details>\n<summary>Venn Diagram</summary>\n\n\n::: {.cell}\n\n```{.r .cell-code}\ntags <- c(\"a\", \"abbr\", \"address\", \"article\", \"aside\", \"audio\",\n \"b\",\"bdi\", \"bdo\", \"blockquote\", \"body\", \"button\", \"canvas\",\n \"caption\",\"cite\", \"code\", \"colgroup\", \"data\", \"datalist\",\n \"dd\", \"del\",\"details\", \"dfn\", \"div\", \"dl\", \"dt\", \"em\",\n \"eventsource\",\"fieldset\", \"figcaption\", \"figure\", \"footer\",\n \"form\", \"h1\", \"h2\", \"h3\", \"h4\", \"h5\", \"h6\", \"head\", \"header\",\n \"hgroup\", \"html\", \"i\",\"iframe\", \"ins\", \"kbd\", \"label\",\n \"legend\", \"li\", \"mark\", \"map\",\"menu\", \"meter\", \"nav\",\n \"noscript\", \"object\", \"ol\", \"optgroup\", \"option\", \"output\",\n \"p\", \"pre\", \"progress\", \"q\", \"ruby\", \"rp\",\"rt\", \"s\", \"samp\",\n \"script\", \"section\", \"select\", \"small\", \"span\", \"strong\",\n \"style\", \"sub\", \"summary\", \"sup\", \"table\", \"tbody\", \"td\",\n \"textarea\", \"tfoot\", \"th\", \"thead\", \"time\", \"title\", \"tr\",\n \"u\", \"ul\", \"var\", \"video\"\n)\n\nvoid_tags <- c(\"area\", \"base\", \"br\", \"col\", \"command\", \"embed\",\n \"hr\", \"img\", \"input\", \"keygen\", \"link\", \"meta\", \"param\",\n \"source\", \"track\", \"wbr\"\n)\n```\n:::\n\n\n</details>\n\n\n::: {.cell}\n\n```{.r .cell-code}\nhtml_tags <- c(\n tags |> #list of tag names from HTML\n set_names() |> #named variable to avoid reserved words!\n map(tag), #make them function calls\n void_tags |>\n set_names() |>\n map(void_tag)\n)\n```\n:::\n\n\n\n### Example\n\n\n::: {.cell}\n\n```{.r .cell-code}\nhtml_tags$ol(\n html_tags$li(\"What is the \", \n html_tags$b(\"derivative\"),\n \"of $f(x) = 1 + 2cos(3pi x + 4)$?\"))\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> <HTML> <ol><li>What is the <b>derivative</b>of $f(x) = 1 + 2cos(3pi x +\n#> 4)$?</li></ol>\n```\n\n\n:::\n:::\n\n\n\n## Bringing the HTML Together\n\n\n::: {.cell}\n\n```{.r .cell-code}\nwith_html <- function(code) {\n eval_tidy(enquo(code), html_tags)\n}\n```\n:::\n\n\n### Main Example\n\n\n::: {.cell}\n\n```{.r .cell-code}\nwith_html(\n body(\n h1(\"Pop quiz!\", id = \"pop_quiz\"),\n ol(\n li(\"What is the \", b(\"derivative\"), \"of $f(x) = 1 + 2cos(3pi x + 4)$?\"),\n ol(\n li(\"$f'(x) = 6pi*sin(3pi x + 4)$\"),\n li(\"$f'(x) = -6pi*sin(3pi x + 4)$\"),\n li(\"$f'(x) = 24pi*sin(3pi x + 4)$\"),\n li(\"$f'(x) = -24pi*sin(3pi x + 4)$\")\n )\n ),\n img(src = \"images/translating/calculus_cat.png\", width = 100, height = 100)\n )\n)\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> <HTML> <body><h1 id='pop_quiz'>Pop quiz!</h1><ol><li>What is the\n#> <b>derivative</b>of $f(x) = 1 + 2cos(3pi x + 4)$?</li><ol><li>$f'(x) =\n#> 6pi*sin(3pi x + 4)$</li><li>$f'(x) = -6pi*sin(3pi x +\n#> 4)$</li><li>$f'(x) = 24pi*sin(3pi x + 4)$</li><li>$f'(x) =\n#> -24pi*sin(3pi x + 4)$</li></ol></ol><img\n#> src='images/translating/calculus_cat.png' width='100' height='100'\n#> /></body>\n```\n\n\n:::\n:::\n\n\n### Check\n\n```{=html}\n<h1 id='pop_quiz'>Pop quiz!</h1><ol><li>What is the <b>derivative</b> of $f(x) = 1 + 2cos(3pi x + 4)$?</li><ol><li>$f'(x) = 6pi*sin(3pi x + 4)$</li><li>$f'(x) = -6pi*sin(3pi x + 4)$</li><li>$f'(x) = 24pi*sin(3pi x + 4)$</li><li>$f'(x) = -24pi*sin(3pi x + 4)$</li></ol></ol><img src='images/translating/calculus_cat.png' width='100' height='100' />\n```\n\n\n## LaTeX\n\n\n::: {.cell}\n\n```{.r .cell-code}\nlatex <- function(x) structure(x, class = \"advr_latex\")\nprint.advr_latex <- function(x) { cat(\"<LATEX> \", x, \"\\n\", sep = \"\") }\n```\n:::\n\n\n### to_math\n\n\n::: {.cell}\n\n```{.r .cell-code}\nto_math <- function(x) {\n expr <- enexpr(x)\n latex( #return LaTeX code\n eval_bare( #eval_bare to ensure use of latex environment \n expr, #expression (not quosure)\n latex_env(expr) #need to define latex_env\n ))\n}\n```\n:::\n\n\n## Known Symbols\n\n\n::: {.cell}\n\n```{.r .cell-code}\ngreek_letters <- c(\n \"alpha\", \"beta\", \"chi\", \"delta\", \"Delta\", \"epsilon\", \"eta\", \n\"gamma\", \"Gamma\", \"iota\", \"kappa\", \"lambda\", \"Lambda\", \"mu\", \n\"nu\", \"omega\", \"Omega\", \"phi\", \"Phi\", \"pi\", \"Pi\", \"psi\", \"Psi\", \n\"rho\", \"sigma\", \"Sigma\", \"tau\", \"theta\", \"Theta\", \"upsilon\", \n\"Upsilon\", \"varepsilon\", \"varphi\", \"varrho\", \"vartheta\", \"xi\", \n\"Xi\", \"zeta\"\n)\n\ngreek_env <- rlang::as_environment(\n rlang::set_names(\n paste0(\"\\\\\", greek_letters), #latex values\n greek_letters #R names\n )\n)\n```\n:::\n\n\n\n::: {.cell}\n\n```{.r .cell-code}\nstr(as.list(greek_env))\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> List of 38\n#> $ zeta : chr \"\\\\zeta\"\n#> $ Xi : chr \"\\\\Xi\"\n#> $ xi : chr \"\\\\xi\"\n#> $ vartheta : chr \"\\\\vartheta\"\n#> $ varrho : chr \"\\\\varrho\"\n#> $ varphi : chr \"\\\\varphi\"\n#> $ varepsilon: chr \"\\\\varepsilon\"\n#> $ Upsilon : chr \"\\\\Upsilon\"\n#> $ upsilon : chr \"\\\\upsilon\"\n#> $ Theta : chr \"\\\\Theta\"\n#> $ theta : chr \"\\\\theta\"\n#> $ tau : chr \"\\\\tau\"\n#> $ Sigma : chr \"\\\\Sigma\"\n#> $ sigma : chr \"\\\\sigma\"\n#> $ rho : chr \"\\\\rho\"\n#> $ Psi : chr \"\\\\Psi\"\n#> $ psi : chr \"\\\\psi\"\n#> $ Pi : chr \"\\\\Pi\"\n#> $ pi : chr \"\\\\pi\"\n#> $ Phi : chr \"\\\\Phi\"\n#> $ phi : chr \"\\\\phi\"\n#> $ Omega : chr \"\\\\Omega\"\n#> $ omega : chr \"\\\\omega\"\n#> $ nu : chr \"\\\\nu\"\n#> $ mu : chr \"\\\\mu\"\n#> $ Lambda : chr \"\\\\Lambda\"\n#> $ lambda : chr \"\\\\lambda\"\n#> $ kappa : chr \"\\\\kappa\"\n#> $ iota : chr \"\\\\iota\"\n#> $ Gamma : chr \"\\\\Gamma\"\n#> $ gamma : chr \"\\\\gamma\"\n#> $ eta : chr \"\\\\eta\"\n#> $ epsilon : chr \"\\\\epsilon\"\n#> $ Delta : chr \"\\\\Delta\"\n#> $ delta : chr \"\\\\delta\"\n#> $ chi : chr \"\\\\chi\"\n#> $ beta : chr \"\\\\beta\"\n#> $ alpha : chr \"\\\\alpha\"\n```\n\n\n:::\n:::\n\n\n\n## Known Functions\n\n### Unary Operations\n\n\n::: {.cell}\n\n```{.r .cell-code}\nunary_op <- function(left, right) {\n new_function(\n exprs(e1 = ),\n expr(\n paste0(!!left, e1, !!right)\n ),\n caller_env()\n )\n}\n```\n:::\n\n\n\n::: {.cell}\n\n```{.r .cell-code}\n#example\nunary_op(\"\\\\sqrt{\", \"}\")\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> function (e1) \n#> paste0(\"\\\\sqrt{\", e1, \"}\")\n```\n\n\n:::\n:::\n\n\n### Binary Operations\n\n\n::: {.cell}\n\n```{.r .cell-code}\nbinary_op <- function(sep) {\n new_function(\n exprs(e1 = , e2 = ),\n expr(\n paste0(e1, !!sep, e2)\n ),\n caller_env()\n )\n}\n```\n:::\n\n\n\n::: {.cell}\n\n```{.r .cell-code}\n#example\nbinary_op(\"+\")\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> function (e1, e2) \n#> paste0(e1, \"+\", e2)\n```\n\n\n:::\n:::\n\n\n<details>\n<summary>Even more LaTeX syntax</summary>\n\n\n::: {.cell}\n\n```{.r .cell-code}\nknown_func_env <- child_env(\n .parent = empty_env(),\n \n # Binary operators\n `+` = binary_op(\" + \"),\n `-` = binary_op(\" - \"),\n `*` = binary_op(\" * \"),\n `/` = binary_op(\" / \"),\n `^` = binary_op(\"^\"),\n `[` = binary_op(\"_\"),\n\n # Grouping\n `{` = unary_op(\"\\\\left{ \", \" \\\\right}\"),\n `(` = unary_op(\"\\\\left( \", \" \\\\right)\"),\n paste = paste,\n\n # Other math functions\n sqrt = unary_op(\"\\\\sqrt{\", \"}\"),\n sin = unary_op(\"\\\\sin(\", \")\"),\n cos = unary_op(\"\\\\cos(\", \")\"),\n tan = unary_op(\"\\\\tan(\", \")\"),\n log = unary_op(\"\\\\log(\", \")\"),\n abs = unary_op(\"\\\\left| \", \"\\\\right| \"),\n frac = function(a, b) {\n paste0(\"\\\\frac{\", a, \"}{\", b, \"}\")\n },\n\n # Labelling\n hat = unary_op(\"\\\\hat{\", \"}\"),\n tilde = unary_op(\"\\\\tilde{\", \"}\")\n)\n```\n:::\n\n\n</details>\n\n\n## Unknown Symbols\n\n\n::: {.cell}\n\n```{.r .cell-code}\nnames_grabber <- function(x) {\n switch_expr(x,\n constant = character(),\n symbol = as.character(x),\n call = flat_map_chr(as.list(x[-1]), names_grabber)\n ) |>\n unique()\n}\n```\n:::\n\n\n$$x + y + f(a, b, c, 10)$$\n\n\n::: {.cell}\n\n```{.r .cell-code}\nnames_grabber(expr(x + y + f(a, b, c, 10)))\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> [1] \"x\" \"y\" \"a\" \"b\" \"c\"\n```\n\n\n:::\n:::\n\n\n\n::: {.cell}\n\n```{.r .cell-code}\nlobstr::ast(expr(x + y + f(a, b, c, 10)))\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> █─expr \n#> └─█─`+` \n#> ├─█─`+` \n#> │ ├─x \n#> │ └─y \n#> └─█─f \n#> ├─a \n#> ├─b \n#> ├─c \n#> └─10\n```\n\n\n:::\n:::\n\n\n\n## Unknown Functions\n\n\n::: {.cell}\n\n```{.r .cell-code}\ncalls_grabber <- function(x) {\n switch_expr(x,\n constant = ,\n symbol = character(),\n call = {\n fname <- as.character(x[[1]])\n children <- flat_map_chr(as.list(x[-1]), calls_grabber)\n c(fname, children)\n }\n ) |>\n unique()\n}\n```\n:::\n\n\n$$f(g + b, c, d(a))$$\n\n\n::: {.cell}\n\n```{.r .cell-code}\nnames_grabber(expr(f(g + b, c, d(a))))\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> [1] \"g\" \"b\" \"c\" \"a\"\n```\n\n\n:::\n\n```{.r .cell-code}\ncalls_grabber(expr(f(g + b, c, d(a))))\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> [1] \"f\" \"+\" \"d\"\n```\n\n\n:::\n\n```{.r .cell-code}\nlobstr::ast(expr(f(g + b, c, d(a))))\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> █─expr \n#> └─█─f \n#> ├─█─`+` \n#> │ ├─g \n#> │ └─b \n#> ├─c \n#> └─█─d \n#> └─a\n```\n\n\n:::\n:::\n\n\n---\n\n\n::: {.cell}\n\n```{.r .cell-code}\nseek_closure <- function(op) {\n # change math font for function names\n # apply ending parenthesis\n new_function(\n exprs(... = ),\n expr({\n contents <- paste(..., collapse = \", \")\n paste0(!!paste0(\"\\\\mathrm{\", op, \"}(\"), contents, \")\")\n })\n )\n}\n```\n:::\n\n\n## Bringing the LaTeX Together\n\n\n::: {.cell}\n\n```{.r .cell-code}\nlatex_env <- function(expr) {\n \n # Unknown Functions\n calls <- calls_grabber(expr)\n call_list <- map(set_names(calls), seek_closure)\n call_env <- as_environment(call_list)\n\n # Known Functions\n known_func_env <- env_clone(known_func_env, call_env)\n\n # Unknown Symbols\n names <- names_grabber(expr)\n symbol_env <- as_environment(set_names(names), parent = known_func_env)\n\n # Known symbols\n greek_env <- env_clone(greek_env, parent = symbol_env)\n greek_env\n}\n\nto_math <- function(x) {\n expr <- enexpr(x)\n latex( #return LaTeX code\n eval_bare( #eval_bare to ensure use of latex environment \n expr, #expression (not quosure)\n latex_env(expr) #need to define latex_env\n ))\n}\n```\n:::\n\n\n### Check\n\n\n::: {.cell}\n\n```{.r .cell-code}\nto_math(sin(pi) + f(a))\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n#> <LATEX> \\sin(\\pi) + \\mathrm{f}(a)\n```\n\n\n:::\n:::\n\n\n## Finishing the Example\n\n(TO DO)\n", 6 "supporting": [ 7 "21_files" 8 ], 9 "filters": [ 10 "rmarkdown/pagebreak.lua" 11 ], 12 "includes": { 13 "include-in-header": [ 14 "<link href=\"../site_libs/htmltools-fill-0.5.8.1/fill.css\" rel=\"stylesheet\" />\n<script src=\"../site_libs/htmlwidgets-1.6.4/htmlwidgets.js\"></script>\n<script src=\"../site_libs/d3-3.3.8/d3.min.js\"></script>\n<script src=\"../site_libs/dagre-0.4.0/dagre-d3.min.js\"></script>\n<link href=\"../site_libs/mermaid-0.3.0/dist/mermaid.css\" rel=\"stylesheet\" />\n<script src=\"../site_libs/mermaid-0.3.0/dist/mermaid.slim.min.js\"></script>\n<link href=\"../site_libs/DiagrammeR-styles-0.2/styles.css\" rel=\"stylesheet\" />\n<script src=\"../site_libs/chromatography-0.1/chromatography.js\"></script>\n<script src=\"../site_libs/DiagrammeR-binding-1.0.11/DiagrammeR.js\"></script>\n" 15 ] 16 }, 17 "engineDependencies": {}, 18 "preserve": {}, 19 "postProcess": true 20 } 21 }