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