1:- module(mathml, [pl_mathml/2, pl_mathml/3, pl_mathjax/2, pl_mathjax/3]).    2
    3:- discontiguous mathml/0, math/2, math/3, math/4, current/3, paren/3, prec/3.    4:- discontiguous type/3, denoting/3, ml/3, jax/3.
    5
    6:- use_module(library(http/html_write)).    7:- use_module(library(rolog)).    8
    9% Hook to defined own macros
   10%
   11% Example
   12% assert(math_hook(t0, subscript(t, 0))).
   13%
   14% From R, the hook is installed by
   15% mathml:hook(t0, subscript(t, 0))
   16%
   17:- dynamic math_hook/2, math_hook/3, math_hook/4.   18:- multifile math_hook/2, math_hook/3, math_hook/4.   19
   20% Low-level functions (see, e.g. nthroot.pl)
   21%
   22% Example
   23% see nthroot.pl
   24%
   25:- multifile mlx/3.    % translate term to mathml
   26:- multifile jaxx/3.   % translate to LaTeX
   27:- multifile precx/3.  % operator precedence
   28:- multifile parenx/3. % count parentheses
   29:- multifile typex/3.  % some type information
   30
   31% Translate prolog expression to MathML string
   32%
   33% Example
   34% pl_mathml(sin(pi/2), M).
   35%
   36pl_mathml(R, S)
   37=> pl_mathml(R, S, []).
   38
   39% The flags allow for context-dependent translation
   40%
   41% Examples
   42% see vignette of R package mathml
   43%
   44pl_mathml(R, S, Flags)
   45 => mathml(R, M, Flags),
   46    html(M, H, []),
   47    maplist(atom_string, H, S).
   48
   49% R interface: Translate R expression to MathJax string
   50pl_mathjax(R, S)
   51 => pl_mathjax(R, S, []).
   52
   53pl_mathjax(R, S, Flags)
   54 => mathjax(R, S, Flags).
   55
   56% Translate R expression to HTML/MathJax term
   57mathml(R, M, Flags)
   58 => ml(R, M0, Flags),
   59    denoting(R, Denoting, Flags),
   60    ml(with(Denoting), With, Flags),
   61    !, M = [math(M0), With].
   62
   63mathjax(R, M, Flags)
   64 => jax(R, M0, Flags),
   65    denoting(R, Denoting, Flags),
   66    jax(with(Denoting), With, Flags),
   67    !, format(string(M), "$~w$~w", [M0, With]).
   68
   69% Translates the compound A to another compound M, checking for Flags
   70% and eventually changing Flags to Flags1
   71%
   72macro(A, A1, Flags, Flags1) :-
   73    math_hook(A, A0, Flags, Flags0),
   74    !, Flags1 = Flags0,
   75    A1 = A0.
   76
   77macro(A, A1, Flags, Flags1) :-
   78    math_hook(A, A0, Flags),
   79    !, Flags1 = Flags,
   80    A1 = A0.
   81
   82macro(A, A1, Flags, Flags1) :-
   83    math_hook(A, A0),
   84    !, Flags1 = Flags,
   85    A1 = A0.
   86
   87macro(A, M, Flags, Flags1) :-
   88    math(A, M, Flags, Flags1),   % math/4 macro changing Flags
   89    dif(Flags-A, Flags1-M).
   90
   91macro(A, M, Flags, Flags) :-
   92    math(A, M, Flags),           % math/3 only reading Flags
   93    dif(A, M).
   94
   95macro(A, M, Flags, Flags) :-
   96    math(A, M),                  % math/2 ignoring the flags
   97    dif(A, M).
   98
   99% Main MathML translation
  100%
  101% R: R expression
  102% M: HTML term
  103% Flags: to control some aspects of the output
  104%
  105% This predicate only checks if a macro can be applied. Add ml/3 predicates for
  106% R expressions with their translation below.
  107%
  108ml(R, M, Flags),
  109    macro(R, R1, Flags, Flags1)
  110 => ml(R1, M, Flags1).
  111
  112ml(R, M, Flags),
  113    mlx(R, R1, Flags)            % R hook into ml/3
  114 => M = R1.
  115
  116% Same for MathJax/LaTeX
  117jax(R, M, Flags),
  118    macro(R, R1, Flags, Flags1)
  119 => jax(R1, M, Flags1).
  120
  121jax(R, M, Flags),
  122    jaxx(R, R1, Flags)           % R hook
  123 => M = R1.
  124
  125% Return precedence of an R expression, to decide if parentheses are
  126% needed. Uses the usual Prolog precendence.
  127prec(R, Prec, Flags),
  128    macro(R, R1, Flags, Flags1)
  129 => prec(R1, Prec, Flags1).
  130
  131prec(R, Prec, Flags),
  132    precx(R, Prec1, Flags)
  133 => Prec = Prec1.
  134
  135% Return parentheses counter of an R expression. Needed to decide
  136% which shape is chosen (), [], {}, and restarting again with ().
  137paren(R, Paren, Flags),
  138    macro(R, R1, Flags, Flags1)
  139 => paren(R1, Paren, Flags1).
  140
  141paren(R, Paren, Flags),
  142    parenx(R, Paren1, Flags)
  143 => Paren = Paren1.
  144
  145% Return some extra type information as a list.
  146type(R, Type, Flags),
  147    macro(R, R1, Flags, Flags1)
  148 => type(R1, Type, Flags1).
  149
  150type(R, Type, Flags),
  151    typex(R, Type1, Flags)
  152 => Type = Type1.
  153
  154% Suppress the names of function arguments from R
  155%
  156% For instance, the R expression dbinom(x=5, size=20, prob=0.6) is
  157% handed over to mathml as dbinom(name(x) = 5, name(size) = ...). This
  158% macro removes the name of the arguments.
  159math(name(_) = R, M)
  160 => M = R.
  161
  162% These two predicate are only used for ad hoc testing from within
  163% Prolog.
  164%
  165% Examples
  166% mathml(sin(x)).
  167% mathjax(sin(x)).
  168%
  169% mathml :-
  170%     mathml(sin(x)).
  171%
  172mathml(R) :-
  173    r2mathml(R, M),
  174    atomic_list_concat(M, S),
  175    writeln(R-S).
  176
  177mathjax(R) :-
  178    r2mathjax(R, M),
  179    atomic_list_concat(M, S),
  180    writeln(R-S).
  181
  182% Performance can be a bit improved by putting Flags at the end of the
  183% list of arguments and having the R term as the first argument.
  184% However, some rules below use maplist. There it is convenient to have
  185% Flags in the beginning.
  186ml_(Flags, R, M)
  187 => ml(R, M, Flags).
  188
  189jax_(Flags, R, M)
  190 => jax(R, M, Flags).
  191
  192paren_(Flags, R, Paren)
  193 => paren(R, Paren, Flags).
  194
  195denoting_(Flags, R, Den)
  196 => denoting(R, Den, Flags).
  197
  198% Summation sign, product sign
  199%
  200% Sigma_range Arg
  201% Sigma_from^to Arg
  202%
  203% Same for product and Pi
  204%
  205math(sum_over(Arg, Range), M)
  206 => M = fn(subscript(sum, Range), [Arg]).
  207
  208math(sum_over(Arg, From, To), M)
  209 => M = fn(subsupscript(sum, From, To), [Arg]).
  210
  211mathml :-
  212    mathml(sum_over('['(x, i), i)).
  213
  214mathml :-
  215    mathml(sum_over('['(x, i), i=1, n)).
  216
  217math(prod_over(Arg, Range), M)
  218 => M = fn(subscript(prod, Range), [Arg]).
  219
  220math(prod_over(Arg, From, To), M)
  221 => M = fn(subsupscript(prod, From, To), [Arg]).
  222
  223mathml :-
  224    mathml(prod_over('['(x, i), i)).
  225
  226mathml :-
  227    mathml(prod_over('['(x, i), i=1, n)).
  228
  229% Subscripts like x[i]
  230%
  231% Terms like x[i] are first translated to subscript(x, i). Then, it is
  232% tested if the base is actually a power, and cases with simultaneous
  233% index and power are translated to subsubscript(x, index, power). This
  234% is necessary to avoid extra space in terms like x_i^2.
  235%
  236base(A, Base, Flags) :-
  237    type(A, Type, Flags),
  238    member(base(Base), Type).
  239
  240index(A, Idx, Flags) :-
  241    type(A, Type, Flags),
  242    member(index(Idx), Type).
  243
  244power(A, Pwr, Flags) :-
  245    type(A, Type, Flags),
  246    member(power(Pwr), Type).
  247
  248math(A, M, _Flags),
  249    compound(A),
  250    compound_name_arguments(A, '[', [Base | Idx])
  251 => M = subscript(Base, list("", Idx)).
  252
  253math(subscript(A, Idx), M, Flags),
  254    power(A, Pwr, Flags),
  255    base(A, Base, Flags)
  256 => M = subsupscript(Base, Idx, Pwr).
  257
  258ml(subscript(Base, Idx), M, Flags)
  259 => ml(Base, X, Flags),
  260    ml(Idx, Y, Flags),
  261    M = msub([X, Y]).
  262
  263jax(subscript(Base, Idx), M, Flags)
  264 => jax(Base, X, Flags),
  265    jax(Idx, Y, Flags),
  266    format(string(M), "{~w}_{~w}", [X, Y]).
  267
  268prec(subscript(Base, _Idx), P, Flags)
  269 => prec(Base, P, Flags).
  270
  271type(subscript(Base, Idx), Type, Flags)
  272 => type(Base, T, Flags),
  273    Type = [base(Base), index(Idx) | T].
  274
  275mathml :-
  276    mathml(subscript(x, i)).
  277
  278mathml :-
  279    mathml('['(x, i)).
  280
  281mathml :-
  282    mathml('['(x, i, 2)).
  283
  284% Under
  285
  286%
  287% Check for under(over(A, Power), Index)
  288%
  289math(under(A, Idx), X, Flags, New),
  290    type(A, over(Bas, Pwr), Flags)
  291 => New = [replace(over(Bas, Pwr), underover(Bas, Idx, Pwr)) | Flags],
  292    X = A. 
  293
  294ml(under(A, B), M, Flags)
  295 => ml(A, X, Flags),
  296    ml(B, Y, Flags),
  297    M = munder([X, Y]).
  298
  299paren(under(A, _), Paren, Flags)
  300 => paren(A, Paren, Flags).
  301
  302prec(under(A, _), Prec,Flags)
  303 => prec(A, Prec, Flags).
  304
  305type(under(A, B), Type, _Flags)
  306 => Type = under(A, B).
  307
  308jax(under(A, B), M, Flags)
  309 => jax(A, X, Flags),
  310    jax(B, Y, Flags),
  311    format(string(M), "{~w}/limits_{~w}", [X, Y]).
  312
  313% Superscripts like s^2
  314%
  315% See above for terms that have an index and a power at the same time.
  316%
  317math(Base^Pwr, M, _Flags)
  318 => M = superscript(Base, Pwr).
  319
  320math(superscript(A, Pwr), M, Flags),
  321    index(A, Idx, Flags),
  322    base(A, Base, Flags)
  323 => M = subsupscript(Base, Idx, Pwr).
  324
  325% Avoid parenthesis in sin^2 x
  326math(superscript(Base, Pwr), M, Flags),
  327    type(Base, Type, Flags),
  328    \+ member(special, Type),
  329    prec(Base, P, Flags),
  330    current_op(Hat, xfy, ^),
  331    P >= Hat
  332 => M = superscript(paren(Base), Pwr).
  333
  334ml(superscript(Base, Pwr), M, Flags)
  335 => ml(Base, X, Flags),
  336    ml(Pwr, Y, Flags),
  337    M = msup([X, Y]).
  338
  339jax(superscript(Base, Pwr), M, Flags)
  340 => jax(Base, X, Flags),
  341    jax(Pwr, Y, Flags),
  342    format(string(M), "{~w}^{~w}", [X, Y]).
  343
  344prec(superscript(_Base, _Pwr), P, _Flags)
  345 => current_op(P, xfy, ^).
  346
  347type(superscript(Base, Pwr), Type, Flags)
  348 => type(Base, T, Flags),
  349    Type = [base(Base), power(Pwr) | T].
  350
  351mathml :-
  352    mathml(superscript(x, 2)).
  353
  354mathml :-
  355    mathml(x^2).
  356
  357mathml :-
  358    mathml(-1 ^ 2).
  359
  360% Over
  361
  362%
  363% Check for over(under(A, Index), Power)
  364%
  365math(over(A, Pwr), X, Flags, New),
  366    type(A, under(Bas, Idx), Flags)
  367 => New = [replace(under(Bas, Idx), underover(Bas, Idx, Pwr)) | Flags],
  368    X = A. 
  369
  370ml(over(A, B), M, Flags)
  371 => ml(A, X, Flags),
  372    ml(B, Y, Flags),
  373    M = mover([X, Y]).
  374
  375paren(over(A, _), Paren, Flags)
  376 => paren(A, Paren, Flags).
  377
  378prec(over(_, _), Prec, _Flags)
  379 => current(Prec, xfy, ^).
  380
  381type(over(A, B), Type, _Flags)
  382 => Type = over(A, B).
  383
  384jax(over(A, B), M, Flags)
  385 => jax(A, X, Flags),
  386    jax(B, Y, Flags),
  387    format(string(M), "{~w}/limits^{~w}", [X, Y]).
  388
  389% Subscripts and superscripts
  390%
  391math(subsupscript(Base, Idx, Pwr), M, Flags),
  392    type(Base, Type, Flags),
  393    \+ member(special, Type),
  394    prec(Base, P, Flags),
  395    current_op(Hat, xfy, ^),
  396    P >= Hat
  397 => M = subsupscript(paren(Base), Idx, Pwr).
  398
  399ml(subsupscript(Base, Idx, Pwr), M, Flags)
  400 => ml(Base, X, Flags),
  401    ml(Idx, Y, Flags),
  402    ml(Pwr, Z, Flags),
  403    M = msubsup([X, Y, Z]).
  404
  405jax(subsupscript(Base, Idx, Pwr), M, Flags)
  406 => jax(Base, X, Flags),
  407    jax(Idx, Y, Flags),
  408    jax(Pwr, Z, Flags),
  409    format(string(M), "{~w}_{~w}^{~w}", [X, Y, Z]).
  410
  411prec(subsupscript(Base, _Idx, Pwr), P, Flags)
  412 => prec(subscript(Base, Pwr), P, Flags).
  413
  414type(subsupscript(Base, Idx, Pwr), Type, Flags)
  415 => type(Base, T, Flags),
  416    Type = [base(Base), index(Idx), power(Pwr) | T].
  417
  418mathml :-
  419    mathml(subsupscript(x, i, 2)).
  420
  421mathml :-
  422    mathml(subsupscript(-1, i, 2)).
  423
  424mathml :-
  425    mathml('['(x, i)^2).
  426
  427% Underover
  428ml(underover(A, B, C), M, Flags)
  429 => ml(A, X, Flags),
  430    ml(B, Y, Flags),
  431    ml(C, Z, Flags),
  432    M = munderover([X, Y, Z]).
  433
  434paren(underover(A, _, _), Paren, Flags)
  435 => paren(A, Paren, Flags).
  436
  437prec(underover(A, _, C), Prec, Flags)
  438 => prec(over(A, C), Prec, Flags).
  439
  440type(underover(A, B, C), Type, _Flags)
  441 => Type = underover(A, B, C).
  442
  443math(under(A, Idx), X, Flags, New),
  444    type(A, over(Bas, Pwr, Flags), Flags)
  445 => New = [replace(over(Bas, Pwr), underover(Bas, Idx, Pwr)) | Flags],
  446    X = A. 
  447
  448jax(underover(A, B, C), M, Flags)
  449 => jax(A, X, Flags),
  450    jax(B, Y, Flags),
  451    jax(C, Z, Flags),
  452    format(string(M), "{~w}/limits_{~w}^{~w}", [X, Y, Z]).
  453
  454%
  455% Hyphen
  456%
  457math(hyph(L, R), M, _Flags)
  458 =>  M = hyph(L, R).
  459
  460ml(hyph(L, R), M, Flags)
  461 => ml(L, X, Flags),
  462    ml(R, Y, Flags),
  463    M = mrow([X, &('#8209'), Y]). 
  464
  465jax(hyph(L, R), M, Flags)
  466 => jax(L, X, Flags),
  467    jax(R, Y, Flags),
  468    format(string(M), "\\mbox{{~w}{-}{~w}}", [X, Y]). 
  469
  470%
  471% Colours 
  472%
  473math(color(C, A), M, _Flags)
  474 => M = color(C, A).
  475
  476ml(color(C, A), M, Flags),
  477    atom(C)
  478 => member(color(C, S), Flags),
  479    ml(color(S, A), M, Flags).
  480
  481ml(color(C, A), M, Flags),
  482    string(C)
  483 => ml(A, X, Flags),
  484    M = mrow(style("color: ~w"-C), X).
  485
  486jax(color(C, A), M, Flags)
  487 => jax(A, X, Flags),
  488    format(string(M), "\\color{~w}{~w}", [C, X]). 
  489    
  490type(color(_C, A), T, Flags)
  491 => type(A, T, Flags).
  492
  493% Strings are translated to upright text
  494math(R, M),
  495    string(R)
  496 => M = text(R).
  497
  498ml(text(R), M, _Flags)
  499 => M = mtext(R).
  500
  501jax(text(R), M, _Flags)
  502 => format(string(M), "\\mathrm{~w}", [R]).
  503
  504type(text(_), T, _Flags)
  505 => T = [atomic].
  506
  507mathml :-
  508    mathml("text").
  509
  510mathjax :-
  511    mathjax("text").
  512
  513% Atoms with the name of greek letters are shown in greek
  514math(R, M),
  515    atom(R),
  516    memberchk(R, [alpha, beta, gamma, delta, epsilon, varepsilon, zeta, eta,
  517        theta, vartheta, iota, kappa, lambda, mu, nu, xi, pi, rho, sigma,
  518        varsigma, tau, upsilon, phi, varphi, chi, psi, omega, 'Gamma', 'Delta',
  519        'Theta', 'Lambda', 'Xi', 'Pi', 'Sigma', 'Upsilon', 'Phi', 'Psi',
  520        'Omega'])
  521 => M = greek(R).
  522
  523ml(greek(R), M, _Flags)
  524 => M = mi(&(R)).
  525
  526jax(greek(R), M, _Flags)
  527 => format(string(M), "\\~w", [R]).
  528
  529type(greek(_), T, _Flags)
  530 => T = [atomic].
  531
  532mathml :-
  533    mathml(alpha).
  534
  535% Some special symbols that are rendered as is in MathML and MathJax
  536%
  537% As it is now, this is only the diamond.
  538math(R, M),
  539    atom(R),
  540    memberchk(R, [diamond])
  541 => M = symbol(R).
  542
  543ml(symbol(R), M, _Flags)
  544 => M = mi(&(R)).
  545
  546jax(symbol(R), M, _Flags)
  547 => format(string(M), "\\~w", [R]).
  548
  549type(symbol(_), T, _Flags)
  550 => T = [atomic].
  551
  552% Booleans
  553math(true, M)
  554 => M = boolean("T").
  555
  556math(false, M)
  557 => M = boolean("F").
  558
  559ml(boolean(R), M, _Flags)
  560 => M = mi(R).
  561
  562jax(boolean(R), M, _Flags)
  563 => format(string(M), "~w", [R]).
  564
  565type(boolean(_), T, _Flags)
  566 => T = [atomic].
  567
  568mathml :-
  569    mathml(true),
  570    mathml(false).
  571
  572% Sets
  573%
  574% render is.null(A) as A = \emptyset
  575math('is.null'(R), M)
  576 => M = (R == null).
  577
  578math(null, M)
  579 => M = set(empty).
  580
  581ml(set(empty), M, _Flags)
  582 => M = mi(&(empty)).
  583
  584jax(set(empty), M, _Flags)
  585 => M = "\\emptyset".
  586
  587type(set(empty), T, _Flags)
  588 => T = [atomic].
  589
  590% Special functions with powers: sin^2(x)
  591%
  592% Note that powers are stored in the Flags.
  593math(sin(A), M, Flags, Flags2),
  594    select(superscript(Pwr), Flags, Flags1)
  595 => Flags2 = Flags1,
  596    M = fn(sin^Pwr, [A]).
  597
  598math(sinpi(A), M, Flags, Flags2),
  599    select(superscript(Pwr), Flags, Flags1)
  600 => Flags2 = Flags1,
  601    M = fn(sinpi^Pwr, [A]).
  602
  603math(cos(A), M, Flags, Flags2),
  604    select(superscript(Pwr), Flags, Flags1)
  605 => Flags2 = Flags1,
  606    M = fn(cos^Pwr, [A]).
  607
  608math(cospi(A), M, Flags, Flags2),
  609    select(superscript(Pwr), Flags, Flags1)
  610 => Flags2 = Flags1,
  611    M = fn(cospi^Pwr, [A]).
  612
  613math(tan(A), M, Flags, Flags2),
  614    select(superscript(Pwr), Flags, Flags1)
  615 => Flags2 = Flags1,
  616    M = fn(tan^Pwr, [A]).
  617
  618math(tanpi(A), M, Flags, Flags2),
  619    select(superscript(Pwr), Flags, Flags1)
  620 => Flags2 = Flags1,
  621    M = fn(tanpi^Pwr, [A]).
  622
  623% Special functions
  624%
  625special(A, _Flags) :-
  626    atom(A),
  627    memberchk(A, [sgn, sin, cos, tan, asin, arcsin, acos, arccos, atan,
  628        arctan, arctan2, sinh, cosh, tanh, arsinh, arcosh, artanh, log,
  629        exp, sum, prod, min, max, argmin, argmax]).
  630
  631math(R, M, Flags),
  632    special(R, Flags)
  633 => M = special(R).
  634
  635% Summation sign is an operator
  636ml(special(sum), M, _Flags)
  637 => M = mo(&(sum)).
  638
  639prec(special(sum), Prec, _Flags)
  640 => current(P, yfx, *),
  641    Prec is P + 1.
  642
  643ml(special(prod), M, _Flags)
  644 => M = mo(&(prod)).
  645
  646prec(special(prod), Prec, _Flags)
  647 => current(P, yfx, *),
  648    Prec is P.
  649
  650ml(special(R), M, _Flags)
  651 => M = mi(R).
  652
  653jax(special(sgn), M, _Flags)
  654 => M = "\\mathrm{sgn}\\,".
  655
  656jax(special(argmin), M, _Flags)
  657 => M = "\\arg\\min".
  658
  659jax(special(argmax), M, _Flags)
  660 => M = "{\\arg\\max}".
  661
  662jax(special(R), M, _Flags)
  663 => format(string(M), "\\~w", [R]).
  664
  665type(special(_), T, _Flags)
  666 => T = [special].
  667
  668prec(special(sin), Prec, _Flags)
  669 => Prec = 0.
  670
  671prec(special(cos), Prec, _Flags)
  672 => Prec = 0.
  673
  674prec(special(tan), Prec, _Flags)
  675 => Prec = 0.
  676
  677prec(special(sinh), Prec, _Flags)
  678 => Prec = 0.
  679
  680prec(special(cosh), Prec, _Flags)
  681 => Prec = 0.
  682
  683prec(special(tanh), Prec, _Flags)
  684 => Prec = 0.
  685
  686prec(special(exp), Prec, _Flags)
  687 => Prec = 0.
  688
  689prec(special(_), Prec, _Flags)
  690 => current(Prec, yfx, *).
  691
  692mathml :-
  693    mathml(exp(x)),
  694    mathml(exp(x + y)).
  695
  696% Space
  697%
  698math(space, M)
  699 => M = space(thinmathspace).
  700
  701ml(space(W), M, _Flags)
  702 => M = mspace(width(W), []).
  703
  704jax(space(thinmathspace), M, _Flags)
  705 => M = "\\,".
  706
  707jax(space(_Width), M, _Flags)
  708 => M = "\\ ".
  709
  710% Atoms (in R, "symbols" or "names") are rendered in the
  711% usual italic font (MathML renders multiletter atoms in upright font).
  712%
  713% Possible decorations: plain, bold, italic, cal (= calligraphic)
  714%
  715math(R, M),
  716    atom(R)
  717 => M = ident(R).
  718
  719math(plain(R), M, Flags0, Flags1)
  720 => M = R,
  721    Flags1 = [mathvariant(plain) | Flags0].
  722
  723math(bold(R), M, Flags0, Flags1)
  724 => M = R,
  725    Flags1 = [mathvariant(bold) | Flags0].
  726
  727math(italic(R), M, Flags0, Flags1)
  728 => M = R,
  729    Flags1 = [mathvariant(italic) | Flags0].
  730
  731math(cal(A), M, Flags, New)
  732 => New = [mathvariant(calligraphy) | Flags],
  733    M = A.
  734
  735ml(ident(R), M, Flags),
  736    member(mathvariant(calligraphy), Flags)
  737 => M = mi(mathvariant(script), R).
  738
  739ml(ident(R), M, Flags),
  740    member(mathvariant(plain), Flags)
  741 => M = mi(mathvariant(normal), R).
  742
  743ml(ident(R), M, Flags),
  744    member(mathvariant(italic), Flags)
  745 => M = mi(mathvariant(italic), R).
  746
  747ml(ident(R), M, Flags),
  748    member(mathvariant(bold), Flags)
  749 => M = mi(mathvariant(bold), R).
  750
  751ml(ident(R), M, _Flags)
  752 => M = mi(R).
  753
  754jax(ident(R), M, Flags),
  755    member(mathvariant(calligraphy), Flags)
  756 => format(string(M), "\\mathcal{~w}", [R]).
  757
  758jax(ident(R), M, Flags),
  759    member(mathvariant(plain), Flags)
  760 => format(string(M), "\\mathrm{~w}", [R]).
  761
  762jax(ident(R), M, Flags),
  763    member(mathvariant(italic), Flags)
  764 => format(string(M), "\\mathit{~w}", [R]).
  765
  766jax(ident(R), M, Flags),
  767    member(mathvariant(bold), Flags)
  768 => format(string(M), "\\mathbf{~w}", [R]).
  769
  770jax(ident(R), M, _Flags)
  771 => format(string(M), "~w", [R]).
  772
  773type(ident(_), T, _Flags)
  774 => T = [atomic].
  775
  776% Linear model (render the equation)
  777math(lm(F, _Data), M)
  778 => M = F.
  779
  780% Functions from the R package base
  781%
  782% ignore return
  783math(return(X), M)
  784 => M = X.
  785
  786% |x|
  787math(length(R), M)
  788 => M = abs(R).
  789
  790ml(abs(R), M, Flags)
  791 => ml(R, X, Flags),
  792    M = mrow([mo(&(vert)), X, mo(&(vert))]).
  793
  794jax(abs(R), M, Flags)
  795 => jax(R, X, Flags),
  796    format(string(M), "{\\left\\vert{~w}\\right\\vert}", [X]).
  797
  798paren(abs(_), P, _Flags)
  799 => P = 0.
  800
  801prec(abs(R), P, Flags)
  802 => prec(paren(R), P, Flags).
  803
  804math(sign(R), M)
  805 => M = fn(sgn, [R]).
  806
  807ml(sqrt(R), M, Flags)
  808 => ml(R, X, Flags),
  809    M = msqrt(X).
  810
  811jax(sqrt(A), M, Flags)
  812 => jax(A, X, Flags),
  813    format(string(M), "\\sqrt{~w}", [X]).
  814
  815paren(sqrt(_), P, _Flags)
  816 => P = 0.
  817
  818prec(sqrt(_), P, _Flags)
  819 => current_op(P0, xfy, ^),
  820    P is P0 + 1.
  821
  822math(sin(A), M)
  823 => M = fn(sin, [A]).
  824
  825math(cos(A), M)
  826 => M = fn(cos, [A]).
  827
  828math(tan(A), M)
  829 => M = fn(tan, [A]).
  830
  831math(asin(A), M)
  832 => M = fn(superscript(sin, -1), [A]).
  833
  834math(arcsin(A), M)
  835 => M = fn(superscript(sin, -1), [A]).
  836
  837math(acos(A), M)
  838 => M = fn(superscript(cos, -1), [A]).
  839
  840math(arccos(A), M)
  841 => M = fn(superscript(cos, -1), [A]).
  842
  843math(atan(A), M)
  844 => M = fn(superscript(tan, -1), [A]).
  845
  846math(arctan(A), M)
  847 => M = fn(superscript(tan, -1), [A]).
  848
  849math(atan2(A, B), M)
  850 => M = fn(superscript(tan, -1), [A, B]).
  851
  852math(sinpi(A), M)
  853 => M = fn(sin, [A*pi]).
  854
  855math(cospi(A), M)
  856 => M = fn(cos, [A*pi]).
  857
  858math(tanpi(A), M)
  859 => M = fn(tan, [A*pi]).
  860
  861math(sinh(A), M)
  862 => M = fn(sinh, [A]).
  863
  864math(cosh(A), M)
  865 => M = fn(cosh, [A]).
  866
  867math(tanh(A), M)
  868 => M = fn(tanh, [A]).
  869
  870math(asinh(A), M)
  871 => M = fn(superscript(sinh, -1), [A]).
  872
  873math(acosh(A), M)
  874 => M = fn(superscript(cosh, -1), [A]).
  875
  876math(atanh(A), M)
  877 => M = fn(superscript(tanh, -1), [A]).
  878
  879% Show all as forall
  880math(all(A), M)
  881 => M = forall(A).
  882
  883ml(forall(A), M, Flags)
  884 => ml(A, X, Flags),
  885    M = mrow([mo(&('ForAll')), mo(&(af)), X]).
  886
  887jax(forall(A), M, Flags)
  888 => jax(A, X, Flags),
  889    format(string(M), "\\forall{~w}", [X]).
  890
  891paren(forall(A), P, Flags)
  892 => paren(A, P, Flags).
  893
  894prec(forall(_), P, _Flags)
  895 => current(P, yfx, *).
  896
  897% Show any as exists
  898math(any(A), M)
  899 => M = exists(A).
  900
  901ml(exists(A), M, Flags)
  902 => ml(A, X, Flags),
  903    M = mrow([mo(&('Exists')), mo(&(af)), X]).
  904
  905jax(exists(A), M, Flags)
  906 => jax(A, X, Flags),
  907    format(string(M), "\\exists{~w}", [X]).
  908
  909paren(exists(A), P, Flags)
  910 => paren(A, P, Flags).
  911
  912prec(exists(_), P, _Flags)
  913 => current(P, yfx, *).
  914
  915math(besselI(X, Nu), M)
  916 => M = fn(subscript('I', Nu), [paren(X)]).
  917
  918math(besselK(X, Nu), M)
  919 => M = fn(subscript('K', Nu), [paren(X)]).
  920
  921math(besselJ(X, Nu), M)
  922 => M = fn(subscript('J', Nu), [paren(X)]).
  923
  924math(besselY(X, Nu), M)
  925 => M = fn(subscript('Y', Nu), [paren(X)]).
  926
  927math(beta(A, B), M)
  928 => M = fn('B', [A, B]).
  929
  930math(lbeta(A, B), M)
  931 => M = log(beta(A, B)).
  932
  933math(gamma(A), M)
  934 => M = fn('Gamma', [paren(A)]).
  935
  936math(lgamma(A), M)
  937 => M = log(gamma(A)).
  938
  939math(digamma(A), M)
  940 => M = frac(d, d*A) * log(gamma(A)).
  941
  942math(trigamma(A), M)
  943 => M = frac(d^2, (d*A)^2) * log(gamma(A)).
  944
  945math(psigamma(x=A, deriv=Deriv), M)
  946 => M = psigamma(A, Deriv).
  947
  948math(psigamma(A, Deriv), M)
  949 => M = frac(d^(Deriv+2), (d*A)^(Deriv+2)) * log(gamma(A)).
  950
  951ml(choose(N, K), M, Flags)
  952 => ml(N, X, Flags),
  953    ml(K, Y, Flags),
  954    M = mrow([mo('('), mfrac([linethickness(0)], [X, Y]), mo(')')]).
  955
  956jax(choose(N, K), M, Flags)
  957 => jax(N, X, Flags),
  958    jax(K, Y, Flags),
  959    format(string(M), "\\binom{~w}{~w}", [X, Y]).
  960
  961paren(choose(_, _), P, _Flags)
  962 => P = 1.
  963
  964prec(choose(_, _), P, _Flags)
  965 => P = 0.
  966
  967type(choose(_, _), T, _Flags)
  968 => T = paren.
  969
  970math(lchoose(N, K), M)
  971 => M = log(choose(N, K)).
  972
  973math(factorial(N), M)
  974 => current(Prec, xfy, ^),
  975    M = yf(Prec, !, N).
  976
  977math(lfactorial(N), M)
  978 => M = log(factorial(N)).
  979
  980math(and(A, B), M)
  981 => current(Prec, xfy, ','),
  982    M = xfy(Prec, and, A, B).
  983
  984math(or(A, B), M)
  985 => current(Prec, xfy, ';'),
  986    M = xfy(Prec, or, A, B).
  987
  988math(!(A), M)
  989 => current(Prec, xfy, ','),
  990    M = fy(Prec, not, A).
  991
  992math(!(A, B), M)
  993 => current(Prec, xfy, ^),
  994    M = xfy(Prec, not, A, B).
  995
  996math(xor(x=A, y=B), M)
  997 => M = xor(A, B).
  998
  999math(xor(A, B), M)
 1000 => current(Prec, xfy, ';'),
 1001    M = xfy(Prec, veebar, A, B).
 1002
 1003math(exp(A), M)
 1004 => M = fn(exp, [A]).
 1005
 1006math(expm1(A), M)
 1007 => M = exp(A) - 1.
 1008
 1009math(log(X), M)
 1010 => M = fn(log, [X]).
 1011
 1012math(log10(X), M)
 1013 => M = logb(X, 10).
 1014
 1015math(log2(X), M)
 1016 => M = logb(X, 2).
 1017
 1018math(logb(X, B), M)
 1019 => M = fn(subscript(log, B), [X]).
 1020
 1021math(log1p(A), M)
 1022 => M = log(1 + A).
 1023
 1024ml(ceiling(A), M, Flags)
 1025 => ml(A, X, Flags),
 1026    M = mrow([mo(&(lceil)), X, mo(&(rceil))]).
 1027
 1028jax(ceiling(A), M, Flags)
 1029 => jax(A, X, Flags),
 1030    format(string(M), "\\lceil{~w}\\rceil", [X]).
 1031
 1032paren(ceiling(_), P, _Flags)
 1033 => P is 0.
 1034
 1035ml(floor(A), M, Flags)
 1036 => ml(A, X, Flags),
 1037    M = mrow([mo(&(lfloor)), X, mo(&(rfloor))]).
 1038
 1039jax(floor(A), M, Flags)
 1040 => jax(A, X, Flags),
 1041    format(string(M), "\\lfloor{~w}\\rfloor", [X]).
 1042
 1043paren(floor(_), P, _Flags)
 1044 => P is 0.
 1045
 1046% Represent function bodies as :-/2, '<-'/2
 1047math((_F :- Body), M)
 1048 => M = Body.
 1049
 1050math('<-'(R, S), M)
 1051 => M = (R == S).
 1052
 1053% Do not show curly brace around code blocks
 1054math(Curly, M, Flags),
 1055    compound(Curly),
 1056    compound_name_arguments(Curly, '{', Args)
 1057 => exclude(invisible_(Flags), Args, Args1),
 1058    M = body(Args1).
 1059
 1060invisible_(_Flags, invisible(_)).
 1061
 1062ml(body([R]), M, Flags)
 1063 => ml(R, M, Flags).
 1064
 1065ml(body(Body), M, Flags)
 1066 => maplist(ml_(Flags), Body, R),
 1067    M = mrow([mo('{'), mtable(columnalign(left), R)]).
 1068
 1069jax(body([R]), M, Flags)
 1070 => jax(R, M, Flags).
 1071
 1072jax(body(Body), M, Flags)
 1073 => maplist(jax_(Flags), Body, Ls),
 1074    atomic_list_concat(Ls, "}\\\\\n{", Rs),
 1075    format(string(M), "\\left\\{\\begin{array}{l}{~w}\\end{array}\\right.", [Rs]).
 1076
 1077% Hide (this is not phantom, see elsewhere)
 1078math(invisible(_), M, _Flags)
 1079 => M = ''.
 1080
 1081% Vectors: '##'(1, 2, 3) or '$$' or '%%' or '!!' for different types
 1082math(Hash, M, Flags),
 1083    option_(sep(Sep), Flags),
 1084    compound(Hash),
 1085    compound_name_arguments(Hash, Name, Elements),
 1086    member(Name, ['##', '$$', '%%', '!!'])
 1087 => M = paren(list(Sep, Elements)).
 1088
 1089math(Hash, M, _Flags),
 1090    compound(Hash),
 1091    compound_name_arguments(Hash, Name, Elements),
 1092    member(Name, ['##', '$$', '%%', '!!'])
 1093 => M = paren(Elements).
 1094
 1095% Prooftree: two tables are needed because of different attributes
 1096
 1097% For the table with two rows
 1098ml(proof_tree(A), M, Flags),
 1099    compound(A),
 1100    compound_name_arguments(A, Name, Rows),
 1101    member(Name, ['###2'])
 1102 => maplist(ml_row(Flags), Rows, R),
 1103    M = mrow([mtable([align('top 2'), rowlines(solid), framespacing('0 0'), semantics('bspr_inferenceRule:down')], R)]).
 1104
 1105% For the table with just one row
 1106ml(A, M, Flags),
 1107    compound(A),
 1108    compound_name_arguments(A, Name, Rows),
 1109    member(Name, ['###1'])
 1110 => maplist(ml_row2(Flags), Rows, R),
 1111    M = mrow([mtable([framespacing('0 0')], R)]).
 1112
 1113% Needed to set the attribute of the cell to "rowalign('bottom')"
 1114ml_row2(Flags, Row, M),
 1115    compound(Row),
 1116    compound_name_arguments(Row, Name, Cells),
 1117    member(Name, ['##', '$$', '%%', '!!'])
 1118 => maplist(ml_cell2(Flags), Cells, C),
 1119    M = mtr(C).
 1120
 1121ml_cell2(Flags, Cell, M)
 1122 => ml(Cell, C, Flags),
 1123    ml(mrow_attribute([semantics('bspr_inference:1;bspr_labelledRule:right')], C), C1, Flags),
 1124    M = mtd([rowalign('bottom')], C1).
 1125
 1126ml(mrow_attribute(Attr, A), M, _Flags)
 1127 => M = mrow(Attr, [A]).
 1128
 1129% Needed to add attributes
 1130ml_cell3(Flags, Cell, M)
 1131 => ml(func3(Cell), C, Flags),
 1132    M = mtd(C).
 1133
 1134ml(func3(A), M, Flags) 
 1135 => ml(A, M1, Flags),
 1136    %ml(mrow_attribute([data-mjx-textclass('ORD')], M1), M2, Flags),
 1137    M = mrow(mspace([width('.5ex')], mstyle([displaystyle('false'), scriptlevel('0')], M1))).
 1138
 1139/* This should be:
 1140 M = mrow(mspace([width('.5ex')]), mstyle([displaystyle('false'), scriptlevel('0')], M1)).
 1141
 1142so that the resulting line is <mrow><mspace width(".5ex")</mspace> ...</mrow>
 1143but it raises an error
 1144*/
 1145
 1146% Matrices
 1147ml(Matrix, M, Flags),
 1148    compound(Matrix),
 1149    compound_name_arguments(Matrix, Name, Rows),
 1150    member(Name, ['###', '$$$', '%%%', '!!!'])
 1151 => maplist(ml_row(Flags), Rows, R),
 1152    M = mrow([mo('('), mtable(columnalign(left), R), mo(')')]).
 1153
 1154ml_row(Flags, Row, M),
 1155    compound(Row),
 1156    compound_name_arguments(Row, Name, Cells),
 1157    member(Name, ['##', '$$', '%%', '!!'])
 1158 => maplist(ml_cell(Flags), Cells, C),
 1159    M = mtr(C).
 1160
 1161% Needed to add attributes with "ml_cell3 (see above)"
 1162ml_row(Flags, Row, M),
 1163    compound(Row),
 1164    compound_name_arguments(Row, Name, Cells),
 1165    member(Name, ['##1'])
 1166 => maplist(ml_cell3(Flags), Cells, C),
 1167    M = mtr(C).
 1168
 1169ml_cell(Flags, Cell, M)
 1170 => ml(Cell, C, Flags),
 1171    M = mtd(C).
 1172
 1173jax(Matrix, M, Flags),
 1174    compound(Matrix),
 1175    compound_name_arguments(Matrix, Name, [Row1 | Rows]),
 1176    member(Name, ['###', '$$$', '%%%', '!!!'])
 1177 => findall(c, arg(_, Row1, _), Ls),
 1178    atomic_list_concat(Ls, LLL),
 1179    maplist(jax_row(Flags), [Row1 | Rows], R),
 1180    atomic_list_concat(R, Lines),
 1181    format(string(M), "\\left(\\begin{array}{~w}~w\\end{array}\\right)", [LLL, Lines]).
 1182
 1183jax_row(Flags, Row, M),
 1184    compound(Row),
 1185    compound_name_arguments(Row, Name, Cells),
 1186    member(Name, ['##', '$$', '%%', '!!'])
 1187 => maplist(jax_cell(Flags), Cells, C),
 1188    atomic_list_concat(C, ' & ', R),
 1189    format(string(M), "~w\\\\\n", [R]).
 1190
 1191jax_cell(Flags, C, M)
 1192 => jax(C, X, Flags),
 1193    format(string(M), "~w", [X]).
 1194
 1195math(Identical, M),
 1196    compound(Identical),
 1197    compound_name_arguments(Identical, identical, [X, Y])
 1198 => M = (X == Y).
 1199
 1200% Distinguish cases
 1201ml(ifelse(T, Y, N), M, Flags)
 1202 => ml(T, Test, Flags),
 1203    ml(Y, Yes, Flags),
 1204    ml(N, No, Flags),
 1205    ml(space, S, Flags),
 1206    M = mrow([mo('{'),
 1207      mtable(columnalign(left),
 1208      [ mtr([Yes, mrow([mtext("if"), S, Test])]),
 1209        mtr([No, mtext("otherwise")])
 1210      ])]).
 1211
 1212jax(ifelse(T, Y, N), M, Flags)
 1213 => jax(T, Test, Flags),
 1214    jax(Y, Yes, Flags),
 1215    jax(N, No, Flags),
 1216    format(string(M),
 1217      "\\left\\{\\begin{array}{ll} {~w} & \\mathrm{if}~~{~w}\\\\ {~w} & \\mathrm{otherwise}\\end{array}\\right.",
 1218      [Yes, Test, No]).
 1219
 1220paren(ifelse(_, _, _), P, _Flags)
 1221 => P is 0.
 1222
 1223ml(if(T, Y), M, Flags)
 1224 => ml(T, Test, Flags),
 1225    ml(Y, Yes, Flags),
 1226    ml(space, S, Flags),
 1227    M = mrow([Yes, mtext(","), S, mtext("if"), S, Test]).
 1228
 1229jax(if(T, Y), M, Flags)
 1230 => jax(T, Test, Flags),
 1231    jax(Y, Yes, Flags),
 1232    format(string(M), "{~w},\\ \\mathrm{if}\\ {~w}", [Yes, Test]).
 1233
 1234paren(if(_, _), P, _Flags)
 1235 => P is 0.
 1236
 1237math('%in%'(X, Y), M)
 1238 => M = isin(X, Y).
 1239
 1240math(setdiff(X, Y), M)
 1241 => M = X - Y.
 1242
 1243math('%x%'(X, Y), M)
 1244 => M = kronecker(X, Y).
 1245
 1246math('&'(A, B), M)
 1247 => M = and(A, B).
 1248
 1249math('|'(A, B), M)
 1250 => M = or(A, B).
 1251
 1252ml(Prod, M, Flags),
 1253    compound(Prod),
 1254    compound_name_arguments(Prod, prod, Args)
 1255 => maplist(ml_(Flags), Args, MX),
 1256    M = mrow([mo(&(prod)), mrow(MX)]).
 1257
 1258jax(prod(A), M, Flags)
 1259 => jax(A, X, Flags),
 1260    format(string(M), "\\prod{~w}", [X]).
 1261
 1262jax(Prod, M, Flags),
 1263    compound(Prod),
 1264    compound_name_arguments(Prod, prod, Args)
 1265 => maplist(jax_(Flags), Args, X),
 1266    format(string(M), "\\prod{~w}", [X]).
 1267
 1268paren(Prod, P, Flags),
 1269    compound(Prod),
 1270    compound_name_arguments(Prod, prod, Args)
 1271 => maplist(paren_(Flags), Args, PX),
 1272    max_list(PX, P).
 1273
 1274prec(Prod, P, _Flags),
 1275    compound(Prod),
 1276    compound_name_arity(Prod, prod, _)
 1277 => current(P, yfx, *).
 1278
 1279math(Min, M),
 1280    compound(Min),
 1281    compound_name_arguments(Min, min, Args)
 1282 => M = fn(min, Args).
 1283
 1284math(Max, M),
 1285    compound(Max),
 1286    compound_name_arguments(Max, max, Args)
 1287 => M = fn(max, Args).
 1288
 1289math(t(A), M)
 1290 => M = A^"T".
 1291
 1292math(Which, M),
 1293    compound(Which),
 1294    compound_name_arguments(Which, which, Args)
 1295 => M = subscript("I", Args).
 1296
 1297math('which.max'(A), M)
 1298 => M = argmax(A).
 1299
 1300math('which.min'(A), M)
 1301 => M = argmin(A).
 1302
 1303math(arg(Min, Sub), M)
 1304 => M = subscript(nodot(arg, Min), Sub).
 1305
 1306% Extract value from a result (e.g., integrate)
 1307math($(Fn, "value"), M)
 1308 => M = Fn.
 1309
 1310% Integrate over range
 1311%
 1312% Case A: Fn is a function
 1313math(integrate(Fn, Lower, Upper), M, Flags),
 1314    Fn = (Head :- _Body),
 1315    compound(Head),
 1316    compound_name_arguments(Head, function, [DX | _]),
 1317    member(name-Name, Flags)
 1318 => M = integrate(fn(Name, [DX]), Lower, Upper, DX).
 1319
 1320math(integrate(Fn, Lower, Upper), M, _Flags),
 1321    Fn = (Head :- _Body),
 1322    compound(Head),
 1323    compound_name_arguments(Head, function, [DX | _])
 1324 => M = integrate(fn(lambda, [DX]), Lower, Upper, DX).
 1325
 1326% Case B: Fn is an atom (inquire R for argument names)
 1327math(integrate(Fn, Lower, Upper), M, _Flags),
 1328    atom(Fn)
 1329 => r_eval('['(formalArgs(args(Fn)), 1), Arg1),
 1330    atom_string(DX, Arg1),
 1331    M = integrate(fn(Fn, [DX]), Lower, Upper, DX).
 1332
 1333% Internal
 1334ml(integrate(Fn, From, To, DX), M, Flags)
 1335 => ml(Fn, XFn, Flags),
 1336    ml(From, XFrom, Flags),
 1337    ml(To, XTo, Flags),
 1338    ml(DX, XDX, Flags),
 1339    ml(space, Space, Flags),
 1340    M = mrow([munderover([mo(&(int)), XFrom, XTo]), XFn, Space, mi(d), XDX]).
 1341
 1342jax(integrate(Fn, From, To, DX), M, Flags)
 1343 => jax(Fn, XFn, Flags),
 1344    jax(From, XFrom, Flags),
 1345    jax(To, XTo, Flags),
 1346    jax(DX, XDX, Flags),
 1347    format(string(M), "\\int_{~w}^{~w}{~w}\\,{d{~w}}", [XFrom, XTo, XFn, XDX]).
 1348
 1349paren(integrate(_, _, _, A), Paren, Flags)
 1350 => paren(A, Paren, Flags).
 1351
 1352prec(integrate(_, _, _, _), Prec, _Flags)
 1353 => current(Prec, yfx, *).
 1354
 1355% Decorations
 1356math(roof(A), M)
 1357 => M = hat(A).
 1358
 1359ml(hat(A), M, Flags)
 1360 => ml(A, X, Flags),
 1361    M = mover(accent(true), [X, mo(&('Hat'))]).
 1362
 1363jax(hat(A), M, Flags)
 1364 => jax(A, X, Flags),
 1365    format(string(M), "\\hat{~w}", [X]).
 1366
 1367paren(hat(A), Paren, Flags)
 1368 => paren(A, Paren, Flags).
 1369
 1370prec(hat(A), Prec, Flags)
 1371 => prec(A, Prec, Flags).
 1372
 1373type(hat(A), Type, Flags)
 1374 => type(A, Type, Flags).
 1375
 1376ml(tilde(A), M, Flags)
 1377 => ml(A, X, Flags),
 1378    M = mover(accent(true), [X, mo(&(tilde))]).
 1379
 1380jax(tilde(A), M, Flags)
 1381 => jax(A, X, Flags),
 1382    format(string(M), "\\tilde{~w}", [X]).
 1383
 1384paren(tilde(A), Paren, Flags)
 1385 => paren(A, Paren, Flags).
 1386
 1387prec(tilde(A), Prec, Flags)
 1388 => prec(A, Prec, Flags).
 1389
 1390type(tilde(A), Type, Flags)
 1391 => type(A, Type, Flags).
 1392
 1393math(mean(A), M)
 1394 => M = overline(A).
 1395
 1396ml(overline(A), M, Flags)
 1397 => ml(A, X, Flags),
 1398    M = mover(accent(true), [X, mo(&(macr))]).
 1399
 1400jax(overline(A), M, Flags)
 1401 => jax(A, X, Flags),
 1402    format(string(M), "\\overline{~w}", [X]).
 1403
 1404paren(overline(A), Paren, Flags)
 1405 => paren(A, Paren, Flags).
 1406
 1407% Put overline(x)^2 in parentheses
 1408prec(overline(_), Prec, _Flags)
 1409 => current(P, yfx, *),
 1410    Prec = P.
 1411
 1412type(overline(A), Type, Flags)
 1413 => type(A, Type, Flags).
 1414
 1415ml(cancel(A), M, Flags)
 1416 => ml(A, X, Flags),
 1417    M = menclose(notation(updiagonalstrike), X).
 1418
 1419jax(cancel(A), M, Flags)
 1420 => jax(A, X, Flags),
 1421    format(string(M), "\\cancel{~w}", [X]).
 1422
 1423paren(cancel(A), Paren, Flags)
 1424 => paren(A, Paren, Flags).
 1425
 1426prec(cancel(A), Prec, Flags)
 1427 => prec(A, Prec, Flags).
 1428
 1429type(cancel(A), Type, Flags)
 1430 => type(A, Type, Flags).
 1431
 1432math(boxed(A), M)
 1433 => M = box(A).
 1434
 1435ml(box(A), M, Flags)
 1436 => ml(A, X, Flags),
 1437    M = menclose(notation(roundedbox), X).
 1438
 1439jax(box(A), M, Flags)
 1440 => jax(A, X, Flags),
 1441    format(string(M), "\\boxed{~w}", [X]).
 1442
 1443paren(box(A), Paren, Flags)
 1444 => paren(A, Paren, Flags).
 1445
 1446prec(box(A), Prec, Flags)
 1447 => prec(A, Prec, Flags).
 1448
 1449type(box(A), Type, Flags)
 1450 => type(A, Type, Flags).
 1451
 1452ml(phantom(A), M, Flags)
 1453 => ml(A, X, Flags),
 1454    M = mphantom(X).
 1455
 1456jax(phantom(A), M, Flags)
 1457 => jax(A, X, Flags),
 1458    format(string(M), "\\phantom{~w}", [X]).
 1459
 1460paren(phantom(A), Paren, Flags)
 1461 => paren(A, Paren, Flags).
 1462
 1463prec(phantom(A), Prec, Flags)
 1464 => prec(A, Prec, Flags).
 1465
 1466type(phantom(A), Type, Flags)
 1467 => type(A, Type, Flags).
 1468
 1469ml(prime(A), M, Flags)
 1470 => ml(A, X, Flags),
 1471    M = msup([X, mo(&('#x2032'))]).
 1472
 1473jax(prime(A), M, Flags)
 1474 => jax(A, X, Flags),
 1475    format(string(M), "{~w^\\prime}", [X]).
 1476
 1477paren(prime(A), Paren, Flags)
 1478 => paren(A, Paren, Flags).
 1479
 1480% Put prime(x)^2 in parentheses
 1481prec(prime(_), Prec, _Flags)
 1482 => current(P, yfx, *),
 1483    Prec = P.
 1484
 1485type(prime(A), Type, Flags)
 1486 => type(A, Type, Flags).
 1487
 1488%
 1489% Mathematical operators/signs
 1490%
 1491ml(op(le), M, _Flags)
 1492 => M = mo(&(le)).
 1493
 1494jax(op(le), M, _Flags)
 1495 => M = "\\le".
 1496
 1497ml(op(ge), M, _Flags)
 1498 => M = mo(&(ge)).
 1499
 1500jax(op(ge), M, _Flags)
 1501 => M = "\\ge".
 1502
 1503ml(op(ne), M, _Flags)
 1504 => M = mo(&(ne)).
 1505
 1506jax(op(ne), M, _Flags)
 1507 => M = "\\ne".
 1508
 1509ml(op('%.%'), M, _Flags)
 1510 => M = mo(&(sdot)).
 1511
 1512jax(op('%.%'), M, _Flags)
 1513 => M = "\\cdot".
 1514
 1515ml(op('%+-%'), M, _Flags)
 1516 => M = mo(&(pm)).
 1517
 1518jax(op('%+-%'), M, _Flags)
 1519 => M = "\\pm".
 1520
 1521ml(op('%*%'), M, _Flags)
 1522 => M = mo(&(times)).
 1523
 1524jax(op('%*%'), M, _Flags)
 1525 => M = "\\times".
 1526
 1527ml(op(sum), M, _Flags)
 1528 => M = mo(&(sum)).
 1529
 1530jax(op(sum), M, _Flags)
 1531 => M = "\\sum".
 1532
 1533ml(op(prod), M, _Flags)
 1534 => M = mo(&(prod)).
 1535
 1536jax(op(prod), M, _Flags)
 1537 => M = "\\prod".
 1538
 1539ml(op('#58'), M, _Flags)
 1540 => M = mo(&('#58')).
 1541
 1542jax(op('#58'), M, _Flags)
 1543 => M = ":".
 1544
 1545ml(op(','), M, _Flags)
 1546 => M = mo(',').
 1547
 1548jax(op(','), M, _Flags)
 1549 => M = ",".
 1550
 1551ml(op('CircleTimes'), M, _Flags)
 1552 => M = mo(&('CircleTimes')).
 1553
 1554jax(op('CircleTimes'), M, _Flags)
 1555 => M = "\\otimes".
 1556
 1557ml(op('#x2062'), M, _Flags)
 1558 => M = mo(&('#x2062')).
 1559
 1560jax(op('#x2062'), M, _Flags)
 1561 => M = "{}".
 1562
 1563ml(op('Tilde'), M, _Flags)
 1564 => M = mo(&('Tilde')).
 1565
 1566jax(op('Tilde'), M, _Flags)
 1567 => M = "\\sim".
 1568
 1569ml(op('%<->%'), M, _Flags)
 1570 => M = mo(&(leftrightarrow)).
 1571
 1572jax(op('%<->%'), M, _Flags)
 1573 => M = "\\leftrightarrow".
 1574
 1575ml(op('%<=>%'), M, _Flags)
 1576 => M = mo(&(iff)).
 1577
 1578jax(op('%<=>%'), M, _Flags)
 1579 => M = "\\iff".
 1580
 1581ml(op('%->%'), M, _Flags)
 1582 => M = mo(&(rightarrow)).
 1583
 1584jax(op('%->%'), M, _Flags)
 1585 => M = "\\rightarrow".
 1586
 1587ml(op('%=>%'), M, _Flags)
 1588 => M = mo(&(rArr)).
 1589
 1590jax(op('%=>%'), M, _Flags)
 1591 => M = "\\Rightarrow".
 1592
 1593ml(op('%<-%'), M, _Flags)
 1594 => M = mo(&(leftarrow)).
 1595
 1596jax(op('%<-%'), M, _Flags)
 1597 => M = "\\leftarrow".
 1598
 1599ml(op('%<=%'), M, _Flags)
 1600 => M = mo(&(lArr)).
 1601
 1602jax(op('%<=%'), M, _Flags)
 1603 => M = "\\Leftarrow".
 1604
 1605ml(op('%up%'), M, _Flags)
 1606 => M = mo(&(uparrow)).
 1607
 1608jax(op('%up%'), M, _Flags)
 1609 => M = "\\uparrow".
 1610
 1611ml(op('%dblup%'), M, _Flags)
 1612 => M = mo(&(uArr)).
 1613
 1614jax(op('%dblup%'), M, _Flags)
 1615 => M = "\\Uparrow".
 1616
 1617ml(op('%down%'), M, _Flags)
 1618 => M = mo(&(downarrow)).
 1619
 1620jax(op('%down%'), M, _Flags)
 1621 => M = "\\downarrow".
 1622
 1623ml(op('%dbldown%'), M, _Flags)
 1624 => M = mo(&(dArr)).
 1625
 1626jax(op('%dbldown%'), M, _Flags)
 1627 => M = "\\Downarrow".
 1628
 1629ml(op('%~~%'), M, _Flags)
 1630 => M = mo(&(approx)).
 1631
 1632jax(op('%~~%'), M, _Flags)
 1633 => M = "\\approx".
 1634
 1635ml(op('%==%'), M, _Flags)
 1636 => M = mo(&(equiv)).
 1637
 1638jax(op('%==%'), M, _Flags)
 1639 => M = "\\equiv".
 1640
 1641ml(op('%=~%'), M, _Flags)
 1642 => M = mo(&(cong)).
 1643
 1644jax(op('%=~%'), M, _Flags)
 1645 => M = "\\cong".
 1646
 1647ml(op('%prop%'), M, _Flags)
 1648 => M = mo(&(prop)).
 1649
 1650jax(op('%prop%'), M, _Flags)
 1651 => M = "\\propto".
 1652
 1653ml(op('%>%'), M, _Flags)
 1654 => M = mo(&('#x22A2')).
 1655
 1656ml(op('%<%'), M, _Flags)
 1657 => M = mo(&('#x22AC')).
 1658
 1659ml(op('%,%'), M, _Flags)
 1660 => M = mo(',').
 1661
 1662ml(op(and), M, _Flags)
 1663 => M = mo(&(and)).
 1664
 1665jax(op(and), M, _Flags)
 1666 => M = "\\land".
 1667
 1668ml(op(or), M, _Flags)
 1669 => M = mo(&(or)).
 1670
 1671ml(op('%|%'), M, _Flags)
 1672 => M = mo(&(or)).
 1673
 1674jax(op(or), M, _Flags)
 1675 => M = "\\lor".
 1676
 1677ml(op(not), M, _Flags)
 1678 => M = mo(&(not)).
 1679
 1680jax(op(not), M, _Flags)
 1681 => M = "\\lnot".
 1682
 1683ml(op(~), M, _Flags)
 1684 => M = mo(&(not)).
 1685
 1686ml(op(veebar), M, _Flags)
 1687 => M = mo(&(veebar)).
 1688
 1689jax(op(veebar), M, _Flags)
 1690 => M = "\\veebar".
 1691
 1692ml(op(isin), M, _Flags)
 1693 => M = mo(&(isin)).
 1694
 1695jax(op(isin), M, _Flags)
 1696 => M = "\\in".
 1697
 1698ml(op(notin), M, _Flags)
 1699 => M = mo(&(notin)).
 1700
 1701jax(op(notin), M, _Flags)
 1702 => M = "\\notin".
 1703
 1704ml(op(cap), M, _Flags)
 1705 => M = mo(&(cap)).
 1706
 1707jax(op(cap), M, _Flags)
 1708 => M = "\\cap".
 1709
 1710ml(op(cup), M, _Flags)
 1711 => M = mo(&(cup)).
 1712
 1713jax(op(cup), M, _Flags)
 1714 => M = "\\cup".
 1715
 1716ml(op(A), M, _Flags)
 1717 => M = mo(A).
 1718
 1719jax(op(A), M, _Flags)
 1720 => format(string(M), "~w", [A]).
 1721
 1722prec(op(A), P, _Flags),
 1723    current(P0, _Fix, A)
 1724 => P = P0.
 1725
 1726current(0, fy, op(sum)).
 1727
 1728denoting(op(_), D, _Flags)
 1729 => D = [].
 1730
 1731% Numbers
 1732%
 1733% To avoid unnecessary decimals for integers, make it explicit in R: x^2L
 1734%
 1735math(A, M),
 1736    integer(A),
 1737    A >= 0
 1738 => M = posint(A).
 1739
 1740math(A, M),
 1741    integer(A)
 1742 => M = integer(A).
 1743
 1744math(integer(A), M),
 1745    A >= 0
 1746 => M = posint(A).
 1747
 1748math(integer(A), M)
 1749 => Abs is abs(A),
 1750    M = -posint(Abs).
 1751
 1752math(A, M),
 1753    number(A),
 1754    A >= 0
 1755 => M = pos(A).
 1756
 1757math(A, M),
 1758    number(A)
 1759 => M = number(A).
 1760
 1761ml(posint(A), M, _Flags)
 1762 => M = mn(A).
 1763
 1764ml(pos(1.0Inf), M, _Flags)
 1765 => M = mi(&('#x221E')).
 1766
 1767% Default number of decimals is 2, change it using Flags
 1768math(round(A, D), M, Flags0, Flags1)
 1769 => M = A,
 1770    Flags1 = [digits(D) | Flags0].
 1771
 1772math(round(A), M)
 1773 => M = round(A, 0).
 1774
 1775math(pos(A), M, Flags, Flags2),
 1776    number(A),
 1777    A < 0.1,
 1778    select_option(pval(.), Flags, Flags1)
 1779 => M = pos(A),
 1780    Flags2 = [digits(3) | Flags1].
 1781
 1782math(pos(A), M, Flags, Flags2),
 1783    select_option(pval(.), Flags, Flags1)
 1784 => M = pos(A),
 1785    Flags2 = [digits(2) | Flags1].
 1786
 1787math(pos(A), M, Flags, Flags2),
 1788    number(A),
 1789    A < 0.001,
 1790    select_option(pval(P), Flags, Flags1)
 1791 => M = (P < 0.001),
 1792    Flags2 = [pval(.) | Flags1].
 1793
 1794math(pos(A), M, Flags, Flags2),
 1795    number(A),
 1796    select_option(pval(P), Flags, Flags1)
 1797 => M = (P = A),
 1798    Flags2 = [pval(.) | Flags1].
 1799
 1800ml(pos(A), M, Flags)
 1801 => option_(digits(D), Flags, 2),
 1802    format(atom(Mask), '~~~wf', [D]),
 1803    option_(mult(F), Flags, 1),
 1804    format(string(X), Mask, [F*A]),
 1805    M = mn(X).
 1806
 1807jax(posint(A), M, _Flags)
 1808 => format(string(M), "~w", [A]).
 1809
 1810jax(pos(1.0Inf), M, _Flags)
 1811 => M = "\\infty".
 1812
 1813jax(pos(A), M, Flags)
 1814 => option_(digits(D), Flags, 2),
 1815    format(atom(Mask), '~~~wf', [D]),
 1816    format(string(M), Mask, [A]).
 1817
 1818type(pos(A), Type, _Flags)
 1819 => Type = [numeric(A), atomic].
 1820
 1821type(posint(A), Type, _Flags)
 1822 => Type = [numeric(A), atomic].
 1823
 1824math(number(A), M),
 1825    A < 0
 1826 => Abs is abs(A),
 1827    M = -pos(Abs).
 1828
 1829math(number(A), M)
 1830 => M = pos(A).
 1831
 1832% Operators
 1833math(isin(A, B), X)
 1834 => current_op(Prec, xfx, =),
 1835    X = yfx(Prec, isin, A, B).
 1836
 1837math(notin(A, B), X)
 1838 => current_op(Prec, xfx, =),
 1839    X = yfx(Prec, notin, A, B).
 1840
 1841math(intersect(A, B), X)
 1842 => current_op(Prec, yfx, *),
 1843    X = yfx(Prec, cap, A, B).
 1844
 1845math(union(A, B), X)
 1846 => current_op(Prec, yfx, *),
 1847    X = yfx(Prec, cup, A, B).
 1848
 1849math(':'(A, B), X)
 1850 => current_op(Prec, yfx, *),
 1851    X = yfx(Prec, '#58', A, B).
 1852
 1853math(kronecker(A, B), X)
 1854 => current_op(Prec, yfx, *),
 1855    X = yfx(Prec, 'CircleTimes', A, B).
 1856
 1857math('=='(A, B), X)
 1858 => X = '='(A, B).
 1859
 1860math(A = B, X)
 1861 => current_op(Prec, xfx, =),
 1862    X = yfy(Prec, =, A, B).
 1863
 1864math(A \= B, X)
 1865 => current_op(Prec, xfx, \=),
 1866    X = xfx(Prec, ne, A, B).
 1867
 1868math(A =\= B, X)
 1869 => X = (A \= B).
 1870
 1871math(A < B, X)
 1872 => current_op(Prec, xfx, <),
 1873    X = yfy(Prec, <, A, B).
 1874
 1875math(A =< B, X)
 1876 => current_op(Prec, xfx, =<),
 1877    X = yfy(Prec, le, A, B).
 1878
 1879math(~(A, B), X)
 1880 => current_op(Prec, xfx, =),
 1881    X = yfy(Prec, 'Tilde', A, B).
 1882
 1883math('%<->%'(A, B), X)
 1884 => current_op(Prec, xfy, ->),
 1885    X = yfy(Prec, '%<->%', A, B).
 1886
 1887math('%<=>%'(A, B), X)
 1888 => current_op(Prec, xfy, ->),
 1889    X = yfy(Prec, '%<=>%', A, B).
 1890
 1891math('%->%'(A, B), X)
 1892 => current_op(Prec, xfy, ->),
 1893    X = yfy(Prec, '%->%', A, B).
 1894
 1895math('%=>%'(A, B), X)
 1896 => current_op(Prec, xfy, ->),
 1897    X = yfy(Prec, '%=>%', A, B).
 1898
 1899math('%<-%'(A, B), X)
 1900 => current_op(Prec, xfy, ->),
 1901    X = yfy(Prec, '%<-%', A, B).
 1902
 1903math('%<=%'(A, B), X)
 1904 => current_op(Prec, xfy, ->),
 1905    X = yfy(Prec, '%<=%', A, B).
 1906
 1907math('%up%'(A, B), X)
 1908 => current_op(Prec, xfy, ->),
 1909    X = yfy(Prec, '%up%', A, B).
 1910
 1911math('%dblup%'(A, B), X)
 1912 => current_op(Prec, xfy, ->),
 1913    X = yfy(Prec, '%dblup%', A, B).
 1914
 1915math('%down%'(A, B), X)
 1916 => current_op(Prec, xfy, ->),
 1917    X = yfy(Prec, '%down%', A, B).
 1918
 1919math('%dbldown%'(A, B), X)
 1920 => current_op(Prec, xfy, ->),
 1921    X = yfy(Prec, '%dbldown%', A, B).
 1922
 1923math('%==%'(A, B), X)
 1924 => current_op(Prec, xfx, =),
 1925    X = yfy(Prec, '%==%', A, B).
 1926
 1927math('%=~%'(A, B), X)
 1928 => current_op(Prec, xfx, =),
 1929    X = yfy(Prec, '%=~%', A, B).
 1930
 1931math('%prop%'(A, B), X)
 1932 => current_op(Prec, xfx, =),
 1933    X = yfy(Prec, '%prop%', A, B).
 1934
 1935math('%>%'(A), X)
 1936 => current_op(Prec, xfy, ';'),
 1937    X = fy(Prec, '%>%', A).
 1938
 1939math('%>%'(A, B), X)
 1940 => current_op(Prec, xfy, ';'),
 1941    X = yfy(Prec, '%>%', A, B).
 1942
 1943math('%<%'(A), X)
 1944 => current_op(Prec, xfy, ','),
 1945    X = fy(Prec, '%<%', A).
 1946
 1947math('%<%'(A, B), X)
 1948 => current_op(Prec, xfy, ','),
 1949    X = yfy(Prec, '%<%', A, B).
 1950
 1951math('%,%'(A, B), X)
 1952 => current_op(Prec, xfy, ','),
 1953    X = yfy(Prec, '%,%', A, B).
 1954
 1955math('%|%'(A, B), X)
 1956 => current_op(Prec, xfy, ';'),
 1957    X = yfy(Prec, '%|%', A, B).
 1958
 1959math(~(A), X)
 1960 => current_op(Prec, fy, \+),
 1961    X = fy(Prec, ~, A).
 1962
 1963math(A > B, X)
 1964 => current_op(Prec, xfx, >),
 1965    X = yfy(Prec, >, A, B).
 1966
 1967math(A >= B, X)
 1968 => current_op(Prec, xfx, >=),
 1969    X = yfy(Prec, ge, A, B).
 1970
 1971math(+A, X)
 1972 => current_op(Prec, yfx, +),
 1973    X = fy(Prec, +, A).
 1974
 1975math(A + B, X)
 1976 => current_op(Prec, yfx, +),
 1977    X = yfy(Prec, +, A, B).
 1978
 1979math(-A, X)
 1980 => current_op(Prec, yfx, -),
 1981    X = fy(Prec, -, A).
 1982
 1983math(A - B, X)
 1984 => current_op(Prec, yfx, -),
 1985    X = yfy(Prec, -, A, B).
 1986
 1987% Suppress multiplication dot in simple expressions
 1988math(A * B, X, Flags),
 1989    type(A, TypeA, Flags),
 1990    member(atomic, TypeA),
 1991    type(B, TypeB, Flags),
 1992    member(atomic, TypeB)
 1993 => X = nodot(A, B).
 1994
 1995math(A * B, X, Flags),
 1996    current_op(Mult, yfx, *),
 1997    prec(A, Prec, Flags),
 1998    Prec =< Mult,
 1999    type(A, TypeA, Flags),
 2000    (member(atomic, TypeA) ; member(op, TypeA)),
 2001    type(B, TypeB, Flags),
 2002    member(atomic, TypeB)
 2003 => X = nodot(A, B).
 2004
 2005% Different multiplication signs
 2006math(A * B, M)
 2007 => M = '%.%'(A, B).
 2008
 2009math(times(A, B), M)
 2010  => M = '%*%'(A, B).
 2011
 2012math(crossprod(A, B), M)
 2013 => M = '%*%'(t(A), B).
 2014
 2015math(tcrossprod(A, B), M)
 2016 => M = '%*%'(A, t(B)).
 2017
 2018math('%~~%'(A, B), X)
 2019 => current_op(Prec, xfx, =),
 2020    X = yfy(Prec, '%~~%', A, B).
 2021
 2022math(~(A, B), X)
 2023 => current_op(Prec, xfx, =),
 2024    X = yfy(Prec, 'Tilde', A, B).
 2025
 2026math(dot(A, B), X)
 2027 => X = '%.%'(A, B).
 2028
 2029math('%.%'(A, B), X)
 2030 => current_op(Prec, yfx, *),
 2031    X = yfy(Prec, '%.%', A, B).
 2032
 2033math('%+-%'(A, B), X)
 2034 => current_op(Prec, yfx, +),
 2035    X = yfy(Prec, '%+-%', A, B).
 2036
 2037math(nodot(A, B), X)
 2038 => current_op(Prec, yfx, *),
 2039    X = yfy(Prec, '#x2062', A, B).
 2040
 2041math('%*%'(A, B), X)
 2042 => current_op(Prec, yfx, *),
 2043    X = yfy(Prec, '%*%', A, B).
 2044
 2045math(A / B, X)
 2046 => current_op(Prec, yfx, /),
 2047    X = yfx(Prec, /, A, B).
 2048
 2049math((A ; B), X)
 2050 => current_op(Prec, xfx, =),
 2051    X = yfy(Prec, ;, A, B).
 2052
 2053math(A^B, X)
 2054 => X = superscript(A, B).
 2055
 2056% Render operators with the appropriate parentheses
 2057ml(fy(Prec, Op, A), M, Flags)
 2058 => ml(op(Op), S, Flags),
 2059    ml(right(Prec, A), X, Flags),
 2060    M = mrow([S, X]).
 2061
 2062ml(yf(Prec, Op, A), M, Flags)
 2063 => ml(op(Op), S, Flags),
 2064    ml(left(Prec, A), X, Flags),
 2065    M = mrow([X, S]).
 2066
 2067ml(xfx(Prec, Op, A, B), M, Flags)
 2068 => ml(left(Prec-1, A), X, Flags),
 2069    ml(op(Op), S, Flags),
 2070    ml(right(Prec-1, B), Y, Flags),
 2071    M = mrow([X, S, Y]).
 2072
 2073ml(yfx(Prec, Op, A, B), M, Flags)
 2074 => ml(left(Prec, A), X, Flags),
 2075    ml(op(Op), S, Flags),
 2076    ml(right(Prec-1, B), Y, Flags),
 2077    M = mrow([X, S, Y]).
 2078
 2079ml(xfy(Prec, Op, A, B), M, Flags)
 2080 => ml(left(Prec-1, A), X, Flags),
 2081    ml(op(Op), S, Flags),
 2082    ml(right(Prec, B), Y, Flags),
 2083    M = mrow([X, S, Y]).
 2084
 2085ml(yfy(Prec, Op, A, B), M, Flags)
 2086 => ml(left(Prec, A), X, Flags),
 2087    ml(op(Op), S, Flags),
 2088    ml(right(Prec, B), Y, Flags),
 2089    M = mrow([X, S, Y]).
 2090
 2091jax(fy(Prec, Op, A), M, Flags)
 2092 => jax(op(Op), S, Flags),
 2093    jax(right(Prec, A), X, Flags),
 2094    format(string(M), "{~w}{~w}", [S, X]).
 2095
 2096jax(yf(Prec, Op, A), M, Flags)
 2097 => jax(op(Op), S, Flags),
 2098    jax(left(Prec, A), X, Flags),
 2099    format(string(M), "{~w}{~w}", [X, S]).
 2100
 2101jax(xfx(Prec, Op, A, B), M, Flags)
 2102 => jax(left(Prec-1, A), X, Flags),
 2103    jax(op(Op), S, Flags),
 2104    jax(right(Prec-1, B), Y, Flags),
 2105    format(string(M), "{~w}{~w}{~w}", [X, S, Y]).
 2106
 2107jax(yfx(Prec, Op, A, B), M, Flags)
 2108 => jax(left(Prec, A), X, Flags),
 2109    jax(op(Op), S, Flags),
 2110    jax(right(Prec-1, B), Y, Flags),
 2111    format(string(M), "{~w}{~w}{~w}", [X, S, Y]).
 2112
 2113jax(xfy(Prec, Op, A, B), M, Flags)
 2114 => jax(left(Prec-1, A), X, Flags),
 2115    jax(op(Op), S, Flags),
 2116    jax(right(Prec, B), Y, Flags),
 2117    format(string(M), "{~w}{~w}{~w}", [X, S, Y]).
 2118
 2119jax(yfy(Prec, Op, A, B), M, Flags)
 2120 => jax(left(Prec, A), X, Flags),
 2121    jax(op(Op), S, Flags),
 2122    jax(right(Prec, B), Y, Flags),
 2123    format(string(M), "{~w}{~w}{~w}", [X, S, Y]).
 2124
 2125denoting(fy(_, _, A), D, Flags)
 2126 => denoting(A, D, Flags).
 2127
 2128denoting(yf(_, _, A), D, Flags)
 2129 => denoting(A, D, Flags).
 2130
 2131denoting(xfx(_, _, A, B), D, Flags)
 2132 => denoting(A, DenA, Flags),
 2133    denoting(B, DenB, Flags),
 2134    append(DenA, DenB, D).
 2135
 2136denoting(xfy(_, _, A, B), D, Flags)
 2137 => denoting(A, DA, Flags),
 2138    denoting(B, DB, Flags),
 2139    append(DA, DB, D).
 2140
 2141denoting(yfx(_, _, A, B), D, Flags)
 2142 => denoting(A, DA, Flags),
 2143    denoting(B, DB, Flags),
 2144    append(DA, DB, D).
 2145
 2146denoting(yfy(_, _, A, B), D, Flags)
 2147 => denoting(A, DA, Flags),
 2148    denoting(B, DB, Flags),
 2149    append(DA, DB, D).
 2150
 2151paren(fy(_Prec, _Op, A), P, Flags)
 2152 => paren(A, P, Flags).
 2153
 2154paren(fx(_Prec, _Op, A), P, Flags)
 2155 => paren(A, P, Flags).
 2156
 2157paren(xf(_Prec, _Op, A), P, Flags)
 2158 => paren(A, P, Flags).
 2159
 2160paren(yf(_Prec, _Op, A), P, Flags)
 2161 => paren(A, P, Flags).
 2162
 2163paren(xfx(Prec, _Op, A, B), P, Flags)
 2164 => paren(left(Prec, A), P1, Flags),
 2165    paren(right(Prec, B), P2, Flags),
 2166    P is max(P1, P2).
 2167
 2168paren(xfy(Prec, _Op, A, B), P, Flags)
 2169 => paren(left(Prec, A), P1, Flags),
 2170    paren(right(Prec, B), P2, Flags),
 2171    P is max(P1, P2).
 2172
 2173paren(yfx(Prec, _Op, A, B), P, Flags)
 2174 => paren(left(Prec, A), P1, Flags),
 2175    paren(right(Prec, B), P2, Flags),
 2176    P is max(P1, P2).
 2177
 2178paren(yfy(Prec, _Op, A, B), P, Flags)
 2179 => paren(left(Prec, A), P1, Flags),
 2180    paren(right(Prec, B), P2, Flags),
 2181    P is max(P1, P2).
 2182
 2183prec(fy(Prec, _, _), P, _Flags)
 2184 => P = Prec.
 2185
 2186prec(yf(Prec, _, _), P, _Flags)
 2187 => P = Prec.
 2188
 2189prec(xfx(Prec, _, _, _), P, _Flags)
 2190 => P = Prec.
 2191
 2192prec(yfx(Prec, _, _, _), P, _Flags)
 2193 => P = Prec.
 2194
 2195prec(xfy(Prec, _, _, _), P, _Flags)
 2196 => P = Prec.
 2197
 2198prec(yfy(Prec, _, _, _), P, _Flags)
 2199 => P = Prec.
 2200
 2201type(fy(_, _, _), Type, _Flags)
 2202 => Type = [op].
 2203
 2204type(yf(_, _, _), Type, _Flags)
 2205 => Type = [op].
 2206
 2207type(xfx(_, _, _, _), Type, _Flags)
 2208 => Type = [op].
 2209
 2210type(yfx(_, _, _, _), Type, _Flags)
 2211 => Type = [op].
 2212
 2213type(xfy(_, _, _, _), Type, _Flags)
 2214 => Type = [op].
 2215
 2216type(yfy(_, _, _, _), Type, _Flags)
 2217 => Type = [op].
 2218
 2219math(left(Prec, A), M, Flags),
 2220    prec(A, P, Flags),
 2221    P > Prec
 2222 => M = paren(A).
 2223
 2224math(left(_, A), M)
 2225 => M = A.
 2226
 2227math(right(Prec, A), M)
 2228 => P is Prec, % - 1,
 2229    M = left(P, A).
 2230
 2231denoting(left(_, A), D, Flags)
 2232 => denoting(A, D, Flags).
 2233
 2234denoting(right(_, A), D, Flags)
 2235 => denoting(A, D, Flags).
 2236
 2237% Add name to elements
 2238math(name(A, Name), M, Flags, New)
 2239 => New = [name(Name) | Flags],
 2240    M = A.
 2241
 2242% Suppress 'Vectorize'
 2243math('Vectorize'(A, _Args), M)
 2244 => M = A.
 2245
 2246% Abbreviations
 2247%
 2248% Example
 2249% t = .../..., with s^2_pool denoting the pooled variance
 2250%
 2251ml(denote(A, _, _), X, Flags)
 2252 => ml(A, X, Flags).
 2253
 2254jax(denote(A, _, _), X, Flags)
 2255 => jax(A, X, Flags).
 2256
 2257paren(denote(A, _, _), Paren, Flags)
 2258 => paren(A, Paren, Flags).
 2259
 2260prec(denote(A, _, _), Prec, Flags)
 2261 => prec(A, Prec, Flags).
 2262
 2263type(denote(A, _, _), Type, Flags)
 2264 => type(A, Type, Flags).
 2265
 2266denoting(denote(A, Expr, Info), Den, Flags)
 2267 => denoting(Expr, T, Flags),
 2268    Den = [denoting(A, Expr, Info) | T].
 2269
 2270% Render abbreviations
 2271%
 2272ml(denoting(A, Expr, Info), X, Flags)
 2273 => ml(A = Expr, AExpr, Flags),
 2274    X = span([math(AExpr), " denoting ", Info]).
 2275
 2276jax(denoting(A, Expr, Info), X, Flags)
 2277 => jax(A = Expr, AExpr, Flags),
 2278    format(string(X), "$~w$ denoting ~w", [AExpr, Info]).
 2279
 2280type(denoting(A, _, _), Type, Flags)
 2281 => type(A, Type, Flags).
 2282
 2283denoting(denoting(_, _, _), Den, _Flags)
 2284 => Den = [].
 2285
 2286% Collect abbreviations
 2287%
 2288ml(with(Abbreviations), X, Flags)
 2289 => sort(Abbreviations, Sorted), % remove duplicates
 2290    ml(with_(Sorted), X, Flags).
 2291
 2292ml(with_([]), W, _Flags)
 2293 => W = "".
 2294
 2295ml(with_([A]), W, Flags)
 2296 => ml(A, X, Flags),
 2297    W = span([", with", &(nbsp), X]).
 2298
 2299ml(with_([A, B | T]), W, Flags)
 2300 => ml(A, X, Flags),
 2301    ml(and([B | T]), Y, Flags),
 2302    W = span([", with", &(nbsp), X | Y]).
 2303
 2304ml(and([]), W, _Flags)
 2305 => W = ".".
 2306
 2307ml(and([A | T]), W, Flags)
 2308 => ml(A, X, Flags),
 2309    ml(and(T), Y, Flags),
 2310    W = span([", and", &(nbsp), X | Y]).
 2311
 2312jax(with(Abbreviations), X, Flags)
 2313 => sort(Abbreviations, Sorted), % remove duplicates
 2314    jax(with_(Sorted), X, Flags).
 2315
 2316jax(with_([]), W, _Flags)
 2317 => W = "".
 2318
 2319jax(with_([A]), W, Flags)
 2320 => jax(A, X, Flags),
 2321    format(string(W), ", with ~w", [X]).
 2322
 2323jax(with_([A, B | T]), W, Flags)
 2324 => jax(A, X, Flags),
 2325    jax(and([B | T]), Y, Flags),
 2326    format(string(W), ", with ~w~w", [X, Y]).
 2327
 2328jax(and([]), W, _Flags)
 2329 => W = ".".
 2330
 2331jax(and([A | T]), W, Flags)
 2332 => jax(A, X, Flags),
 2333    jax(and(T), Y, Flags),
 2334    format(string(W), ", and ~w~w", [X, Y]).
 2335
 2336% No parentheses
 2337math({}(A), M)
 2338 => M = A.
 2339
 2340% Parentheses
 2341%
 2342% parenthesis/1, bracket/1, curly/1 generate the respective parenthesis,
 2343% paren/1 is a generic parenthesis, cycling over (), [], {}
 2344math('('(A), M)
 2345 => M = paren(A).
 2346
 2347ml(paren(A), M, Flags),
 2348    paren(A, P, Flags),
 2349    2 is P mod 3
 2350 => ml(braces(A), M, Flags).
 2351
 2352ml(paren(A), M, Flags),
 2353    paren(A, P, Flags),
 2354    1 is P mod 3
 2355 => ml(brackets(A), M, Flags).
 2356
 2357ml(paren(A), M, Flags)
 2358 => ml(parentheses(A), M, Flags).
 2359
 2360jax(paren(A), M, Flags),
 2361    paren(A, P, Flags),
 2362    2 is P mod 3
 2363 => jax(braces(A), M, Flags).
 2364
 2365jax(paren(A), M, Flags),
 2366    paren(A, P, Flags),
 2367    1 is P mod 3
 2368 => jax(brackets(A), M, Flags).
 2369
 2370jax(paren(A), M, Flags)
 2371 => jax(parentheses(A), M, Flags).
 2372
 2373paren(paren(A), P, Flags)
 2374 => paren(A, P0, Flags),
 2375    succ(P0, P).
 2376
 2377type(paren(_), T, _Flags)
 2378 => T = paren.
 2379
 2380ml(parentheses(A), M, Flags)
 2381 => ml(A, X, Flags),
 2382    M = mrow([mo('('), X, mo(')')]).
 2383
 2384jax(parentheses(A), M, Flags)
 2385 => jax(A, X, Flags),
 2386    format(string(M), "\\left(~w\\right)", [X]).
 2387
 2388paren(parentheses(_), P, _Flags)
 2389 => P = 1.
 2390
 2391type(parentheses(_), T, _Flags)
 2392 => T = paren.
 2393
 2394ml(brackets(A), M, Flags)
 2395 => ml(A, X, Flags),
 2396    M = mrow([mo('['), X, mo(']')]).
 2397
 2398jax(brackets(A), M, Flags)
 2399 => jax(A, X, Flags),
 2400    format(string(M), "\\left[~w\\right]", [X]).
 2401
 2402paren(brackets(_), P, _Flags)
 2403 => P = 2.
 2404
 2405type(brackets(_), T, _Flags)
 2406 => T = paren.
 2407
 2408ml(braces(A), M, Flags)
 2409 => ml(A, X, Flags),
 2410    M = mrow([mo('{'), X, mo('}')]).
 2411
 2412jax(braces(A), M, Flags)
 2413 => jax(A, X, Flags),
 2414    format(string(M), "\\left\\{~w\\right\\}", [X]).
 2415
 2416paren(braces(_), P, _Flags)
 2417 => P = 3.
 2418
 2419type(braces(_), T, _Flags)
 2420 => T = paren.
 2421
 2422% Lists of things
 2423math([H | T], M)
 2424 => M = list(space, [H | T]).
 2425
 2426ml(list(_, [A]), M, Flags)
 2427 => ml(A, M, Flags).
 2428
 2429ml(list(Sep, [A, B | T]), M, Flags)
 2430 => ml(A, X, Flags),
 2431    ml(tail(Sep, [B | T]), Y, Flags),
 2432    M = mrow([X | Y]).
 2433
 2434ml(tail(Sep, [A]), M, Flags)
 2435 => ml(Sep, S, Flags),
 2436    ml(A, X, Flags),
 2437    M = [S, X].
 2438
 2439ml(tail(Sep, [A, B | T]), M, Flags)
 2440 => ml(Sep, S, Flags),
 2441    ml(A, X, Flags),
 2442    ml(tail(Sep, [B | T]), Y, Flags),
 2443    M = [S, X | Y].
 2444
 2445jax(list(_, [A]), M, Flags)
 2446 => jax(A, M, Flags).
 2447
 2448jax(list(Sep, [A, B | T]), M, Flags)
 2449 => jax(A, X, Flags),
 2450    jax(tail(Sep, [B | T]), Y, Flags),
 2451    format(string(M), "{~w}{~w}", [X, Y]).
 2452
 2453jax(tail(Sep, [A]), M, Flags)
 2454 => jax(Sep, S, Flags),
 2455    jax(A, X, Flags),
 2456    format(string(M), "{~w}{~w}", [S, X]).
 2457
 2458jax(tail(Sep, [A, B | T]), M, Flags)
 2459 => jax(Sep, S, Flags),
 2460    jax(A, X, Flags),
 2461    jax(tail(Sep, [B | T]), Y, Flags),
 2462    format(string(M), "{~w}{~w}{~w}", [S, X, Y]).
 2463
 2464paren(list(_, List), P, Flags)
 2465 => maplist(paren_(Flags), List, P0),
 2466    max_list(P0, P).
 2467
 2468prec(list(_, [A]), P, Flags)
 2469 => prec(A, P, Flags).
 2470
 2471prec(list(Sep, [_, _ | _]), P, Flags)
 2472 => prec(Sep, P, Flags).
 2473
 2474denoting(list(_, L), D, Flags)
 2475 => maplist(denoting_(Flags), L, List),
 2476    append(List, D).
 2477
 2478% Fractions
 2479ml(frac(N, D), M, Flags)
 2480 => ml(N, X, Flags),
 2481    ml(D, Y, Flags),
 2482    M = mfrac([X, Y]).
 2483
 2484jax(frac(N, D), M, Flags)
 2485 => jax(N, X, Flags),
 2486    jax(D, Y, Flags),
 2487    format(string(M), "\\frac{~w}{~w}", [X, Y]).
 2488
 2489paren(frac(_, _), P, _Flags)
 2490 => P = 0.
 2491
 2492prec(frac(_, _), P, _Flags)
 2493 => current(P, yfx, /). % was P - 1
 2494
 2495type(frac(_, _), Type, _Flags)
 2496  => Type = [fraction].
 2497
 2498% Large fraction
 2499math(dfrac(Num, Den), M)
 2500 => M = display(frac(Num, Den)).
 2501
 2502% Integer division
 2503math(div(Num, Den), M)
 2504 => M = floor(Num / Den).
 2505
 2506% Modulo
 2507math(rem(Num, Den), M)
 2508 => M = ceiling(Num / Den).
 2509
 2510
 2511% Large font ("displaystyle")
 2512ml(display(A), M, Flags)
 2513 => ml(A, X, Flags),
 2514    M = mstyle(displaystyle(true), X).
 2515
 2516jax(display(A), M, Flags)
 2517 => jax(A, X, Flags),
 2518    format(string(M), "\\displaystyle{~w}", [X]).
 2519
 2520prec(display(A), P, Flags)
 2521 => prec(A, P, Flags).
 2522
 2523type(display(A), T, Flags)
 2524 => type(A, T, Flags).
 2525
 2526% Underbrace
 2527ml(underbrace(A, U), M, Flags)
 2528 => ml(A, X, Flags),
 2529    ml(U, Y, Flags),
 2530    M = munder([munder(accentunder(true),
 2531                  [X, mo(stretchy(true), &('UnderBrace'))]), Y]).
 2532
 2533jax(underbrace(A, U), M, Flags)
 2534 => jax(A, X, Flags),
 2535    jax(U, Y, Flags),
 2536    format(string(M), "\\underbrace{~w}_{~w}", [X, Y]).
 2537
 2538paren(underbrace(A, _), Paren, Flags)
 2539 => paren(A, Paren, Flags).
 2540
 2541prec(underbrace(A, _), Prec, Flags)
 2542 => prec(A, Prec, Flags).
 2543
 2544type(underbrace(A, _), Type, Flags)
 2545 => type(A, Type, Flags).
 2546
 2547% Mistakes
 2548%
 2549% See vignette for examples
 2550%
 2551option_(NameOption, Flags) :-
 2552    option(NameOption, Flags).
 2553
 2554option_(NameOption, Flags) :-
 2555    compound_name_arguments(NameOption, Name, [Option]),
 2556    member(Name-String, Flags),
 2557    atom_string(Option, String).
 2558
 2559option_(NameOption, Flags, _Default),
 2560    compound_name_arguments(NameOption, Name, [_]),
 2561    compound_name_arguments(NameOption0, Name, [_]),
 2562    option_(NameOption0, Flags)
 2563 => NameOption = NameOption0.
 2564    
 2565option_(NameOption, _Flags, Default)
 2566 => compound_name_arguments(NameOption, _Name, [Default]).
 2567
 2568math(omit_left(Expr), M, Flags),
 2569    option_(error(ignore), Flags)
 2570 => M = Expr.
 2571
 2572math(omit_left(Expr), M, Flags),
 2573    option_(error(asis), Flags),
 2574    Expr =.. [_Op, _L, R]
 2575 => M = R.
 2576
 2577math(omit_left(Expr), M, Flags),
 2578    option_(error(fix), Flags),
 2579    Expr =.. [Op, L, R]
 2580 => M = list(space, [box(list(space, [L, op(Op)])), R]).
 2581
 2582math(omit_left(Expr), M, _Flags), % default
 2583    Expr =.. [Op, L, R]
 2584 => M = list(space, [cancel(list(space, [L, op(Op)])), R]).
 2585
 2586math(omit_right(Expr), M, Flags),
 2587    option_(error(ignore), Flags)
 2588 => M = Expr.
 2589
 2590math(omit_right(Expr), M, Flags),
 2591    option_(error(asis), Flags),
 2592    Expr =.. [_Op, L, _R]
 2593 => M = L.
 2594
 2595math(omit_right(Expr), M, Flags),
 2596    option_(error(fix), Flags),
 2597    Expr =.. [Op, L, R]
 2598 => M = list(space, [L, box(list(space, [op(Op), R]))]).
 2599
 2600math(omit_right(Expr), M, _Flags),
 2601    Expr =.. [Op, L, R]
 2602 => M = list(space, [L, cancel(list(space, [op(Op), R]))]).
 2603
 2604math(omit(_Expr), M, Flags),
 2605    option_(error(asis), Flags)
 2606 => M = "".
 2607
 2608math(omit(Expr), M, Flags),
 2609    option_(error(ignore), Flags)
 2610 => M = Expr.
 2611
 2612math(omit(Expr), M, Flags),
 2613    option_(error(fix), Flags)
 2614 => M = box(Expr).
 2615
 2616math(omit(Expr), M, _Flags)
 2617 => M = cancel(Expr).
 2618
 2619math(add_left(Expr), M, Flags),
 2620    option_(error(ignore), Flags),
 2621    Expr =.. [_Op, _L, R]
 2622 => M = R.
 2623
 2624math(add_left(Expr), M, Flags),
 2625    option_(error(asis), Flags)
 2626 => M = Expr.
 2627
 2628math(add_left(Expr), M, Flags),
 2629    option_(error(fix), Flags),
 2630    Expr =.. [Op, L, R]
 2631 => M = list(space, [cancel(list(space, [L, op(Op)])), R]).
 2632
 2633math(add_left(Expr), M, _Flags),
 2634    Expr =.. [Op, L, R]
 2635 => M = list(space, [box(list(space, [L, op(Op)])), R]).
 2636
 2637math(add_right(Expr), M, Flags),
 2638    option_(error(ignore), Flags),
 2639    Expr =.. [_Op, L, _R]
 2640 => M = L.
 2641
 2642math(add_right(Expr), M, Flags),
 2643    option_(error(asis), Flags)
 2644 => M = Expr.
 2645
 2646math(add_right(Expr), M, Flags),
 2647    option_(error(fix), Flags),
 2648    Expr =.. [Op, L, R]
 2649 => M = list(space, [L, cancel(list(space, [op(Op), R]))]).
 2650
 2651math(add_right(Expr), M, _Flags),
 2652    Expr =.. [Op, L, R]
 2653 => M = list(space, [L, box(list(space, [op(Op), R]))]).
 2654
 2655math(add(_Expr), M, Flags),
 2656    option_(error(ignore), Flags)
 2657 => M = "". % suppress at the next level, in the list
 2658
 2659math(add(Expr), M, Flags),
 2660    option_(error(asis), Flags)
 2661 => M = Expr.
 2662
 2663math(add(Expr), M, Flags),
 2664    option_(error(fix), Flags)
 2665 => M = cancel(Expr).
 2666
 2667math(add(Expr), M, _Flags)
 2668 => M = box(Expr).
 2669
 2670math(instead(_Wrong, Correct), M, Flags),
 2671    option_(error(ignore), Flags)
 2672 => M = Correct.
 2673
 2674math(instead(Wrong, _Correct), M, Flags),
 2675    option_(error(asis), Flags)
 2676 => M = Wrong.
 2677
 2678math(instead(_Wrong, Correct), M, Flags),
 2679    option_(error(fix), Flags)
 2680 => M = box(Correct).
 2681
 2682math(instead(Wrong, Correct), M, _Flags)
 2683 => M = underbrace(Wrong, list(space, ["instead", "of", Correct])).
 2684
 2685% Find minimum
 2686math(Optim, M),
 2687    compound(Optim),
 2688    compound_name_arguments(Optim, optim, [Par, Fn | _])
 2689 => M = argmin(fn(Fn, [Par])).
 2690
 2691% Probability distributions
 2692math(dbinom(K, N, Pi), M)
 2693 => M = fn(subscript('P', "Bi"), (['X' = K] ; [N, Pi])).
 2694
 2695math(pbinom(K, N, Pi), M)
 2696 => M = fn(subscript('P', "Bi"), (['X' =< K] ; [N, Pi])).
 2697
 2698math(pbinom(_K, N, Pi, Tail), M)
 2699 => M = fn(subscript('P', "Bi"), ([Tail] ; [N, Pi])).
 2700
 2701math(qbinom(Alpha, N, Pi), M)
 2702 => M = fn(subscript(argmin, k),
 2703          [fn(subscript('P', "Bi"), (['X' =< k] ; [N, Pi])) > Alpha]).
 2704
 2705math(dpois(K, Rate), M)
 2706  => M = fn(subscript('P', "Po"), (['X' = K] ; [Rate])).
 2707
 2708math(ppois(K, Rate), M)
 2709  => M = fn(subscript('P', "Po"), (['X' =< K] ; [Rate])).
 2710
 2711math(qpois(Alpha, Rate), M)
 2712 => M = fn(subscript(argmax, k),
 2713          [fn(subscript('P', "Po"), (['X' =< k] ; [Rate])) > Alpha]).
 2714
 2715math(dexp(X, Rate), M)
 2716  => M = fn(subscript('f', "Exp"), ([X] ; [Rate])).
 2717
 2718math(pexp(X, Rate), M)
 2719  => M = fn(subscript('F', "Exp"), ([X] ; [Rate])).
 2720
 2721math(qexp(P, Rate), M)
 2722  => M = fn(subscript('F' ^ -1, "Exp"), ([P] ; [Rate])).
 2723
 2724math(dnorm(Z), M)
 2725 => M = fn(phi, [Z]).
 2726
 2727math(dnorm(X, Mu, Sigma2), M)
 2728 => M = fn(phi, ([X] ; [Mu, Sigma2])).
 2729
 2730math(pnorm(Z), M)
 2731 => M = fn('Phi', [Z]).
 2732
 2733math(pnorm(X, Mu, Sigma2), M)
 2734 => M = fn('Phi', ([X] ; [Mu, Sigma2])).
 2735
 2736math(qnorm(Alpha), M)
 2737 => M = fn('Phi' ^ -1, [Alpha]).
 2738
 2739math(qnorm(Alpha, Mu, Sigma2), M)
 2740 => M = fn('Phi' ^ -1, ([Alpha] ; [Mu, Sigma2])).
 2741
 2742math(pchisq(X, Df), M)
 2743 => M = fn(subscript('F', fn(chi^2, [list(space, [Df, "df"])])), [X]).
 2744
 2745math(qchisq(Alpha, Df), M)
 2746 => M = fn(subscript('F' ^ -1, fn(chi^2, [list(space, [Df, "df"])])), [Alpha]).
 2747
 2748math(pt(Dist, Df, _Tail), M)
 2749 => M = fn('P', ([Dist] ; [list(space, [Df, "df"])])).
 2750
 2751math(pt(Dist, Df, _Tail), M)
 2752 => M = fn('P', ([Dist] ; [list(space, [Df, "df"])])).
 2753
 2754math(dist(T, _t, "lower"), M)
 2755 => M = (T =< _t).
 2756
 2757math(dist(T, _t, "upper"), M)
 2758 => M = (T > _t).
 2759
 2760math(dist(T, _t, "two.sided"), M)
 2761 => M = (abs(T) > abs(_t)).
 2762
 2763math(dist(T, _t, "density"), M)
 2764 => M = (T = _t).
 2765 
 2766math(qt(Alpha, Df), M)
 2767 => M = fn(subscript('T', Alpha), [list(space, [Df, "df"])]).
 2768
 2769% Functions like f(x) and f(x; a, b)
 2770ml(fn(Name, (Args ; Pars)), M, Flags)
 2771 => ml(Name, F, Flags),
 2772    ml(paren(list(op(;), [list(op(','), Args), list(op(','), Pars)])), X, Flags),
 2773    M = mrow([F, mo(&(af)), X]).
 2774
 2775jax(fn(Name, (Args ; Pars)), M, Flags),
 2776    string(Name)
 2777 => jax(Name, F, Flags),
 2778    jax(paren(list(op(';'), [list(op(','), Args), list(op(','), Pars)])), X, Flags),
 2779    format(string(M), "~w\\,{~w}", [F, X]).
 2780
 2781jax(fn(Name, (Args ; Pars)), M, Flags)
 2782 => jax(Name, F, Flags),
 2783    jax(paren(list(op(';'), [list(op(','), Args), list(op(','), Pars)])), X, Flags),
 2784    format(string(M), "~w{~w}", [F, X]).
 2785
 2786paren(fn(_Name, (Args ; Pars)), Paren, Flags)
 2787 => paren(list(op(','), Args), X, Flags),
 2788    paren(list(op(','), Pars), Y, Flags),
 2789    Paren is max(X, Y) + 1.
 2790
 2791prec(fn(_Name, (_Args ; _Pars)), Prec, Flags)
 2792 => prec(a * b, P0, Flags),
 2793    Prec is P0 - 1.
 2794
 2795type(fn(_Name, (_Args ; _Pars)), Type, _Flags)
 2796 => Type = [paren].
 2797
 2798ml(fn(Name, [Arg]), M, Flags),
 2799    type(Arg, paren, Flags)
 2800 => ml(Name, F, Flags),
 2801    ml(Arg, X, Flags),
 2802    M = mrow([F, mo(&(af)), X]).
 2803
 2804jax(fn(Name, [Arg]), M, Flags),
 2805    type(Arg, paren, Flags)
 2806 => jax(Name, F, Flags),
 2807    jax(Arg, X, Flags),
 2808    format(string(M), "~w{~w}", [F, X]).
 2809
 2810%
 2811% Omit parenthesis in special functions
 2812%
 2813% sum_i x_i              [prec: sum = 0 -> 401, x_i = 0]
 2814% sum_i (a_i + b_i)      [sum = 0 -> 401, + = 500]
 2815% sum_i a_i * b_i (!)    [sum = 0 -> 401, * = 400]
 2816% sum_i log p_i          [sum = 0 -> 401, log(x) = 400]
 2817%
 2818% prod_i x_i             [prod -> 400, x_i = 0]
 2819% prod_i (a_i + b_i)     [prod -> 400, + = 500]
 2820% prod_i (a_i * b_i) (!) [prod -> 400, * = 400]
 2821% prod_i log p_i         [prod -> 400, log(x) = 400]
 2822%
 2823ml(fn(Name, [Arg]), M, Flags),
 2824    type(Name, Type, Flags),
 2825    member(special, Type),
 2826    prec(Name, P, Flags),
 2827    prec(Arg, Prec, Flags),
 2828    P >= Prec
 2829 => ml(Name, F, Flags),
 2830    ml(Arg, X, Flags),
 2831    M = mrow([F, mo(&(af)), X]).
 2832
 2833jax(fn(Name, [Arg]), M, Flags),
 2834    type(Name, Type, Flags),
 2835    member(special, Type),
 2836    prec(Name, P, Flags),
 2837    prec(Arg, Prec, Flags),
 2838    P >= Prec
 2839 => jax(Name, F, Flags),
 2840    jax(Arg, X, Flags),
 2841    format(string(M), "~w{~w}", [F, X]).
 2842
 2843ml(fn(Name, [Arg]), M, Flags),
 2844    type(Name, Type, Flags),
 2845    member(Type, [special, subscript(_), superscript(_)]),
 2846    prec(Arg, 0, Flags)
 2847 => ml(Name, F, Flags),
 2848    ml(Arg, X, Flags),
 2849    M = mrow([F, mo(&(af)), X]).
 2850
 2851jax(fn(Name, [Arg]), M, Flags),
 2852    type(Name, Type, Flags),
 2853    member(Type, [special, subscript(_), superscript(_)]),
 2854    prec(Arg, 0, Flags)
 2855 => jax(Name, F, Flags),
 2856    jax(Arg, X, Flags),
 2857    format(string(M), "~w{~w}", [F, X]).
 2858
 2859ml(fn(Name, Args), M, Flags)
 2860 => ml(Name, F, Flags),
 2861    ml(paren(list(op(','), Args)), X, Flags),
 2862    M = mrow([F, mo(&(af)), X]).
 2863
 2864jax(fn(Name, Args), M, Flags)
 2865 => jax(Name, F, Flags),
 2866    jax(paren(list(op(','), Args)), X, Flags),
 2867    format(string(M), "~w{~w}", [F, X]).
 2868
 2869paren(fn(_Name, [Arg]), P, Flags),
 2870    type(Arg, paren, Flags)
 2871 => paren(Arg, P, Flags).
 2872
 2873paren(fn(_Name, [Arg]), P, Flags),
 2874    prec(Arg, P0, Flags),
 2875    P0 = 0
 2876 => paren(Arg, P, Flags).
 2877
 2878paren(fn(_Name, Args), P, Flags)
 2879 => paren(list(op(','), Args), P, Flags).
 2880
 2881prec(fn(Name, _Args), Prec, Flags),
 2882    prec(Name, P, Flags),
 2883    P = 0
 2884 => current(Prec0, yfx, *),
 2885    Prec is Prec0 - 1.
 2886
 2887prec(fn(Name, _Args), Prec, Flags)
 2888 => prec(Name, Prec, Flags).
 2889
 2890type(fn(_Name, _Args), Type, _Flags)
 2891 => Type = [function].
 2892
 2893% Comma-separated list
 2894math(R, M),
 2895    compound(R),
 2896    compound_name_arguments(R, ',', Args)
 2897 => M = list(',', Args).
 2898
 2899math(R, M),
 2900    compound(R),
 2901    compound_name_arguments(R, c, Args)
 2902 => M = paren(list(',', Args)).
 2903
 2904% Default compounds
 2905%
 2906% Can't use the macros here because of left recursion
 2907ml(A, M, Flags),
 2908    compound(A),
 2909    compound_name_arguments(A, N, Args)
 2910 => ml(fn(N, Args), M, Flags).
 2911
 2912jax(A, M, Flags),
 2913    compound(A),
 2914    compound_name_arguments(A, N, Args)
 2915 => jax(fn(N, Args), M, Flags).
 2916
 2917type(A, M, Flags),
 2918    compound(A),
 2919    compound_name_arguments(A, N, Args)
 2920 => type(fn(N, Args), M, Flags).
 2921
 2922% Defaults
 2923math(A, M)
 2924 => M = A.
 2925
 2926math(A, M, _Flags)
 2927 => M = A.
 2928
 2929math(A, M, Flags, New)
 2930 => New = Flags,
 2931    M = A.
 2932
 2933paren(A, P, Flags),
 2934    math(A, M),
 2935    dif(A, M)
 2936 => paren(M, P, Flags).
 2937
 2938paren(A, P, Flags),
 2939    math(A, M, Flags),
 2940    dif(A, M)
 2941 => paren(M, P, Flags).
 2942
 2943paren(A, P, Flags),
 2944    math(A, M, Flags, New),
 2945    dif(Flags-A, New-M)
 2946 => paren(M, P, New).
 2947
 2948paren(A, P, Flags),
 2949    math_hook(A, M)
 2950 => paren(M, P, Flags).
 2951
 2952paren(A, P, Flags),
 2953    math_hook(A, M, Flags)
 2954 => paren(M, P, Flags).
 2955
 2956paren(A, P, Flags),
 2957    math_hook(A, M, Flags, New)
 2958 => paren(M, P, New).
 2959
 2960paren(_A, P, _Flags)
 2961 => P = 0.
 2962
 2963prec(A, Den, Flags),
 2964    math(A, M, Flags, New),
 2965    dif(Flags-A, New-M)
 2966 => prec(M, Den, New).
 2967
 2968prec(_A, P, _Flags)
 2969 => P = 0.
 2970
 2971type(A, Type, Flags),
 2972    math(A, M),
 2973    dif(A, M)
 2974 => type(M, Type, Flags).
 2975
 2976type(A, Type, Flags),
 2977    math(A, M, Flags),
 2978    dif(A, M)
 2979 => type(M, Type, Flags).
 2980
 2981type(A, Type, Flags),
 2982    math(A, M, Flags, New),
 2983    dif(Flags-A, New-M)
 2984 => type(M, Type, New).
 2985
 2986type(A, Type, _Flags),
 2987    compound(A)
 2988 => Type = compound.
 2989
 2990denoting(A, Den, Flags),
 2991    math_hook(A, M)
 2992 => denoting(M, Den, Flags).
 2993
 2994denoting(A, Den, Flags),
 2995    math_hook(A, M, Flags)
 2996 => denoting(M, Den, Flags).
 2997
 2998denoting(A, Den, Flags),
 2999    math_hook(A, M, Flags, Flags1)
 3000 => denoting(M, Den, Flags1).
 3001
 3002denoting(A, Den, Flags),
 3003    math(A, M, Flags, Flags1),
 3004    dif(A-Flags, M-Flags1)
 3005 => denoting(M, Den, Flags1).
 3006
 3007denoting(Expression, Den, Flags),
 3008    compound(Expression)
 3009 => compound_name_arguments(Expression, _, Arguments),
 3010    maplist(denoting_(Flags), Arguments, List),
 3011    append(List, Den).
 3012
 3013% If everything fails, there is no abbreviation
 3014denoting(_, Den, _Flags)
 3015 => Den = [].
 3016
 3017% Precedence
 3018current(Prec, Fix, Op) :-
 3019    atom(Op),
 3020    current_op(P, Fix, Op),
 3021    Prec = P