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