1:- module(pval, []).    2:- reexport(library(mathml)).    3
    4:- multifile math_hook/2, math_hook/3, math_hook/4.    5
    6% p-value: if numeric, show e.g. as < 0.001
    7mathml:math_hook(pval(A), M, Flags, Flags1) :-
    8    M = A,
    9    Flags1 = [pval(.) | Flags].
   10
   11% p-value with p symbol
   12mathml:math_hook(pval(A, P), M, Flags, Flags1) :-
   13    M = A,
   14    Flags1 = [pval(P) | Flags].
   15
   16% Round t-statistic to two digits
   17mathml:math_hook(tstat(A), M, Flags, Flags1) :-
   18    M = A,
   19    Flags1 = [digits(2) | Flags].
   20
   21% Render 0.05 as 5%
   22mathml:math_hook(percent(A), M, Flags, Flags1) :-
   23    option(digits(D), Flags, 2),
   24    D1 is D - 2,
   25    Flags1 = [digits(D1), mult(100) | Flags],
   26    M = list("", [A, '%'])