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(xor(x=A, y=B), M)
  992 => M = xor(A, B).
  993
  994math(xor(A, B), M)
  995 => current(Prec, xfy, ';'),
  996    M = xfy(Prec, veebar, A, B).
  997
  998math(exp(A), M)
  999 => M = fn(exp, [A]).
 1000
 1001math(expm1(A), M)
 1002 => M = exp(A) - 1.
 1003
 1004math(log(X), M)
 1005 => M = fn(log, [X]).
 1006
 1007math(log10(X), M)
 1008 => M = logb(X, 10).
 1009
 1010math(log2(X), M)
 1011 => M = logb(X, 2).
 1012
 1013math(logb(X, B), M)
 1014 => M = fn(subscript(log, B), [X]).
 1015
 1016math(log1p(A), M)
 1017 => M = log(1 + A).
 1018
 1019ml(ceiling(A), M, Flags)
 1020 => ml(A, X, Flags),
 1021    M = mrow([mo(&(lceil)), X, mo(&(rceil))]).
 1022
 1023jax(ceiling(A), M, Flags)
 1024 => jax(A, X, Flags),
 1025    format(string(M), "\\lceil{~w}\\rceil", [X]).
 1026
 1027paren(ceiling(_), P, _Flags)
 1028 => P is 0.
 1029
 1030ml(floor(A), M, Flags)
 1031 => ml(A, X, Flags),
 1032    M = mrow([mo(&(lfloor)), X, mo(&(rfloor))]).
 1033
 1034jax(floor(A), M, Flags)
 1035 => jax(A, X, Flags),
 1036    format(string(M), "\\lfloor{~w}\\rfloor", [X]).
 1037
 1038paren(floor(_), P, _Flags)
 1039 => P is 0.
 1040
 1041% Represent function bodies as :-/2, '<-'/2
 1042math((_F :- Body), M)
 1043 => M = Body.
 1044
 1045math('<-'(R, S), M)
 1046 => M = (R == S).
 1047
 1048% Do not show curly brace around code blocks
 1049math(Curly, M, Flags),
 1050    compound(Curly),
 1051    compound_name_arguments(Curly, '{', Args)
 1052 => exclude(invisible_(Flags), Args, Args1),
 1053    M = body(Args1).
 1054
 1055invisible_(_Flags, invisible(_)).
 1056
 1057ml(body([R]), M, Flags)
 1058 => ml(R, M, Flags).
 1059
 1060ml(body(Body), M, Flags)
 1061 => maplist(ml_(Flags), Body, R),
 1062    M = mrow([mo('{'), mtable(columnalign(left), R)]).
 1063
 1064jax(body([R]), M, Flags)
 1065 => jax(R, M, Flags).
 1066
 1067jax(body(Body), M, Flags)
 1068 => maplist(jax_(Flags), Body, Ls),
 1069    atomic_list_concat(Ls, "}\\\\\n{", Rs),
 1070    format(string(M), "\\left\\{\\begin{array}{l}{~w}\\end{array}\\right.", [Rs]).
 1071
 1072% Hide (this is not phantom, see elsewhere)
 1073math(invisible(_), M, _Flags)
 1074 => M = ''.
 1075
 1076% Vectors: '##'(1, 2, 3) or '$$' or '%%' or '!!' for different types
 1077math(Hash, M, Flags),
 1078    option_(sep(Sep), Flags),
 1079    compound(Hash),
 1080    compound_name_arguments(Hash, Name, Elements),
 1081    member(Name, ['##', '$$', '%%', '!!'])
 1082 => M = paren(list(Sep, Elements)).
 1083
 1084math(Hash, M, _Flags),
 1085    compound(Hash),
 1086    compound_name_arguments(Hash, Name, Elements),
 1087    member(Name, ['##', '$$', '%%', '!!'])
 1088 => M = paren(Elements).
 1089
 1090% Matrices
 1091ml(Matrix, M, Flags),
 1092    compound(Matrix),
 1093    compound_name_arguments(Matrix, Name, Rows),
 1094    member(Name, ['###', '$$$', '%%%', '!!!'])
 1095 => maplist(ml_row(Flags), Rows, R),
 1096    M = mrow([mo('('), mtable(columnalign(left), R), mo(')')]).
 1097
 1098ml_row(Flags, Row, M),
 1099    compound(Row),
 1100    compound_name_arguments(Row, Name, Cells),
 1101    member(Name, ['##', '$$', '%%', '!!'])
 1102 => maplist(ml_cell(Flags), Cells, C),
 1103    M = mtr(C).
 1104
 1105ml_cell(Flags, Cell, M)
 1106 => ml(Cell, C, Flags),
 1107    M = mtd(C).
 1108
 1109jax(Matrix, M, Flags),
 1110    compound(Matrix),
 1111    compound_name_arguments(Matrix, Name, [Row1 | Rows]),
 1112    member(Name, ['###', '$$$', '%%%', '!!!'])
 1113 => findall(c, arg(_, Row1, _), Ls),
 1114    atomic_list_concat(Ls, LLL),
 1115    maplist(jax_row(Flags), [Row1 | Rows], R),
 1116    atomic_list_concat(R, Lines),
 1117    format(string(M), "\\left(\\begin{array}{~w}~w\\end{array}\\right)", [LLL, Lines]).
 1118
 1119jax_row(Flags, Row, M),
 1120    compound(Row),
 1121    compound_name_arguments(Row, Name, Cells),
 1122    member(Name, ['##', '$$', '%%', '!!'])
 1123 => maplist(jax_cell(Flags), Cells, C),
 1124    atomic_list_concat(C, ' & ', R),
 1125    format(string(M), "~w\\\\\n", [R]).
 1126
 1127jax_cell(Flags, C, M)
 1128 => jax(C, X, Flags),
 1129    format(string(M), "~w", [X]).
 1130
 1131math(Identical, M),
 1132    compound(Identical),
 1133    compound_name_arguments(Identical, identical, [X, Y])
 1134 => M = (X == Y).
 1135
 1136% Distinguish cases
 1137ml(ifelse(T, Y, N), M, Flags)
 1138 => ml(T, Test, Flags),
 1139    ml(Y, Yes, Flags),
 1140    ml(N, No, Flags),
 1141    ml(space, S, Flags),
 1142    M = mrow([mo('{'),
 1143      mtable(columnalign(left),
 1144      [ mtr([Yes, mrow([mtext("if"), S, Test])]),
 1145        mtr([No, mtext("otherwise")])
 1146      ])]).
 1147
 1148jax(ifelse(T, Y, N), M, Flags)
 1149 => jax(T, Test, Flags),
 1150    jax(Y, Yes, Flags),
 1151    jax(N, No, Flags),
 1152    format(string(M),
 1153      "\\left\\{\\begin{array}{ll} {~w} & \\mathrm{if}~~{~w}\\\\ {~w} & \\mathrm{otherwise}\\end{array}\\right.",
 1154      [Yes, Test, No]).
 1155
 1156paren(ifelse(_, _, _), P, _Flags)
 1157 => P is 0.
 1158
 1159ml(if(T, Y), M, Flags)
 1160 => ml(T, Test, Flags),
 1161    ml(Y, Yes, Flags),
 1162    ml(space, S, Flags),
 1163    M = mrow([Yes, mtext(","), S, mtext("if"), S, Test]).
 1164
 1165jax(if(T, Y), M, Flags)
 1166 => jax(T, Test, Flags),
 1167    jax(Y, Yes, Flags),
 1168    format(string(M), "{~w},\\ \\mathrm{if}\\ {~w}", [Yes, Test]).
 1169
 1170paren(if(_, _), P, _Flags)
 1171 => P is 0.
 1172
 1173math('%in%'(X, Y), M)
 1174 => M = isin(X, Y).
 1175
 1176math(setdiff(X, Y), M)
 1177 => M = X - Y.
 1178
 1179math('%x%'(X, Y), M)
 1180 => M = kronecker(X, Y).
 1181
 1182math('&'(A, B), M)
 1183 => M = and(A, B).
 1184
 1185math('|'(A, B), M)
 1186 => M = or(A, B).
 1187
 1188ml(Prod, M, Flags),
 1189    compound(Prod),
 1190    compound_name_arguments(Prod, prod, Args)
 1191 => maplist(ml_(Flags), Args, MX),
 1192    M = mrow([mo(&(prod)), mrow(MX)]).
 1193
 1194jax(prod(A), M, Flags)
 1195 => jax(A, X, Flags),
 1196    format(string(M), "\\prod{~w}", [X]).
 1197
 1198jax(Prod, M, Flags),
 1199    compound(Prod),
 1200    compound_name_arguments(Prod, prod, Args)
 1201 => maplist(jax_(Flags), Args, X),
 1202    format(string(M), "\\prod{~w}", [X]).
 1203
 1204paren(Prod, P, Flags),
 1205    compound(Prod),
 1206    compound_name_arguments(Prod, prod, Args)
 1207 => maplist(paren_(Flags), Args, PX),
 1208    max_list(PX, P).
 1209
 1210prec(Prod, P, _Flags),
 1211    compound(Prod),
 1212    compound_name_arity(Prod, prod, _)
 1213 => current(P, yfx, *).
 1214
 1215math(Min, M),
 1216    compound(Min),
 1217    compound_name_arguments(Min, min, Args)
 1218 => M = fn(min, Args).
 1219
 1220math(Max, M),
 1221    compound(Max),
 1222    compound_name_arguments(Max, max, Args)
 1223 => M = fn(max, Args).
 1224
 1225math(t(A), M)
 1226 => M = A^"T".
 1227
 1228math(Which, M),
 1229    compound(Which),
 1230    compound_name_arguments(Which, which, Args)
 1231 => M = subscript("I", Args).
 1232
 1233math('which.max'(A), M)
 1234 => M = argmax(A).
 1235
 1236math('which.min'(A), M)
 1237 => M = argmin(A).
 1238
 1239% Extract value from a result (e.g., integrate)
 1240math($(Fn, "value"), M)
 1241 => M = Fn.
 1242
 1243% Integrate over range
 1244%
 1245% Case A: Fn is a function
 1246math(integrate(Fn, Lower, Upper), M, Flags),
 1247    Fn = (Head :- _Body),
 1248    compound(Head),
 1249    compound_name_arguments(Head, function, [DX | _]),
 1250    member(name-Name, Flags)
 1251 => M = integrate(fn(Name, [DX]), Lower, Upper, DX).
 1252
 1253math(integrate(Fn, Lower, Upper), M, _Flags),
 1254    Fn = (Head :- _Body),
 1255    compound(Head),
 1256    compound_name_arguments(Head, function, [DX | _])
 1257 => M = integrate(fn(lambda, [DX]), Lower, Upper, DX).
 1258
 1259% Case B: Fn is an atom (inquire R for argument names)
 1260math(integrate(Fn, Lower, Upper), M, _Flags),
 1261    atom(Fn)
 1262 => r_eval('['(formalArgs(args(Fn)), 1), Arg1),
 1263    atom_string(DX, Arg1),
 1264    M = integrate(fn(Fn, [DX]), Lower, Upper, DX).
 1265
 1266% Internal
 1267ml(integrate(Fn, From, To, DX), M, Flags)
 1268 => ml(Fn, XFn, Flags),
 1269    ml(From, XFrom, Flags),
 1270    ml(To, XTo, Flags),
 1271    ml(DX, XDX, Flags),
 1272    ml(space, Space, Flags),
 1273    M = mrow([munderover([mo(&(int)), XFrom, XTo]), XFn, Space, mi(d), XDX]).
 1274
 1275jax(integrate(Fn, From, To, DX), M, Flags)
 1276 => jax(Fn, XFn, Flags),
 1277    jax(From, XFrom, Flags),
 1278    jax(To, XTo, Flags),
 1279    jax(DX, XDX, Flags),
 1280    format(string(M), "\\int_{~w}^{~w}{~w}\\,{d{~w}}", [XFrom, XTo, XFn, XDX]).
 1281
 1282paren(integrate(_, _, _, A), Paren, Flags)
 1283 => paren(A, Paren, Flags).
 1284
 1285prec(integrate(_, _, _, _), Prec, _Flags)
 1286 => current(Prec, yfx, *).
 1287
 1288% Decorations
 1289math(roof(A), M)
 1290 => M = hat(A).
 1291
 1292ml(hat(A), M, Flags)
 1293 => ml(A, X, Flags),
 1294    M = mover(accent(true), [X, mo(&('Hat'))]).
 1295
 1296jax(hat(A), M, Flags)
 1297 => jax(A, X, Flags),
 1298    format(string(M), "\\hat{~w}", [X]).
 1299
 1300paren(hat(A), Paren, Flags)
 1301 => paren(A, Paren, Flags).
 1302
 1303prec(hat(A), Prec, Flags)
 1304 => prec(A, Prec, Flags).
 1305
 1306type(hat(A), Type, Flags)
 1307 => type(A, Type, Flags).
 1308
 1309ml(tilde(A), M, Flags)
 1310 => ml(A, X, Flags),
 1311    M = mover(accent(true), [X, mo(&(tilde))]).
 1312
 1313jax(tilde(A), M, Flags)
 1314 => jax(A, X, Flags),
 1315    format(string(M), "\\tilde{~w}", [X]).
 1316
 1317paren(tilde(A), Paren, Flags)
 1318 => paren(A, Paren, Flags).
 1319
 1320prec(tilde(A), Prec, Flags)
 1321 => prec(A, Prec, Flags).
 1322
 1323type(tilde(A), Type, Flags)
 1324 => type(A, Type, Flags).
 1325
 1326math(mean(A), M)
 1327 => M = overline(A).
 1328
 1329ml(overline(A), M, Flags)
 1330 => ml(A, X, Flags),
 1331    M = mover(accent(true), [X, mo(&(macr))]).
 1332
 1333jax(overline(A), M, Flags)
 1334 => jax(A, X, Flags),
 1335    format(string(M), "\\overline{~w}", [X]).
 1336
 1337paren(overline(A), Paren, Flags)
 1338 => paren(A, Paren, Flags).
 1339
 1340% Put overline(x)^2 in parentheses
 1341prec(overline(_), Prec, _Flags)
 1342 => current(P, yfx, *),
 1343    Prec = P.
 1344
 1345type(overline(A), Type, Flags)
 1346 => type(A, Type, Flags).
 1347
 1348ml(cancel(A), M, Flags)
 1349 => ml(A, X, Flags),
 1350    M = menclose(notation(updiagonalstrike), X).
 1351
 1352jax(cancel(A), M, Flags)
 1353 => jax(A, X, Flags),
 1354    format(string(M), "\\cancel{~w}", [X]).
 1355
 1356paren(cancel(A), Paren, Flags)
 1357 => paren(A, Paren, Flags).
 1358
 1359prec(cancel(A), Prec, Flags)
 1360 => prec(A, Prec, Flags).
 1361
 1362type(cancel(A), Type, Flags)
 1363 => type(A, Type, Flags).
 1364
 1365math(boxed(A), M)
 1366 => M = box(A).
 1367
 1368ml(box(A), M, Flags)
 1369 => ml(A, X, Flags),
 1370    M = menclose(notation(roundedbox), X).
 1371
 1372jax(box(A), M, Flags)
 1373 => jax(A, X, Flags),
 1374    format(string(M), "\\boxed{~w}", [X]).
 1375
 1376paren(box(A), Paren, Flags)
 1377 => paren(A, Paren, Flags).
 1378
 1379prec(box(A), Prec, Flags)
 1380 => prec(A, Prec, Flags).
 1381
 1382type(box(A), Type, Flags)
 1383 => type(A, Type, Flags).
 1384
 1385ml(phantom(A), M, Flags)
 1386 => ml(A, X, Flags),
 1387    M = mphantom(X).
 1388
 1389jax(phantom(A), M, Flags)
 1390 => jax(A, X, Flags),
 1391    format(string(M), "\\phantom{~w}", [X]).
 1392
 1393paren(phantom(A), Paren, Flags)
 1394 => paren(A, Paren, Flags).
 1395
 1396prec(phantom(A), Prec, Flags)
 1397 => prec(A, Prec, Flags).
 1398
 1399type(phantom(A), Type, Flags)
 1400 => type(A, Type, Flags).
 1401
 1402ml(prime(A), M, Flags)
 1403 => ml(A, X, Flags),
 1404    M = msup([X, mo(&('#x2032'))]).
 1405
 1406jax(prime(A), M, Flags)
 1407 => jax(A, X, Flags),
 1408    format(string(M), "{~w^\\prime}", [X]).
 1409
 1410paren(prime(A), Paren, Flags)
 1411 => paren(A, Paren, Flags).
 1412
 1413% Put prime(x)^2 in parentheses
 1414prec(prime(_), Prec, _Flags)
 1415 => current(P, yfx, *),
 1416    Prec = P.
 1417
 1418type(prime(A), Type, Flags)
 1419 => type(A, Type, Flags).
 1420
 1421%
 1422% Mathematical operators/signs
 1423%
 1424ml(op(le), M, _Flags)
 1425 => M = mo(&(le)).
 1426
 1427jax(op(le), M, _Flags)
 1428 => M = "\\le".
 1429
 1430ml(op(ge), M, _Flags)
 1431 => M = mo(&(ge)).
 1432
 1433jax(op(ge), M, _Flags)
 1434 => M = "\\ge".
 1435
 1436ml(op(ne), M, _Flags)
 1437 => M = mo(&(ne)).
 1438
 1439jax(op(ne), M, _Flags)
 1440 => M = "\\ne".
 1441
 1442ml(op('%.%'), M, _Flags)
 1443 => M = mo(&(sdot)).
 1444
 1445jax(op('%.%'), M, _Flags)
 1446 => M = "\\cdot".
 1447
 1448ml(op('%+-%'), M, _Flags)
 1449 => M = mo(&(pm)).
 1450
 1451jax(op('%+-%'), M, _Flags)
 1452 => M = "\\pm".
 1453
 1454ml(op('%*%'), M, _Flags)
 1455 => M = mo(&(times)).
 1456
 1457jax(op('%*%'), M, _Flags)
 1458 => M = "\\times".
 1459
 1460ml(op(sum), M, _Flags)
 1461 => M = mo(&(sum)).
 1462
 1463jax(op(sum), M, _Flags)
 1464 => M = "\\sum".
 1465
 1466ml(op(prod), M, _Flags)
 1467 => M = mo(&(prod)).
 1468
 1469jax(op(prod), M, _Flags)
 1470 => M = "\\prod".
 1471
 1472ml(op('#58'), M, _Flags)
 1473 => M = mo(&('#58')).
 1474
 1475jax(op('#58'), M, _Flags)
 1476 => M = ":".
 1477
 1478ml(op(','), M, _Flags)
 1479 => M = mo(',').
 1480
 1481jax(op(','), M, _Flags)
 1482 => M = ",".
 1483
 1484ml(op('CircleTimes'), M, _Flags)
 1485 => M = mo(&('CircleTimes')).
 1486
 1487jax(op('CircleTimes'), M, _Flags)
 1488 => M = "\\otimes".
 1489
 1490ml(op('#x2062'), M, _Flags)
 1491 => M = mo(&('#x2062')).
 1492
 1493jax(op('#x2062'), M, _Flags)
 1494 => M = "{}".
 1495
 1496ml(op('Tilde'), M, _Flags)
 1497 => M = mo(&('Tilde')).
 1498
 1499jax(op('Tilde'), M, _Flags)
 1500 => M = "\\sim".
 1501
 1502ml(op('%<->%'), M, _Flags)
 1503 => M = mo(&(leftrightarrow)).
 1504
 1505jax(op('%<->%'), M, _Flags)
 1506 => M = "\\leftrightarrow".
 1507
 1508ml(op('%<=>%'), M, _Flags)
 1509 => M = mo(&(iff)).
 1510
 1511jax(op('%<=>%'), M, _Flags)
 1512 => M = "\\iff".
 1513
 1514ml(op('%->%'), M, _Flags)
 1515 => M = mo(&(rightarrow)).
 1516
 1517jax(op('%->%'), M, _Flags)
 1518 => M = "\\rightarrow".
 1519
 1520ml(op('%=>%'), M, _Flags)
 1521 => M = mo(&(rArr)).
 1522
 1523jax(op('%=>%'), M, _Flags)
 1524 => M = "\\Rightarrow".
 1525
 1526ml(op('%<-%'), M, _Flags)
 1527 => M = mo(&(leftarrow)).
 1528
 1529jax(op('%<-%'), M, _Flags)
 1530 => M = "\\leftarrow".
 1531
 1532ml(op('%<=%'), M, _Flags)
 1533 => M = mo(&(lArr)).
 1534
 1535jax(op('%<=%'), M, _Flags)
 1536 => M = "\\Leftarrow".
 1537
 1538ml(op('%up%'), M, _Flags)
 1539 => M = mo(&(uparrow)).
 1540
 1541jax(op('%up%'), M, _Flags)
 1542 => M = "\\uparrow".
 1543
 1544ml(op('%dblup%'), M, _Flags)
 1545 => M = mo(&(uArr)).
 1546
 1547jax(op('%dblup%'), M, _Flags)
 1548 => M = "\\Uparrow".
 1549
 1550ml(op('%down%'), M, _Flags)
 1551 => M = mo(&(downarrow)).
 1552
 1553jax(op('%down%'), M, _Flags)
 1554 => M = "\\downarrow".
 1555
 1556ml(op('%dbldown%'), M, _Flags)
 1557 => M = mo(&(dArr)).
 1558
 1559jax(op('%dbldown%'), M, _Flags)
 1560 => M = "\\Downarrow".
 1561
 1562ml(op('%~~%'), M, _Flags)
 1563 => M = mo(&(approx)).
 1564
 1565jax(op('%~~%'), M, _Flags)
 1566 => M = "\\approx".
 1567
 1568ml(op('%==%'), M, _Flags)
 1569 => M = mo(&(equiv)).
 1570
 1571jax(op('%==%'), M, _Flags)
 1572 => M = "\\equiv".
 1573
 1574ml(op('%=~%'), M, _Flags)
 1575 => M = mo(&(cong)).
 1576
 1577jax(op('%=~%'), M, _Flags)
 1578 => M = "\\cong".
 1579
 1580ml(op('%prop%'), M, _Flags)
 1581 => M = mo(&(prop)).
 1582
 1583jax(op('%prop%'), M, _Flags)
 1584 => M = "\\propto".
 1585
 1586ml(op(and), M, _Flags)
 1587 => M = mo(&(and)).
 1588
 1589jax(op(and), M, _Flags)
 1590 => M = "\\land".
 1591
 1592ml(op(or), M, _Flags)
 1593 => M = mo(&(or)).
 1594
 1595jax(op(or), M, _Flags)
 1596 => M = "\\lor".
 1597
 1598ml(op(not), M, _Flags)
 1599 => M = mo(&(not)).
 1600
 1601jax(op(not), M, _Flags)
 1602 => M = "\\lnot".
 1603
 1604ml(op(veebar), M, _Flags)
 1605 => M = mo(&(veebar)).
 1606
 1607jax(op(veebar), M, _Flags)
 1608 => M = "\\veebar".
 1609
 1610ml(op(isin), M, _Flags)
 1611 => M = mo(&(isin)).
 1612
 1613jax(op(isin), M, _Flags)
 1614 => M = "\\in".
 1615
 1616ml(op(notin), M, _Flags)
 1617 => M = mo(&(notin)).
 1618
 1619jax(op(notin), M, _Flags)
 1620 => M = "\\notin".
 1621
 1622ml(op(cap), M, _Flags)
 1623 => M = mo(&(cap)).
 1624
 1625jax(op(cap), M, _Flags)
 1626 => M = "\\cap".
 1627
 1628ml(op(cup), M, _Flags)
 1629 => M = mo(&(cup)).
 1630
 1631jax(op(cup), M, _Flags)
 1632 => M = "\\cup".
 1633
 1634ml(op(A), M, _Flags)
 1635 => M = mo(A).
 1636
 1637jax(op(A), M, _Flags)
 1638 => format(string(M), "~w", [A]).
 1639
 1640prec(op(A), P, _Flags),
 1641    current(P0, _Fix, A)
 1642 => P = P0.
 1643
 1644current(0, fy, op(sum)).
 1645
 1646denoting(op(_), D, _Flags)
 1647 => D = [].
 1648
 1649% Numbers
 1650%
 1651% To avoid unnecessary decimals for integers, make it explicit in R: x^2L
 1652%
 1653math(A, M),
 1654    integer(A),
 1655    A >= 0
 1656 => M = posint(A).
 1657
 1658math(A, M),
 1659    integer(A)
 1660 => M = integer(A).
 1661
 1662math(integer(A), M),
 1663    A >= 0
 1664 => M = posint(A).
 1665
 1666math(integer(A), M)
 1667 => Abs is abs(A),
 1668    M = -posint(Abs).
 1669
 1670math(A, M),
 1671    number(A),
 1672    A >= 0
 1673 => M = pos(A).
 1674
 1675math(A, M),
 1676    number(A)
 1677 => M = number(A).
 1678
 1679ml(posint(A), M, _Flags)
 1680 => M = mn(A).
 1681
 1682ml(pos(1.0Inf), M, _Flags)
 1683 => M = mi(&('#x221E')).
 1684
 1685% Default number of decimals is 2, change it using Flags
 1686math(round(A, D), M, Flags0, Flags1)
 1687 => M = A,
 1688    Flags1 = [round(D) | Flags0].
 1689
 1690ml(pos(A), M, Flags)
 1691 => option_(round(D), Flags, 2),
 1692    format(atom(Mask), '~~~wf', [D]),
 1693    format(string(X), Mask, [A]),
 1694    M = mn(X).
 1695
 1696jax(posint(A), M, _Flags)
 1697 => format(string(M), "~w", [A]).
 1698
 1699jax(pos(1.0Inf), M, _Flags)
 1700 => M = "\\infty".
 1701
 1702jax(pos(A), M, Flags)
 1703 => option_(round(D), Flags, 2),
 1704    format(atom(Mask), '~~~wf', [D]),
 1705    format(string(M), Mask, [A]).
 1706
 1707type(pos(A), Type, _Flags)
 1708 => Type = [numeric(A), atomic].
 1709
 1710type(posint(A), Type, _Flags)
 1711 => Type = [numeric(A), atomic].
 1712
 1713math(number(A), M),
 1714    A < 0
 1715 => Abs is abs(A),
 1716    M = -pos(Abs).
 1717
 1718math(number(A), M)
 1719 => M = pos(A).
 1720
 1721% p-value
 1722math(pval(A), M, Flags, Flags1),
 1723    type(A, T, Flags),
 1724    member(numeric(N), T),
 1725    N =< 1,
 1726    N >= 0.1
 1727 => M = A,
 1728    Flags1 = [round(2) | Flags].
 1729
 1730math(pval(A), M, Flags, Flags1),
 1731    type(A, T, Flags),
 1732    member(numeric(_N), T)
 1733 => M = A,
 1734    Flags1 = [round(3) | Flags].
 1735
 1736math(pval(A), M, Flags, Flags1)
 1737 => M = A,
 1738    Flags1 = Flags.
 1739
 1740math(pval(A, P), M, Flags),
 1741    type(A, T, Flags),
 1742    member(numeric(N), T),
 1743    N < 0.001
 1744 => M = (P < pval(0.001)).
 1745
 1746math(pval(A, P), M, _Flags)
 1747 => M = (P == pval(A)).
 1748
 1749% Operators
 1750math(isin(A, B), X)
 1751 => current_op(Prec, xfx, =),
 1752    X = yfx(Prec, isin, A, B).
 1753
 1754math(notin(A, B), X)
 1755 => current_op(Prec, xfx, =),
 1756    X = yfx(Prec, notin, A, B).
 1757
 1758math(intersect(A, B), X)
 1759 => current_op(Prec, yfx, *),
 1760    X = yfx(Prec, cap, A, B).
 1761
 1762math(union(A, B), X)
 1763 => current_op(Prec, yfx, *),
 1764    X = yfx(Prec, cup, A, B).
 1765
 1766math(':'(A, B), X)
 1767 => current_op(Prec, yfx, *),
 1768    X = yfx(Prec, '#58', A, B).
 1769
 1770math(kronecker(A, B), X)
 1771 => current_op(Prec, yfx, *),
 1772    X = yfx(Prec, 'CircleTimes', A, B).
 1773
 1774math('=='(A, B), X)
 1775 => X = '='(A, B).
 1776
 1777math(A = B, X)
 1778 => current_op(Prec, xfx, =),
 1779    X = yfy(Prec, =, A, B).
 1780
 1781math(A \= B, X)
 1782 => current_op(Prec, xfx, \=),
 1783    X = xfx(Prec, ne, A, B).
 1784
 1785math(A < B, X)
 1786 => current_op(Prec, xfx, <),
 1787    X = yfy(Prec, <, A, B).
 1788
 1789math(A =< B, X)
 1790 => current_op(Prec, xfx, =<),
 1791    X = yfy(Prec, le, A, B).
 1792
 1793math(~(A, B), X)
 1794 => current_op(Prec, xfx, =),
 1795    X = yfy(Prec, 'Tilde', A, B).
 1796
 1797math('%<->%'(A, B), X)
 1798 => current_op(Prec, xfy, ->),
 1799    X = yfy(Prec, '%<->%', A, B).
 1800
 1801math('%<=>%'(A, B), X)
 1802 => current_op(Prec, xfy, ->),
 1803    X = yfy(Prec, '%<=>%', A, B).
 1804
 1805math('%->%'(A, B), X)
 1806 => current_op(Prec, xfy, ->),
 1807    X = yfy(Prec, '%->%', A, B).
 1808
 1809math('%=>%'(A, B), X)
 1810 => current_op(Prec, xfy, ->),
 1811    X = yfy(Prec, '%=>%', A, B).
 1812
 1813math('%<-%'(A, B), X)
 1814 => current_op(Prec, xfy, ->),
 1815    X = yfy(Prec, '%<-%', A, B).
 1816
 1817math('%<=%'(A, B), X)
 1818 => current_op(Prec, xfy, ->),
 1819    X = yfy(Prec, '%<=%', A, B).
 1820
 1821math('%up%'(A, B), X)
 1822 => current_op(Prec, xfy, ->),
 1823    X = yfy(Prec, '%up%', A, B).
 1824
 1825math('%dblup%'(A, B), X)
 1826 => current_op(Prec, xfy, ->),
 1827    X = yfy(Prec, '%dblup%', A, B).
 1828
 1829math('%down%'(A, B), X)
 1830 => current_op(Prec, xfy, ->),
 1831    X = yfy(Prec, '%down%', A, B).
 1832
 1833math('%dbldown%'(A, B), X)
 1834 => current_op(Prec, xfy, ->),
 1835    X = yfy(Prec, '%dbldown%', A, B).
 1836
 1837math('%==%'(A, B), X)
 1838 => current_op(Prec, xfx, =),
 1839    X = yfy(Prec, '%==%', A, B).
 1840
 1841math('%=~%'(A, B), X)
 1842 => current_op(Prec, xfx, =),
 1843    X = yfy(Prec, '%=~%', A, B).
 1844
 1845math('%prop%'(A, B), X)
 1846 => current_op(Prec, xfx, =),
 1847    X = yfy(Prec, '%prop%', A, B).
 1848
 1849math(A > B, X)
 1850 => current_op(Prec, xfx, >),
 1851    X = yfy(Prec, >, A, B).
 1852
 1853math(A >= B, X)
 1854 => current_op(Prec, xfx, >=),
 1855    X = yfy(Prec, ge, A, B).
 1856
 1857math(+A, X)
 1858 => current_op(Prec, yfx, +),
 1859    X = fy(Prec, +, A).
 1860
 1861math(A + B, X)
 1862 => current_op(Prec, yfx, +),
 1863    X = yfy(Prec, +, A, B).
 1864
 1865math(-A, X)
 1866 => current_op(Prec, yfx, -),
 1867    X = fy(Prec, -, A).
 1868
 1869math(A - B, X)
 1870 => current_op(Prec, yfx, -),
 1871    X = yfy(Prec, -, A, B).
 1872
 1873% Suppress multiplication dot in simple expressions
 1874math(A * B, X, Flags),
 1875    type(A, TypeA, Flags),
 1876    member(atomic, TypeA),
 1877    type(B, TypeB, Flags),
 1878    member(atomic, TypeB)
 1879 => X = nodot(A, B).
 1880
 1881math(A * B, X, Flags),
 1882    current_op(Mult, yfx, *),
 1883    prec(A, Prec, Flags),
 1884    Prec =< Mult,
 1885    type(A, TypeA, Flags),
 1886    (member(atomic, TypeA) ; member(op, TypeA)),
 1887    type(B, TypeB, Flags),
 1888    member(atomic, TypeB)
 1889 => X = nodot(A, B).
 1890
 1891% Different multiplication signs
 1892math(A * B, M)
 1893 => M = '%.%'(A, B).
 1894
 1895math(times(A, B), M)
 1896  => M = '%*%'(A, B).
 1897
 1898math(crossprod(A, B), M)
 1899 => M = '%*%'(t(A), B).
 1900
 1901math(tcrossprod(A, B), M)
 1902 => M = '%*%'(A, t(B)).
 1903
 1904math('%~~%'(A, B), X)
 1905 => current_op(Prec, xfx, =),
 1906    X = yfy(Prec, '%~~%', A, B).
 1907
 1908math(~(A, B), X)
 1909 => current_op(Prec, xfx, =),
 1910    X = yfy(Prec, 'Tilde', A, B).
 1911
 1912math(dot(A, B), X)
 1913 => X = '%.%'(A, B).
 1914
 1915math('%.%'(A, B), X)
 1916 => current_op(Prec, yfx, *),
 1917    X = yfy(Prec, '%.%', A, B).
 1918
 1919math('%+-%'(A, B), X)
 1920 => current_op(Prec, yfx, +),
 1921    X = yfy(Prec, '%+-%', A, B).
 1922
 1923math(nodot(A, B), X)
 1924 => current_op(Prec, yfx, *),
 1925    X = yfy(Prec, '#x2062', A, B).
 1926
 1927math('%*%'(A, B), X)
 1928 => current_op(Prec, yfx, *),
 1929    X = yfy(Prec, '%*%', A, B).
 1930
 1931math(A / B, X)
 1932 => current_op(Prec, yfx, /),
 1933    X = yfx(Prec, /, A, B).
 1934
 1935math((A ; B), X)
 1936 => current_op(Prec, xfy, ;),
 1937    X = xfy(Prec, ;, A, B).
 1938
 1939math(A^B, X)
 1940 => X = superscript(A, B).
 1941
 1942% Render operators with the appropriate parentheses
 1943ml(fy(Prec, Op, A), M, Flags)
 1944 => ml(op(Op), S, Flags),
 1945    ml(right(Prec, A), X, Flags),
 1946    M = mrow([S, X]).
 1947
 1948ml(yf(Prec, Op, A), M, Flags)
 1949 => ml(op(Op), S, Flags),
 1950    ml(left(Prec, A), X, Flags),
 1951    M = mrow([X, S]).
 1952
 1953ml(xfx(Prec, Op, A, B), M, Flags)
 1954 => ml(left(Prec-1, A), X, Flags),
 1955    ml(op(Op), S, Flags),
 1956    ml(right(Prec-1, B), Y, Flags),
 1957    M = mrow([X, S, Y]).
 1958
 1959ml(yfx(Prec, Op, A, B), M, Flags)
 1960 => ml(left(Prec, A), X, Flags),
 1961    ml(op(Op), S, Flags),
 1962    ml(right(Prec-1, B), Y, Flags),
 1963    M = mrow([X, S, Y]).
 1964
 1965ml(xfy(Prec, Op, A, B), M, Flags)
 1966 => ml(left(Prec-1, A), X, Flags),
 1967    ml(op(Op), S, Flags),
 1968    ml(right(Prec, B), Y, Flags),
 1969    M = mrow([X, S, Y]).
 1970
 1971ml(yfy(Prec, Op, A, B), M, Flags)
 1972 => ml(left(Prec, A), X, Flags),
 1973    ml(op(Op), S, Flags),
 1974    ml(right(Prec, B), Y, Flags),
 1975    M = mrow([X, S, Y]).
 1976
 1977jax(fy(Prec, Op, A), M, Flags)
 1978 => jax(op(Op), S, Flags),
 1979    jax(right(Prec, A), X, Flags),
 1980    format(string(M), "{~w}{~w}", [S, X]).
 1981
 1982jax(yf(Prec, Op, A), M, Flags)
 1983 => jax(op(Op), S, Flags),
 1984    jax(left(Prec, A), X, Flags),
 1985    format(string(M), "{~w}{~w}", [X, S]).
 1986
 1987jax(xfx(Prec, Op, A, B), M, Flags)
 1988 => jax(left(Prec-1, A), X, Flags),
 1989    jax(op(Op), S, Flags),
 1990    jax(right(Prec-1, B), Y, Flags),
 1991    format(string(M), "{~w}{~w}{~w}", [X, S, Y]).
 1992
 1993jax(yfx(Prec, Op, A, B), M, Flags)
 1994 => jax(left(Prec, A), X, Flags),
 1995    jax(op(Op), S, Flags),
 1996    jax(right(Prec-1, B), Y, Flags),
 1997    format(string(M), "{~w}{~w}{~w}", [X, S, Y]).
 1998
 1999jax(xfy(Prec, Op, A, B), M, Flags)
 2000 => jax(left(Prec-1, A), X, Flags),
 2001    jax(op(Op), S, Flags),
 2002    jax(right(Prec, B), Y, Flags),
 2003    format(string(M), "{~w}{~w}{~w}", [X, S, Y]).
 2004
 2005jax(yfy(Prec, Op, A, B), M, Flags)
 2006 => jax(left(Prec, A), X, Flags),
 2007    jax(op(Op), S, Flags),
 2008    jax(right(Prec, B), Y, Flags),
 2009    format(string(M), "{~w}{~w}{~w}", [X, S, Y]).
 2010
 2011denoting(fy(_, _, A), D, Flags)
 2012 => denoting(A, D, Flags).
 2013
 2014denoting(yf(_, _, A), D, Flags)
 2015 => denoting(A, D, Flags).
 2016
 2017denoting(xfx(_, _, A, B), D, Flags)
 2018 => denoting(A, DenA, Flags),
 2019    denoting(B, DenB, Flags),
 2020    append(DenA, DenB, D).
 2021
 2022denoting(xfy(_, _, A, B), D, Flags)
 2023 => denoting(A, DA, Flags),
 2024    denoting(B, DB, Flags),
 2025    append(DA, DB, D).
 2026
 2027denoting(yfx(_, _, A, B), D, Flags)
 2028 => denoting(A, DA, Flags),
 2029    denoting(B, DB, Flags),
 2030    append(DA, DB, D).
 2031
 2032denoting(yfy(_, _, A, B), D, Flags)
 2033 => denoting(A, DA, Flags),
 2034    denoting(B, DB, Flags),
 2035    append(DA, DB, D).
 2036
 2037paren(fy(_, _, A), P, Flags)
 2038 => paren(A, P, Flags).
 2039
 2040paren(yf(_, _, A), P, Flags)
 2041 => paren(A, P, Flags).
 2042
 2043paren(xfx(_, _, A, B), P, Flags)
 2044 => paren(A, PA, Flags),
 2045    paren(B, PB, Flags),
 2046    P is max(PA, PB).
 2047
 2048paren(yfx(_, _, A, B), P, Flags)
 2049 => paren(A, PA, Flags),
 2050    paren(B, PB, Flags),
 2051    P is max(PA, PB).
 2052
 2053paren(xfy(_, _, A, B), P, Flags)
 2054 => paren(A, PA, Flags),
 2055    paren(B, PB, Flags),
 2056    P is max(PA, PB).
 2057
 2058paren(yfy(_, _, A, B), P, Flags)
 2059 => paren(A, PA, Flags),
 2060    paren(B, PB, Flags),
 2061    P is max(PA, PB).
 2062
 2063prec(fy(Prec, _, _), P, _Flags)
 2064 => P = Prec.
 2065
 2066prec(yf(Prec, _, _), P, _Flags)
 2067 => P = Prec.
 2068
 2069prec(xfx(Prec, _, _, _), P, _Flags)
 2070 => P = Prec.
 2071
 2072prec(yfx(Prec, _, _, _), P, _Flags)
 2073 => P = Prec.
 2074
 2075prec(xfy(Prec, _, _, _), P, _Flags)
 2076 => P = Prec.
 2077
 2078prec(yfy(Prec, _, _, _), P, _Flags)
 2079 => P = Prec.
 2080
 2081type(fy(_, _, _), Type, _Flags)
 2082 => Type = [op].
 2083
 2084type(yf(_, _, _), Type, _Flags)
 2085 => Type = [op].
 2086
 2087type(xfx(_, _, _, _), Type, _Flags)
 2088 => Type = [op].
 2089
 2090type(yfx(_, _, _, _), Type, _Flags)
 2091 => Type = [op].
 2092
 2093type(xfy(_, _, _, _), Type, _Flags)
 2094 => Type = [op].
 2095
 2096type(yfy(_, _, _, _), Type, _Flags)
 2097 => Type = [op].
 2098
 2099math(left(Prec, A), M, Flags),
 2100    prec(A, P, Flags),
 2101    P > Prec
 2102 => M = paren(A).
 2103
 2104math(left(_, A), M)
 2105 => M = A.
 2106
 2107math(right(Prec, A), M)
 2108 => P is Prec, % - 1,
 2109    M = left(P, A).
 2110
 2111denoting(left(_, A), D, Flags)
 2112 => denoting(A, D, Flags).
 2113
 2114denoting(right(_, A), D, Flags)
 2115 => denoting(A, D, Flags).
 2116
 2117% Add name to elements
 2118math(name(A, Name), M, Flags, New)
 2119 => New = [name(Name) | Flags],
 2120    M = A.
 2121
 2122% Suppress 'Vectorize'
 2123math('Vectorize'(A, _Args), M)
 2124 => M = A.
 2125
 2126% Abbreviations
 2127%
 2128% Example
 2129% t = .../..., with s^2_pool denoting the pooled variance
 2130%
 2131ml(denote(A, _, _), X, Flags)
 2132 => ml(A, X, Flags).
 2133
 2134jax(denote(A, _, _), X, Flags)
 2135 => jax(A, X, Flags).
 2136
 2137paren(denote(A, _, _), Paren, Flags)
 2138 => paren(A, Paren, Flags).
 2139
 2140prec(denote(A, _, _), Prec, Flags)
 2141 => prec(A, Prec, Flags).
 2142
 2143type(denote(A, _, _), Type, Flags)
 2144 => type(A, Type, Flags).
 2145
 2146denoting(denote(A, Expr, Info), Den, Flags)
 2147 => denoting(Expr, T, Flags),
 2148    Den = [denoting(A, Expr, Info) | T].
 2149
 2150% Render abbreviations
 2151%
 2152ml(denoting(A, Expr, Info), X, Flags)
 2153 => ml(A = Expr, AExpr, Flags),
 2154    X = span([math(AExpr), " denoting ", Info]).
 2155
 2156jax(denoting(A, Expr, Info), X, Flags)
 2157 => jax(A = Expr, AExpr, Flags),
 2158    format(string(X), "$~w$ denoting ~w", [AExpr, Info]).
 2159
 2160type(denoting(A, _, _), Type, Flags)
 2161 => type(A, Type, Flags).
 2162
 2163denoting(denoting(_, _, _), Den, _Flags)
 2164 => Den = [].
 2165
 2166% Collect abbreviations
 2167%
 2168ml(with(Abbreviations), X, Flags)
 2169 => sort(Abbreviations, Sorted), % remove duplicates
 2170    ml(with_(Sorted), X, Flags).
 2171
 2172ml(with_([]), W, _Flags)
 2173 => W = "".
 2174
 2175ml(with_([A]), W, Flags)
 2176 => ml(A, X, Flags),
 2177    W = span([", with", &(nbsp), X]).
 2178
 2179ml(with_([A, B | T]), W, Flags)
 2180 => ml(A, X, Flags),
 2181    ml(and([B | T]), Y, Flags),
 2182    W = span([", with", &(nbsp), X | Y]).
 2183
 2184ml(and([]), W, _Flags)
 2185 => W = ".".
 2186
 2187ml(and([A | T]), W, Flags)
 2188 => ml(A, X, Flags),
 2189    ml(and(T), Y, Flags),
 2190    W = span([", and", &(nbsp), X | Y]).
 2191
 2192jax(with(Abbreviations), X, Flags)
 2193 => sort(Abbreviations, Sorted), % remove duplicates
 2194    jax(with_(Sorted), X, Flags).
 2195
 2196jax(with_([]), W, _Flags)
 2197 => W = "".
 2198
 2199jax(with_([A]), W, Flags)
 2200 => jax(A, X, Flags),
 2201    format(string(W), ", with ~w", [X]).
 2202
 2203jax(with_([A, B | T]), W, Flags)
 2204 => jax(A, X, Flags),
 2205    jax(and([B | T]), Y, Flags),
 2206    format(string(W), ", with ~w~w", [X, Y]).
 2207
 2208jax(and([]), W, _Flags)
 2209 => W = ".".
 2210
 2211jax(and([A | T]), W, Flags)
 2212 => jax(A, X, Flags),
 2213    jax(and(T), Y, Flags),
 2214    format(string(W), ", and ~w~w", [X, Y]).
 2215
 2216% No parentheses
 2217math({}(A), M)
 2218 => M = A.
 2219
 2220% Parentheses
 2221%
 2222% parenthesis/1, bracket/1, curly/1 generate the respective parenthesis,
 2223% paren/1 is a generic parenthesis, cycling over (), [], {}
 2224math('('(A), M)
 2225 => M = paren(A).
 2226
 2227ml(paren(A), M, Flags),
 2228    paren(A, P, Flags),
 2229    2 is P mod 3
 2230 => ml(braces(A), M, Flags).
 2231
 2232ml(paren(A), M, Flags),
 2233    paren(A, P, Flags),
 2234    1 is P mod 3
 2235 => ml(brackets(A), M, Flags).
 2236
 2237ml(paren(A), M, Flags)
 2238 => ml(parentheses(A), M, Flags).
 2239
 2240jax(paren(A), M, Flags),
 2241    paren(A, P, Flags),
 2242    2 is P mod 3
 2243 => jax(braces(A), M, Flags).
 2244
 2245jax(paren(A), M, Flags),
 2246    paren(A, P, Flags),
 2247    1 is P mod 3
 2248 => jax(brackets(A), M, Flags).
 2249
 2250jax(paren(A), M, Flags)
 2251 => jax(parentheses(A), M, Flags).
 2252
 2253paren(paren(A), P, Flags)
 2254 => paren(A, P0, Flags),
 2255    succ(P0, P).
 2256
 2257type(paren(_), T, _Flags)
 2258 => T = paren.
 2259
 2260ml(parentheses(A), M, Flags)
 2261 => ml(A, X, Flags),
 2262    M = mrow([mo('('), X, mo(')')]).
 2263
 2264jax(parentheses(A), M, Flags)
 2265 => jax(A, X, Flags),
 2266    format(string(M), "\\left(~w\\right)", [X]).
 2267
 2268paren(parentheses(_), P, _Flags)
 2269 => P = 1.
 2270
 2271type(parentheses(_), T, _Flags)
 2272 => T = paren.
 2273
 2274ml(brackets(A), M, Flags)
 2275 => ml(A, X, Flags),
 2276    M = mrow([mo('['), X, mo(']')]).
 2277
 2278jax(brackets(A), M, Flags)
 2279 => jax(A, X, Flags),
 2280    format(string(M), "\\left[~w\\right]", [X]).
 2281
 2282paren(brackets(_), P, _Flags)
 2283 => P = 2.
 2284
 2285type(brackets(_), T, _Flags)
 2286 => T = paren.
 2287
 2288ml(braces(A), M, Flags)
 2289 => ml(A, X, Flags),
 2290    M = mrow([mo('{'), X, mo('}')]).
 2291
 2292jax(braces(A), M, Flags)
 2293 => jax(A, X, Flags),
 2294    format(string(M), "\\left\\{~w\\right\\}", [X]).
 2295
 2296paren(braces(_), P, _Flags)
 2297 => P = 3.
 2298
 2299type(braces(_), T, _Flags)
 2300 => T = paren.
 2301
 2302% Lists of things
 2303math([H | T], M)
 2304 => M = list(space, [H | T]).
 2305
 2306ml(list(_, [A]), M, Flags)
 2307 => ml(A, M, Flags).
 2308
 2309ml(list(Sep, [A, B | T]), M, Flags)
 2310 => ml(A, X, Flags),
 2311    ml(tail(Sep, [B | T]), Y, Flags),
 2312    M = mrow([X | Y]).
 2313
 2314ml(tail(Sep, [A]), M, Flags)
 2315 => ml(Sep, S, Flags),
 2316    ml(A, X, Flags),
 2317    M = [S, X].
 2318
 2319ml(tail(Sep, [A, B | T]), M, Flags)
 2320 => ml(Sep, S, Flags),
 2321    ml(A, X, Flags),
 2322    ml(tail(Sep, [B | T]), Y, Flags),
 2323    M = [S, X | Y].
 2324
 2325jax(list(_, [A]), M, Flags)
 2326 => jax(A, M, Flags).
 2327
 2328jax(list(Sep, [A, B | T]), M, Flags)
 2329 => jax(A, X, Flags),
 2330    jax(tail(Sep, [B | T]), Y, Flags),
 2331    format(string(M), "{~w}{~w}", [X, Y]).
 2332
 2333jax(tail(Sep, [A]), M, Flags)
 2334 => jax(Sep, S, Flags),
 2335    jax(A, X, Flags),
 2336    format(string(M), "{~w}{~w}", [S, X]).
 2337
 2338jax(tail(Sep, [A, B | T]), M, Flags)
 2339 => jax(Sep, S, Flags),
 2340    jax(A, X, Flags),
 2341    jax(tail(Sep, [B | T]), Y, Flags),
 2342    format(string(M), "{~w}{~w}{~w}", [S, X, Y]).
 2343
 2344paren(list(_, List), P, Flags)
 2345 => maplist(paren_(Flags), List, P0),
 2346    max_list(P0, P).
 2347
 2348prec(list(_, [A]), P, Flags)
 2349 => prec(A, P, Flags).
 2350
 2351prec(list(Sep, [_, _ | _]), P, Flags)
 2352 => prec(Sep, P, Flags).
 2353
 2354denoting(list(_, L), D, Flags)
 2355 => maplist(denoting_(Flags), L, List),
 2356    append(List, D).
 2357
 2358% Fractions
 2359ml(frac(N, D), M, Flags)
 2360 => ml(N, X, Flags),
 2361    ml(D, Y, Flags),
 2362    M = mfrac([X, Y]).
 2363
 2364jax(frac(N, D), M, Flags)
 2365 => jax(N, X, Flags),
 2366    jax(D, Y, Flags),
 2367    format(string(M), "\\frac{~w}{~w}", [X, Y]).
 2368
 2369paren(frac(_, _), P, _Flags)
 2370 => P = 0.
 2371
 2372prec(frac(_, _), P, _Flags)
 2373 => current(P, yfx, /). % was P - 1
 2374
 2375type(frac(_, _), Type, _Flags)
 2376  => Type = [fraction].
 2377
 2378% Large fraction
 2379math(dfrac(Num, Den), M)
 2380 => M = display(frac(Num, Den)).
 2381
 2382% Integer division
 2383math(div(Num, Den), M)
 2384 => M = floor(Num / Den).
 2385
 2386% Modulo
 2387math(rem(Num, Den), M)
 2388 => M = ceiling(Num / Den).
 2389
 2390
 2391% Large font ("displaystyle")
 2392ml(display(A), M, Flags)
 2393 => ml(A, X, Flags),
 2394    M = mstyle(displaystyle(true), X).
 2395
 2396jax(display(A), M, Flags)
 2397 => jax(A, X, Flags),
 2398    format(string(M), "\\displaystyle{~w}", [X]).
 2399
 2400prec(display(A), P, Flags)
 2401 => prec(A, P, Flags).
 2402
 2403type(display(A), T, Flags)
 2404 => type(A, T, Flags).
 2405
 2406% Underbrace
 2407ml(underbrace(A, U), M, Flags)
 2408 => ml(A, X, Flags),
 2409    ml(U, Y, Flags),
 2410    M = munder([munder(accentunder(true),
 2411                  [X, mo(stretchy(true), &('UnderBrace'))]), Y]).
 2412
 2413jax(underbrace(A, U), M, Flags)
 2414 => jax(A, X, Flags),
 2415    jax(U, Y, Flags),
 2416    format(string(M), "\\underbrace{~w}_{~w}", [X, Y]).
 2417
 2418paren(underbrace(A, _), Paren, Flags)
 2419 => paren(A, Paren, Flags).
 2420
 2421prec(underbrace(A, _), Prec, Flags)
 2422 => prec(A, Prec, Flags).
 2423
 2424type(underbrace(A, _), Type, Flags)
 2425 => type(A, Type, Flags).
 2426
 2427% Mistakes
 2428%
 2429% See vignette for examples
 2430%
 2431option_(NameOption, Flags) :-
 2432    option(NameOption, Flags).
 2433
 2434option_(NameOption, Flags) :-
 2435    compound_name_arguments(NameOption, Name, [Option]),
 2436    member(Name-String, Flags),
 2437    atom_string(Option, String).
 2438
 2439option_(NameOption, Flags, _Default),
 2440    compound_name_arguments(NameOption, Name, [_]),
 2441    compound_name_arguments(NameOption0, Name, [_]),
 2442    option_(NameOption0, Flags)
 2443 => NameOption = NameOption0.
 2444    
 2445option_(NameOption, _Flags, Default)
 2446 => compound_name_arguments(NameOption, _Name, [Default]).
 2447
 2448math(omit_left(Expr), M, Flags),
 2449    option_(error(ignore), Flags)
 2450 => M = Expr.
 2451
 2452math(omit_left(Expr), M, Flags),
 2453    option_(error(asis), Flags),
 2454    Expr =.. [_Op, _L, R]
 2455 => M = R.
 2456
 2457math(omit_left(Expr), M, Flags),
 2458    option_(error(fix), Flags),
 2459    Expr =.. [Op, L, R]
 2460 => M = list(space, [box(list(space, [L, op(Op)])), R]).
 2461
 2462math(omit_left(Expr), M, _Flags), % default
 2463    Expr =.. [Op, L, R]
 2464 => M = list(space, [cancel(list(space, [L, op(Op)])), R]).
 2465
 2466math(omit_right(Expr), M, Flags),
 2467    option_(error(ignore), Flags)
 2468 => M = Expr.
 2469
 2470math(omit_right(Expr), M, Flags),
 2471    option_(error(asis), Flags),
 2472    Expr =.. [_Op, L, _R]
 2473 => M = L.
 2474
 2475math(omit_right(Expr), M, Flags),
 2476    option_(error(fix), Flags),
 2477    Expr =.. [Op, L, R]
 2478 => M = list(space, [L, box(list(space, [op(Op), R]))]).
 2479
 2480math(omit_right(Expr), M, _Flags),
 2481    Expr =.. [Op, L, R]
 2482 => M = list(space, [L, cancel(list(space, [op(Op), R]))]).
 2483
 2484math(omit(_Expr), M, Flags),
 2485    option_(error(asis), Flags)
 2486 => M = "".
 2487
 2488math(omit(Expr), M, Flags),
 2489    option_(error(ignore), Flags)
 2490 => M = Expr.
 2491
 2492math(omit(Expr), M, Flags),
 2493    option_(error(fix), Flags)
 2494 => M = box(Expr).
 2495
 2496math(omit(Expr), M, _Flags)
 2497 => M = cancel(Expr).
 2498
 2499math(add_left(Expr), M, Flags),
 2500    option_(error(ignore), Flags),
 2501    Expr =.. [_Op, _L, R]
 2502 => M = R.
 2503
 2504math(add_left(Expr), M, Flags),
 2505    option_(error(asis), Flags)
 2506 => M = Expr.
 2507
 2508math(add_left(Expr), M, Flags),
 2509    option_(error(fix), Flags),
 2510    Expr =.. [Op, L, R]
 2511 => M = list(space, [cancel(list(space, [L, op(Op)])), R]).
 2512
 2513math(add_left(Expr), M, _Flags),
 2514    Expr =.. [Op, L, R]
 2515 => M = list(space, [box(list(space, [L, op(Op)])), R]).
 2516
 2517math(add_right(Expr), M, Flags),
 2518    option_(error(ignore), Flags),
 2519    Expr =.. [_Op, L, _R]
 2520 => M = L.
 2521
 2522math(add_right(Expr), M, Flags),
 2523    option_(error(asis), Flags)
 2524 => M = Expr.
 2525
 2526math(add_right(Expr), M, Flags),
 2527    option_(error(fix), Flags),
 2528    Expr =.. [Op, L, R]
 2529 => M = list(space, [L, cancel(list(space, [op(Op), R]))]).
 2530
 2531math(add_right(Expr), M, _Flags),
 2532    Expr =.. [Op, L, R]
 2533 => M = list(space, [L, box(list(space, [op(Op), R]))]).
 2534
 2535math(add(_Expr), M, Flags),
 2536    option_(error(ignore), Flags)
 2537 => M = "". % suppress at the next level, in the list
 2538
 2539math(add(Expr), M, Flags),
 2540    option_(error(asis), Flags)
 2541 => M = Expr.
 2542
 2543math(add(Expr), M, Flags),
 2544    option_(error(fix), Flags)
 2545 => M = cancel(Expr).
 2546
 2547math(add(Expr), M, _Flags)
 2548 => M = box(Expr).
 2549
 2550math(instead(_Wrong, Correct), M, Flags),
 2551    option_(error(ignore), Flags)
 2552 => M = Correct.
 2553
 2554math(instead(Wrong, _Correct), M, Flags),
 2555    option_(error(asis), Flags)
 2556 => M = Wrong.
 2557
 2558math(instead(_Wrong, Correct), M, Flags),
 2559    option_(error(fix), Flags)
 2560 => M = box(Correct).
 2561
 2562math(instead(Wrong, Correct), M, _Flags)
 2563 => M = underbrace(Wrong, list(space, ["instead", "of", Correct])).
 2564
 2565% Find minimum
 2566math(Optim, M),
 2567    compound(Optim),
 2568    compound_name_arguments(Optim, optim, [Par, Fn | _])
 2569 => M = argmin(fn(Fn, [Par])).
 2570
 2571% Probability distributions
 2572math(dbinom(K, N, Pi), M)
 2573 => M = fn(subscript('P', "Bi"), (['X' = K] ; [N, Pi])).
 2574
 2575math(pbinom(K, N, Pi), M)
 2576 => M = fn(subscript('P', "Bi"), (['X' =< K] ; [N, Pi])).
 2577
 2578math(qbinom(Alpha, N, Pi), M)
 2579 => M = fn(subscript(argmin, k),
 2580          [fn(subscript('P', "Bi"), (['X' =< k] ; [N, Pi])) > Alpha]).
 2581
 2582math(dpois(K, Rate), M)
 2583  => M = fn(subscript('P', "Po"), (['X' = K] ; [Rate])).
 2584
 2585math(ppois(K, Rate), M)
 2586  => M = fn(subscript('P', "Po"), (['X' =< K] ; [Rate])).
 2587
 2588math(qpois(Alpha, Rate), M)
 2589 => M = fn(subscript(argmax, k),
 2590          [fn(subscript('P', "Po"), (['X' =< k] ; [Rate])) > Alpha]).
 2591
 2592math(dexp(X, Rate), M)
 2593  => M = fn(subscript('f', "Exp"), ([X] ; [Rate])).
 2594
 2595math(pexp(X, Rate), M)
 2596  => M = fn(subscript('F', "Exp"), ([X] ; [Rate])).
 2597
 2598math(qexp(P, Rate), M)
 2599  => M = fn(subscript('F' ^ -1, "Exp"), ([P] ; [Rate])).
 2600
 2601math(dnorm(Z), M)
 2602 => M = fn(phi, [Z]).
 2603
 2604math(dnorm(X, Mu, Sigma2), M)
 2605 => M = fn(phi, ([X] ; [Mu, Sigma2])).
 2606
 2607math(pnorm(Z), M)
 2608 => M = fn('Phi', [Z]).
 2609
 2610math(pnorm(X, Mu, Sigma2), M)
 2611 => M = fn('Phi', ([X] ; [Mu, Sigma2])).
 2612
 2613math(qnorm(Alpha), M)
 2614 => M = fn('Phi' ^ -1, [Alpha]).
 2615
 2616math(qnorm(Alpha, Mu, Sigma2), M)
 2617 => M = fn('Phi' ^ -1, ([Alpha] ; [Mu, Sigma2])).
 2618
 2619math(pchisq(X, Df), M)
 2620 => M = fn(subscript('F', fn(chi^2, [list(space, [Df, "df"])])), [X]).
 2621
 2622math(qchisq(Alpha, Df), M)
 2623 => M = fn(subscript('F' ^ -1, fn(chi^2, [list(space, [Df, "df"])])), [Alpha]).
 2624
 2625math(pt(T, Df), M)
 2626 => M = fn('P', (['T' =< T] ; [list(space, [Df, "df"])])).
 2627
 2628math(qt(Alpha, Df), M)
 2629 => M = fn(subscript('T', Alpha), [list(space, [Df, "df"])]).
 2630
 2631% Functions like f(x) and f(x; a, b)
 2632ml(fn(Name, (Args ; Pars)), M, Flags)
 2633 => ml(Name, F, Flags),
 2634    ml(paren(list(op(;), [list(op(','), Args), list(op(','), Pars)])), X, Flags),
 2635    M = mrow([F, mo(&(af)), X]).
 2636
 2637jax(fn(Name, (Args ; Pars)), M, Flags),
 2638    string(Name)
 2639 => jax(Name, F, Flags),
 2640    jax(paren(list(op(';'), [list(op(','), Args), list(op(','), Pars)])), X, Flags),
 2641    format(string(M), "~w\\,{~w}", [F, X]).
 2642
 2643jax(fn(Name, (Args ; Pars)), M, Flags)
 2644 => jax(Name, F, Flags),
 2645    jax(paren(list(op(';'), [list(op(','), Args), list(op(','), Pars)])), X, Flags),
 2646    format(string(M), "~w{~w}", [F, X]).
 2647
 2648paren(fn(_Name, (Args ; Pars)), Paren, Flags)
 2649 => paren(list(op(','), Args), X, Flags),
 2650    paren(list(op(','), Pars), Y, Flags),
 2651    Paren is max(X, Y) + 1.
 2652
 2653prec(fn(_Name, (_Args ; _Pars)), Prec, Flags)
 2654 => prec(a * b, P0, Flags),
 2655    Prec is P0 - 1.
 2656
 2657type(fn(_Name, (_Args ; _Pars)), Type, _Flags)
 2658 => Type = [paren].
 2659
 2660ml(fn(Name, [Arg]), M, Flags),
 2661    type(Arg, paren, Flags)
 2662 => ml(Name, F, Flags),
 2663    ml(Arg, X, Flags),
 2664    M = mrow([F, mo(&(af)), X]).
 2665
 2666jax(fn(Name, [Arg]), M, Flags),
 2667    type(Arg, paren, Flags)
 2668 => jax(Name, F, Flags),
 2669    jax(Arg, X, Flags),
 2670    format(string(M), "~w{~w}", [F, X]).
 2671
 2672%
 2673% Omit parenthesis in special functions
 2674%
 2675% sum_i x_i              [prec: sum = 0 -> 401, x_i = 0]
 2676% sum_i (a_i + b_i)      [sum = 0 -> 401, + = 500]
 2677% sum_i a_i * b_i (!)    [sum = 0 -> 401, * = 400]
 2678% sum_i log p_i          [sum = 0 -> 401, log(x) = 400]
 2679%
 2680% prod_i x_i             [prod -> 400, x_i = 0]
 2681% prod_i (a_i + b_i)     [prod -> 400, + = 500]
 2682% prod_i (a_i * b_i) (!) [prod -> 400, * = 400]
 2683% prod_i log p_i         [prod -> 400, log(x) = 400]
 2684%
 2685ml(fn(Name, [Arg]), M, Flags),
 2686    type(Name, Type, Flags),
 2687    member(special, Type),
 2688    prec(Name, P, Flags),
 2689    prec(Arg, Prec, Flags),
 2690    P >= Prec
 2691 => ml(Name, F, Flags),
 2692    ml(Arg, X, Flags),
 2693    M = mrow([F, mo(&(af)), X]).
 2694
 2695jax(fn(Name, [Arg]), M, Flags),
 2696    type(Name, Type, Flags),
 2697    member(special, Type),
 2698    prec(Name, P, Flags),
 2699    prec(Arg, Prec, Flags),
 2700    P >= Prec
 2701 => jax(Name, F, Flags),
 2702    jax(Arg, X, Flags),
 2703    format(string(M), "~w{~w}", [F, X]).
 2704
 2705ml(fn(Name, [Arg]), M, Flags),
 2706    type(Name, Type, Flags),
 2707    member(Type, [special, subscript(_), superscript(_)]),
 2708    prec(Arg, 0, Flags)
 2709 => ml(Name, F, Flags),
 2710    ml(Arg, X, Flags),
 2711    M = mrow([F, mo(&(af)), X]).
 2712
 2713jax(fn(Name, [Arg]), M, Flags),
 2714    type(Name, Type, Flags),
 2715    member(Type, [special, subscript(_), superscript(_)]),
 2716    prec(Arg, 0, Flags)
 2717 => jax(Name, F, Flags),
 2718    jax(Arg, X, Flags),
 2719    format(string(M), "~w{~w}", [F, X]).
 2720
 2721ml(fn(Name, Args), M, Flags)
 2722 => ml(Name, F, Flags),
 2723    ml(paren(list(op(','), Args)), X, Flags),
 2724    M = mrow([F, mo(&(af)), X]).
 2725
 2726jax(fn(Name, Args), M, Flags)
 2727 => jax(Name, F, Flags),
 2728    jax(paren(list(op(','), Args)), X, Flags),
 2729    format(string(M), "~w{~w}", [F, X]).
 2730
 2731paren(fn(_Name, [Arg]), P, Flags),
 2732    type(Arg, paren, Flags)
 2733 => paren(Arg, P, Flags).
 2734
 2735paren(fn(_Name, [Arg]), P, Flags),
 2736    prec(Arg, P0, Flags),
 2737    P0 = 0
 2738 => paren(Arg, P, Flags).
 2739
 2740paren(fn(_Name, Args), P, Flags)
 2741 => paren(list(op(','), Args), P, Flags).
 2742
 2743prec(fn(Name, _Args), Prec, Flags),
 2744    prec(Name, P, Flags),
 2745    P = 0
 2746 => current(Prec0, yfx, *),
 2747    Prec is Prec0 - 1.
 2748
 2749prec(fn(Name, _Args), Prec, Flags)
 2750 => prec(Name, Prec, Flags).
 2751
 2752type(fn(_Name, _Args), Type, _Flags)
 2753 => Type = [function].
 2754
 2755% Comma-separated list
 2756math(R, M),
 2757    compound(R),
 2758    compound_name_arguments(R, ',', Args)
 2759 => M = list(',', Args).
 2760
 2761math(R, M),
 2762    compound(R),
 2763    compound_name_arguments(R, c, Args)
 2764 => M = paren(list(',', Args)).
 2765
 2766% Default compounds
 2767%
 2768% Can't use the macros here because of left recursion
 2769ml(A, M, Flags),
 2770    compound(A),
 2771    compound_name_arguments(A, N, Args)
 2772 => ml(fn(N, Args), M, Flags).
 2773
 2774jax(A, M, Flags),
 2775    compound(A),
 2776    compound_name_arguments(A, N, Args)
 2777 => jax(fn(N, Args), M, Flags).
 2778
 2779type(A, M, Flags),
 2780    compound(A),
 2781    compound_name_arguments(A, N, Args)
 2782 => type(fn(N, Args), M, Flags).
 2783
 2784% Defaults
 2785math(A, M)
 2786 => M = A.
 2787
 2788math(A, M, _Flags)
 2789 => M = A.
 2790
 2791math(A, M, Flags, New)
 2792 => New = Flags,
 2793    M = A.
 2794
 2795paren(A, P, Flags),
 2796    math(A, M),
 2797    dif(A, M)
 2798 => paren(M, P, Flags).
 2799
 2800paren(A, P, Flags),
 2801    math(A, M, Flags),
 2802    dif(A, M)
 2803 => paren(M, P, Flags).
 2804
 2805paren(A, P, Flags),
 2806    math(A, M, Flags, New),
 2807    dif(Flags-A, New-M)
 2808 => paren(M, P, New).
 2809
 2810paren(_A, P, _Flags)
 2811 => P = 0.
 2812
 2813prec(A, Den, Flags),
 2814    math(A, M, Flags, New),
 2815    dif(Flags-A, New-M)
 2816 => prec(M, Den, New).
 2817
 2818prec(_A, P, _Flags)
 2819 => P = 0.
 2820
 2821type(A, Type, Flags),
 2822    math(A, M),
 2823    dif(A, M)
 2824 => type(M, Type, Flags).
 2825
 2826type(A, Type, Flags),
 2827    math(A, M, Flags),
 2828    dif(A, M)
 2829 => type(M, Type, Flags).
 2830
 2831type(A, Type, Flags),
 2832    math(A, M, Flags, New),
 2833    dif(Flags-A, New-M)
 2834 => type(M, Type, New).
 2835
 2836type(A, Type, _Flags),
 2837    compound(A)
 2838 => Type = compound.
 2839
 2840denoting(A, Den, Flags),
 2841    math(A, M, Flags, New),
 2842    dif(Flags-A, New-M)
 2843 => denoting(M, Den, New).
 2844
 2845denoting(Expression, Den, Flags),
 2846    compound(Expression)
 2847 => compound_name_arguments(Expression, _, Arguments),
 2848    maplist(denoting_(Flags), Arguments, List),
 2849    append(List, Den).
 2850
 2851% If everything fails, there is no abbreviation
 2852denoting(_, Den, _Flags)
 2853 => Den = [].
 2854
 2855% Precedence
 2856current(Prec, Fix, Op) :-
 2857    atom(Op),
 2858    current_op(P, Fix, Op),
 2859    Prec = P