axiom-developer
[Top][All Lists]

## [Axiom-developer] MathML package

 From: Arthur Ralfs Subject: [Axiom-developer] MathML package Date: Fri, 05 Jan 2007 22:38:09 -0800 User-agent: Thunderbird 1.5.0.5 (X11/20060719)

Below is a package for producing presentation MathML.  It's my first attempt
and based on Robert Sutor's TeXFomat domain.  It's not finished but I would

particularly appreciate if somebody else would be interested in testing it and
letting me know what doesn't work.

For now I have three exposed functions: coerce, coerceS and coerceL.

So after compiling and then entering some Axiom command, say x**2,
type

coerce(%)
this produces the MathML string as Axiom formats things for output

coerceS(%)
this also outputs with an initial attempt at formatting based on the
structure of the MathML, so take this and paste it into a suitable xml
file and open it in Firefox.  If you paste this into emacs in nxml-mode
and indent-according-to-mode then it is supposed to be more
agreeable for human perusal.

coerceL(%)
this outputs the MathML string as one long line, more suitable for dom
insertion behind the scenes by javascript

I do intend, before I'm finished, to put this into the requisite pamphlet
style with more detailed documentation.  I also have plans to start soon
on a content MathML package.

--Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
--
--Redistribution and use in source and binary forms, with or without
--modification, are permitted provided that the following conditions are
--met:
--
--    - Redistributions of source code must retain the above copyright
--      notice, this list of conditions and the following disclaimer.
--
--    - Redistributions in binary form must reproduce the above copyright
--      notice, this list of conditions and the following disclaimer in
--      the documentation and/or other materials provided with the
--      distribution.
--
--    - Neither the name of The Numerical ALgorithms Group Ltd. nor the
--      names of its contributors may be used to endorse or promote products

-- derived from this software without specific prior written permission.
--
--THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
--IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
--TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
--PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
--OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
--EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
--PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
--PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
--LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
--NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
--SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

)abbrev domain MMLFORM MathMLFormat
++ Author: Arthur C. Ralfs
++ Date: January 2007
++ This package is based on the TeXFormat domain by Robert S. Sutor
++ without which I wouldn't have known where to start.

MathMLFormat(): public == private where
E      ==> OutputForm
I      ==> Integer
L      ==> List
S      ==> String
US     ==> UniversalSegment(Integer)

public == SetCategory with
coerce:   E -> S
++ coerceS(o) changes o in the standard output format to MathML
++ format.
coerceS:   E -> S
++ coerceS(o) changes o in the standard output format to MathML
++ format and displays formatted result.
coerceL:   E -> S
++ coerceS(o) changes o in the standard output format to MathML
++ format and displays result as one long string.

import OutputForm
import Character
import Integer
import List OutputForm
import List String

-- local variables declarations and definitions

expr: E
prec,opPrec: I
str:  S
blank         : S := " \  "

maxPrec       : I   := 1000000
minPrec       : I   := 0

unaryOps      : L S := ["-","^"]$(L S) unaryPrecs : L I := [700,260]$(L I)

-- the precedence of / in the following is relatively low because
-- the bar obviates the need for parentheses.
binaryOps     : L S := ["+->","|","**","/","<",">","=","OVER"]$(L S) binaryPrecs : L I := [0,0,900, 700,400,400,400, 700]$(L I)

naryOps       : L S := ["-","+","*",blank,",",";"," ","ROW","",
" \cr ","&","</mtd></mtr><mtr><mtd>"]$(L S) naryPrecs : L I := [700,700,800, 800,110,110, 0, 0, 0, 0, 0, 0]$(L I)
naryNGOps     : L S := ["ROW","&"]$(L S)  plexOps : L S := ["SIGMA","SIGMA2","PI","PI2","INTSIGN","INDEFINTEGRAL"]$(L S) plexPrecs : L I := [ 700, 800, 700, 800 , 700, 700]$(L I)   specialOps : L S := ["MATRIX","BRACKET","BRACE","CONCATB","VCONCAT", _ "AGGLST","CONCAT","OVERBAR","ROOT","SUB","TAG", _  "SUPERSUB","ZAG","AGGSET","SC","PAREN", _ "SEGMENT","QUOTE","theMap" ] -- the next two lists provide translations for some strings for -- which MML provides special macros. specialStrings : L S := ["cos", "cot", "csc", "log", "sec", "sin", "tan", "cosh", "coth", "csch", "sech", "sinh", "tanh", "acos","asin","atan","erf","...","$","infinity"]
specialStringsInMML : L S :=

