[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[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.
--All rights reserved.
--
--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.
private == add
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>…</mo>","<mo>$</mo>","<mo>∞</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 "</math>"
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 "</math>"
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>"]
addBraces str ==
concat ["<mo>[</mo>",str,"<mo>}</mo>"]
addBrackets str ==
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>→</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'>‾</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>∑</mo>"
op = "SIGMA2" => "<mo>∑</mo>"
op = "PI" => "<mo>∏</mo>"
op = "PI2" => "<mo>∏</mo>"
op = "INTSIGN" => "<mo>∫</mo>"
op = "INDEFINTEGRAL" => "<mo>∫</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>⁢</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>π</mi>"
str = "%e" => "<mi>ⅇ</mi>"
str = "%i" => "<mi>ⅈ</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)
- [Axiom-developer] MathML package,
Arthur Ralfs <=