["<mo>cos</mo>","<mo>cot</mo>","<mo>csc</mo>","<mo>log</mo>","<mo>sec</mo>","<mo>sin</mo>","<mo>tan</mo>", "<mo>cosh</mo>","<mo>coth</mo>","<mo>csch</mo>","<mo>sech</mo>","<mo>sinh</mo>","<mo>tanh</mo>", "<mo>arccos</mo>","<mo>arcsin</mo>","<mo>arctan</mo>","<mo>erf</mo>","<mo>&#x2026;</mo>","<mo>$</mo>","<mo>&#x221E;</mo>"]  -- local function signatures addBraces: S -> S addBrackets: S -> S displayElt: S -> Void ++ function for recursively displaying mathml nicely formatted eltLimit: (S,I,S) -> I ++ demarcates end postion of mathml element with name:S starting at ++ position i:I in mathml string s:S and returns end of end tag as ++ i:I position in mathml string, i.e. find start and end of ++ substring: <name ...>...</name> eltName: (I,S) -> S ++ find name of mathml element starting at position i:I in string s:S exprex: E -> S group: S -> S formatBinary: (S,L E, I) -> S formatFunction: (S,L E, I) -> S formatMatrix: L E -> S formatNary: (S,L E, I) -> S formatNaryNoGroup: (S,L E, I) -> S formatNullary: S -> S formatPlex: (S,L E, I) -> S formatSpecial: (S,L E, I) -> S formatUnary: (S, E, I) -> S formatMml: (E,I) -> S newWithNum: I ->$
parenthesize:   S -> S
precondition:   E -> E
postcondition:  S -> S
stringify:      E -> S
tagEnd:         (S,I,S) -> I
++  finds closing ">" of start or end tag for mathML element
ungroup:        S -> S

-- public function definitions

coerce(expr : E): S ==
s : S := postcondition formatMml(precondition expr, minPrec)
s

coerceS(expr : E): S ==
s : S := postcondition formatMml(precondition expr, minPrec)

sayTeX$Lisp "<math xmlns=_"http://www.w3.org/1998/Math/MathML_"; mathsize=_"big_" display=_"block_">"  displayElt(s) sayTeX$Lisp "[/itex]"
s

coerceL(expr : E): S ==
s : S := postcondition formatMml(precondition expr, minPrec)

sayTeX$Lisp "<math xmlns=_"http://www.w3.org/1998/Math/MathML_"; mathsize=_"big_" display=_"block_">"  sayTeX$Lisp s
sayTeX$Lisp "[/itex]" s -- local function definitions displayElt(mathML:S): Void == -- Takes a string of syntactically complete mathML -- and formats it for display. -- sayTeX$Lisp "****displayElt1****"
--      sayTeX$Lisp mathML enT:I -- marks end of tag, e.g. "<name>" enE:I -- marks end of element, e.g. "<name> ... </name>" end:I -- marks end of mathML string u:US end := #mathML length:I := 60 -- sayTeX$Lisp "****displayElt1.1****"
name:S := eltName(1,mathML)
--      sayTeX$Lisp name -- sayTeX$Lisp concat("****displayElt1.2****",name)
enE := eltLimit(name,2+#name,mathML)
--      sayTeX$Lisp "****displayElt2****" if enE < length then -- sayTeX$Lisp "****displayElt3****"
u := segment(1,enE)$US sayTeX$Lisp mathML.u
else
--        sayTeX$Lisp "****displayElt4****" enT := tagEnd(name,1,mathML) u := segment(1,enT)$US
sayTeX$Lisp mathML.u u := segment(enT+1,enE-#name-3)$US
displayElt(mathML.u)
u := segment(enE-#name-2,enE)$US sayTeX$Lisp mathML.u
if end > enE then
--        sayTeX$Lisp "****displayElt5****" u := segment(enE+1,end)$US
displayElt(mathML.u)

void()$Void eltName(pos:I,mathML:S): S == -- Assuming pos is the position of "<" for a start tag of a mathML -- element finds and returns the element's name. i:I := pos+1 --sayTeX$Lisp "eltName:mathmML string: "mathML

while member?(mathML.i,lowerCase()$CharacterClass)$CharacterClass repeat
        i := i+1
u:US := segment(pos+1,i-1)
name:S := mathML.u

eltLimit(name:S,pos:I,mathML:S): I ==
-- Finds the end of a mathML element like "<name ...> ... </name>"
-- where pos is the position of the space after name in the start tag
-- although it could point to the closing ">".  Returns the position
-- of the ">" in the end tag.
pI:I := pos
startI:I
endI:I
startS:S := concat ["<",name]
endS:S := concat ["</",name,">"]
level:I := 1
--sayTeX$Lisp "eltLimit: element name: "name while (level > 0) repeat startI := position(startS,mathML,pI)$String

endI := position(endS,mathML,pI)$String if (startI = 0) then level := level-1 --sayTeX$Lisp "****eltLimit 1******"
pI := tagEnd(name,endI,mathML)
else
if (startI < endI) then
level := level+1
pI := tagEnd(name,startI,mathML)
else
level := level-1
pI := tagEnd(name,endI,mathML)
pI

tagEnd(name:S,pos:I,mathML:S):I ==
-- Finds the closing ">" for either a start or end tag of a mathML
-- element, so the return value is the position of ">" in mathML.
pI:I := pos
while  (mathML.pI ^= char ">") repeat
pI := pI+1
u:US := segment(pos,pI)$US --sayTeX$Lisp "tagEnd: "mathML.u
pI

exprex(expr : E): S ==
-- This is an attempt to break down the expr into atoms, not
-- satisfactorily so far.
le : L E := expr pretend L E
--      le : L E := (first rest le) pretend L E
--      le : L E := (first rest le) pretend L E
s : S := stringify first le
--      if #le > 1 then
--        for a in rest le repeat
--      s := concat [s,"{",exprex first rest le,"}"]
--      s := exprex first rest le

ungroup(str: S): S ==
len : I := #str
len < 14 => str
lrow : S :=  "<mrow>"
rrow : S :=  "</mrow>"
-- drop leading and trailing mrows
u1 : US := segment(1,6)$US u2 : US := segment(len-6,len)$US
if (str.u1 =$S lrow) and (str.u2 =$S rrow) then
u : US := segment(7,len-7)$US str := str.u str postcondition(str: S): S == str := ungroup str len : I := #str plusminus : S := "<mo>+</mo><mo>-</mo>" pos : I := position(plusminus,str,1) if pos > 0 then ustart:US := segment(1,pos-1)$US
uend:US := segment(pos+20,len)$US str := concat [str.ustart,"<mo>-</mo>",str.uend] if pos < len-18 then str := postcondition(str) str stringify expr == (object2String$Lisp expr)@S

group str ==
concat ["<mrow>",str,"</mrow>"]

concat ["<mo>[</mo>",str,"<mo>}</mo>"]

concat ["<mo>[</mo>",str,"<mo>]</mo>"]

parenthesize str ==
concat ["<mo>(</mo>",str,"<mo>)</mo>"]

precondition expr ==
outputTran$Lisp expr formatSpecial(op : S, args : L E, prec : I) : S == arg : E prescript : Boolean := false op = "theMap" => "<mtext>theMap(...)</mtext>" op = "AGGLST" => formatNary(",",args,prec) op = "AGGSET" => formatNary(";",args,prec) op = "TAG" => group concat [formatMml(first args,prec), "<mo>&RightArrow;</mo>", formatMml(second args,prec)] op = "VCONCAT" => group concat("<mtable><mtr>",  concat(concat([concat("<mtd>",concat(formatMml(u, minPrec),"</mtd>"))  for u in args]::L S), "</mtr></mtable>")) op = "CONCATB" => formatNary(" ",args,prec) op = "CONCAT" => formatNary("",args,minPrec) op = "QUOTE" => group concat("<mo>'</mo>",formatMml(first args, minPrec)) op = "BRACKET" => group addBrackets ungroup formatMml(first args, minPrec) op = "BRACE" => group addBraces ungroup formatMml(first args, minPrec) op = "PAREN" => group parenthesize ungroup formatMml(first args, minPrec) op = "OVERBAR" => null args => ""  group concat ["<mover accent='true'><mrow>",formatMml(first args,minPrec),"</mrow><mo stretchy='true'>&OverBar;</mo>"]  op = "ROOT" => null args => "" tmp : S := group formatMml(first args, minPrec) null rest args => concat ["<msqrt>",tmp,"</msqrt>"] group concat  ["<mroot><mrow>",formatMml(first rest args, minPrec),"</mrow>",tmp,"</mroot>"]  op = "SEGMENT" => tmp : S := concat [formatMml(first args, minPrec),"<mo>..</mo>"] group null rest args => tmp concat [tmp,formatMml(first rest args, minPrec)] op = "SUB" => group concat ["<msub>",formatMml(first args, minPrec), formatSpecial("AGGLST",rest args,minPrec),"</msub>"] op = "SUPERSUB" => base:S := formatMml(first args, minPrec) args := rest args if #args = 1 then  "<msub><mrow>"base"</mrow><mrow>"formatMml(first args, minPrec)"</mrow></msub>"  else if #args = 2 then  "<msubsup><mrow>"base"</mrow><mrow>"formatMml(first args,minPrec)"</mrow><mrow>"formatMml(first rest args, minPrec)"</mrow></msubsup>"  else if #args = 3 then  "<mmultiscripts><mrow>"base"</mrow><mrow>"formatMml(first args,minPrec)"</mrow><mrow>"formatMml(first rest args,minPrec)"</mrow><mprescripts/><mrow>"formatMml(first rest rest args,minPrec)"</mrow><none/></mmultiscripts>"  else if #args = 4 then  "<mmultiscripts><mrow>"base"</mrow><mrow>"formatMml(first args,minPrec)"</mrow><mrow>"formatMml(first rest args,minPrec)"</mrow><mprescripts/><mrow>"formatMml(first rest rest args,minPrec)"</mrow><mrow>"formatMml(first rest rest rest args,minPrec)"</mrow></mmultiscripts>"  else "<mtext>Problem with multiscript object</mtext>" op = "SC" => -- need to handle indentation someday null args => "" tmp := formatNaryNoGroup("</mtd></mtr><mtr><mtd>", args, minPrec) group concat ["<mtable><mtr><mtd>",tmp,"</mtd></mtr></mtable>"] op = "MATRIX" => formatMatrix rest args op = "ZAG" => concat [" \zag{",formatMml(first args, minPrec),"}{", formatMml(first rest args,minPrec),"}"] concat ["<mtext>not done yet for: ",op,"</mtext>"] formatPlex(op : S, args : L E, prec : I) : S == hold : S p : I := position(op,plexOps) p < 1 => error "unknown plex op" opPrec := plexPrecs.p n : I := #args (n ^= 2) and (n ^= 3) => error "wrong number of arguments for plex" s : S := op = "SIGMA" => "<mo>&Sum;</mo>" op = "SIGMA2" => "<mo>&Sum;</mo>" op = "PI" => "<mo>&Product;</mo>" op = "PI2" => "<mo>&Product;</mo>" op = "INTSIGN" => "<mo>&Integral;</mo>" op = "INDEFINTEGRAL" => "<mo>&Integral;</mo>" "????" hold := formatMml(first args,minPrec) args := rest args if op ^= "INDEFINTEGRAL" then if hold ^= "" then s := concat ["<munderover>",s,group hold] else s := concat ["<munderover>",s,group " "] if not null rest args then hold := formatMml(first args,minPrec) if hold ^= "" then s := concat [s,group hold,"</munderover>"] else s := concat [s,group " ","</munderover>"] args := rest args s := concat [s,formatMml(first args,minPrec)] else hold := group concat [hold,formatMml(first args,minPrec)] s := concat [s,hold] if opPrec < prec then s := parenthesize s group s formatMatrix(args : L E) : S == -- format for args is [[ROW ...],[ROW ...],[ROW ...]] -- generate string for formatting columns (centered) group addBrackets concat  ["<mtable><mtr><mtd>",formatNaryNoGroup("</mtd></mtr><mtr><mtd>",args,minPrec),  "</mtd></mtr></mtable>"] formatFunction(op : S, args : L E, prec : I) : S ==  group concat ["<mo>",op,"</mo>",parenthesize formatNary(",",args,minPrec)]  formatNullary(op : S) == op = "NOTHING" => "" group concat ["<mo>",op,"</mo><mo>(</mo><mo>)</mo>"] formatUnary(op : S, arg : E, prec : I) == p : I := position(op,unaryOps) p < 1 => error "unknown unary op" opPrec := unaryPrecs.p s : S := concat ["<mo>",op,"</mo>",formatMml(arg,opPrec)] opPrec < prec => group parenthesize s op = "-" => s group s formatBinary(op : S, args : L E, prec : I) : S == p : I := position(op,binaryOps) p < 1 => error "unknown binary op" opPrec := binaryPrecs.p s1 : S := formatMml(first args, opPrec) s2 : S := formatMml(first rest args, opPrec) op :=  op = "|" => s := concat ["<mrow>",s1,"</mrow><mo>",op,"</mo><mrow>",s2,"</mrow>"] op = "**" => s := concat ["<msup><mrow>",s1,"</mrow><mrow>",s2,"</mrow></msup>"] op = "/" => s := concat ["<mfrac><mrow>",s1,"</mrow><mrow>",s2,"</mrow></mfrac>"] op = "OVER" => s := concat ["<mfrac><mrow>",s1,"</mrow><mrow>",s2,"</mrow></mfrac>"] op = "+->" => s := concat ["<mrow>",s1,"</mrow><mo>",op,"</mo><mrow>",s2,"</mrow>"] s := concat ["<mrow>",s1,"</mrow><mo>",op,"</mo><mrow>",s2,"</mrow>"]  group op = "OVER" => s opPrec < prec => parenthesize s s formatNary(op : S, args : L E, prec : I) : S == group formatNaryNoGroup(op, args, prec) formatNaryNoGroup(op : S, args : L E, prec : I) : S == null args => "" p : I := position(op,naryOps) p < 1 => error "unknown nary op" op := op = "," => "<mo>,</mo>" --originally , \:  op = ";" => "<mo>;</mo>" --originally ; \: should figure these out  op = "*" => "<mo>&InvisibleTimes;</mo>" op = " " => "<mspace width='0.5em'/>" op = "ROW" => "</mtd><mtd>" op = "+" => "<mo>+</mo>" op = "-" => "<mo>-</mo>" op l : L S := nil opPrec := naryPrecs.p for a in args repeat l := concat(op,concat(formatMml(a,opPrec),l)$L(S))$L(S) s : S := concat reverse rest l opPrec < prec => parenthesize s s formatMml(expr,prec) == i,len : Integer intSplitLen : Integer := 20 ATOM(expr)address@hidden => str := stringify expr len := #str -- this bit seems to deal with integers FIXP$Lisp expr =>
i := expr pretend Integer
if (i < 0) or (i > 9)
then
group
nstr : String := ""
-- insert some blanks into the string, if too long
while ((len := #str) > intSplitLen) repeat
nstr := concat [nstr," ",
elt(str,segment(1,intSplitLen)$US)] str := elt(str,segment(intSplitLen+1)$US)
empty? nstr => concat ["<mn>",str,"</mn>"]
nstr :=
empty? str => nstr
concat [nstr," ",str]
concat ["<mn>",elt(nstr,segment(2)$US),"</mn>"] else str := concat ["<mn>",str,"</mn>"] str = "%pi" => "<mi>&pi;</mi>" str = "%e" => "<mi>&ExponentialE;</mi>" str = "%i" => "<mi>&ImaginaryI;</mi>" -- what sort of atom starts with %%? need an example len > 1 and str.1 = char "%" and str.2 = char "%" => u : US := segment(3,len)$US
concat(concat("<mi>",str.u),"</mi>")
len > 0 and str.1 = char "%" => concat(concat("<mi>",str),"</mi>")

len > 1 and digit? str.1 => concat ["<mn>",str,"</mn>"] -- should handle floats
   -- presumably this is a literal string
len > 0 and str.1 = char "_"" =>
concat(concat("<mtext>",str),"</mtext>")
len = 1 and str.1 = char " " => "{\ }"
(i := position(str,specialStrings)) > 0 =>
specialStringsInMML.i
(i := position(char " ",str)) > 0 =>
-- We want to preserve spacing, so use a roman font.
-- What's this for?  Leave the \rm in for now so I can see
-- where it arises.
concat(concat("<mtext>\rm ",str),"</mtext>")
-- if we get to here does that mean it's a variable?
concat ["<mi>",str,"</mi>"]
l : L E := (expr pretend L E)
null l => blank
op : S := stringify first l
args : L E := rest l
nargs : I := #args

-- special cases
member?(op, specialOps) => formatSpecial(op,args,prec)
member?(op, plexOps)    => formatPlex(op,args,prec)

-- nullary case
0 = nargs => formatNullary op

-- unary case
(1 = nargs) and member?(op, unaryOps) =>
formatUnary(op, first args, prec)

-- binary case
(2 = nargs) and member?(op, binaryOps) =>
formatBinary(op, args, prec)

-- nary case
member?(op,naryNGOps) => formatNaryNoGroup(op,args, prec)
member?(op,naryOps) => formatNary(op,args, prec)
op := formatMml(first l,minPrec)
formatFunction(op,args,prec)