[Axiom-developer] mathml sums and products patch

[Arthur Ralfs]

Tim,

This patch fixes some ambiguities in the display of sums and
products brought to my attention by Martin.  It doesn't bring the
silver version of mathml into sync with what I have.  I'll leave that
possibly for later.

The problems can be seen in the output from the following commands:

1. summation(i^2,i=a..b)^(d-c)
2. summation(i^2^(d-c),i=a..b)
3. sum(operator(f)(i)+1,i=1..n)
4. sum(operator(f)(i),i=1..n)+1
5. sum(operator(f)(i)+1,i=1..n)^3

Arthur

Note to Waldek if you notice this:  since the mathml code in Axiom and
 FriCAS has already diverged I'll be issuing a separate patch for FriCAS
shortly.

--- mathml.spad.pamphlet        2007-12-26 13:49:34.000000000 -0800
+++ mathml.spad.pamphlet.new    2007-12-29 12:14:36.000000000 -0800
@@ -1011,10 +1011,10 @@
     formatSuperSub(expr : E, args : L E, opPrec : I) : S ==
       -- this produces prime notation ordinary derivatives.
       -- first have to divine the semantics, add cases as needed
-      WriteLine$Lisp "SuperSub1 begin"
+--      WriteLine$Lisp "SuperSub1 begin"
       atomE : L E := atomize(expr)      
       op : S := stringify first atomE
-      WriteLine$Lisp "op: "op
+--      WriteLine$Lisp "op: "op
       op ^= "SUPERSUB" => _
           "<mtext>Mistake in formatSuperSub: no SUPERSUB1</mtext>"
       #args ^= 1 => "<mtext>Mistake in SuperSub1: #args <> 1</mtext>"
@@ -1024,9 +1024,9 @@
       -- {{{SUPERSUB}{y}{ }{,,}}{x}}, expr is the first {} and args is the
       -- {x}
       funcS : S := stringify first rest atomE
-      WriteLine$Lisp "funcS: "funcS
+--      WriteLine$Lisp "funcS: "funcS
       bvarS : S := stringify first args
-      WriteLine$Lisp "bvarS: "bvarS
+--      WriteLine$Lisp "bvarS: "bvarS
       -- count the number of commas
       commaS : S := stringify first rest rest rest atomE
       commaTest : S := ","
@@ -1035,7 +1035,7 @@
         i := i+1
        commaTest := commaTest","
       s : S := "<msup><mi>"funcS"</mi><mrow>"
-      WriteLine$Lisp "s: "s
+--      WriteLine$Lisp "s: "s
       j : I := 0
       while j < i repeat
         s := s"<mo>&#x02032;</mo>"
@@ -1046,7 +1046,7 @@
       -- This one produces ordinary derivatives with differential notation,
       -- it needs a little more work yet.
       -- first have to divine the semantics, add cases as needed
-      WriteLine$Lisp "SuperSub begin"
+--      WriteLine$Lisp "SuperSub begin"
       atomE : L E := atomize(expr)      
       op : S := stringify first atomE
       op ^= "SUPERSUB" => _
@@ -1069,6 +1069,7 @@
       s : S := 
"<mfrac><mrow><msup><mo>&#x02146;</mo><mn>"string(ndiffs)"</mn></msup><mi>"funcS"</mi></mrow><mrow><mo>&#x02146;</mo><msup><mi>"formatMml(first
 
args,minPrec)"</mi><mn>"string(ndiffs)"</mn></msup></mrow></mfrac><mo>&#x02061;</mo><mo>(</mo><mi>"formatMml(first
 args,minPrec)"</mi><mo>)</mo>"
 
     formatPlex(op : S, args : L E, prec : I) : S ==
+      checkarg:Boolean := false
       hold : S
       p : I := position(op,plexOps)
       p < 1 => error "unknown plex op"
@@ -1077,13 +1078,21 @@
       n : I := #args
       (n ^= 2) and (n ^= 3) => error "wrong number of arguments for plex"
       s : S :=
-        op = "SIGMA"   => "<mo>&#x02211;</mo>"
+        op = "SIGMA"   => 
+         checkarg := true
+         "<mo>&#x02211;</mo>"
        -- Sum
-        op = "SIGMA2"   => "<mo>&#x02211;</mo>"
+        op = "SIGMA2"   => 
+         checkarg := true
+         "<mo>&#x02211;</mo>"
        -- Sum
-        op = "PI"      => "<mo>&#x0220F;</mo>"
+        op = "PI"      => 
+         checkarg := true
+         "<mo>&#x0220F;</mo>"
        -- Product
-        op = "PI2"     => "<mo>&#x0220F;</mo>"
+        op = "PI2"     => 
+         checkarg := true
+         "<mo>&#x0220F;</mo>"
        -- Product
 --        op = "INTSIGN" => "<mo>&#x0222B;</mo>"
        -- Integral, int
@@ -1104,7 +1113,15 @@
          else
            s := concat [s,group " ","</munderover>"]
           args := rest args
-        s := concat [s,formatMml(first args,minPrec)]
+       -- if checkarg true need to test op arg for "+" at least
+       -- and wrap parentheses if so
+       if checkarg then
+          la : L E := (first args pretend L E)
+          opa : S := stringify first la
+         if opa = "+" then
+            s := concat [s,"<mo>(</mo>",formatMml(first 
args,minPrec),"<mo>)</mo>"]
+          else s := concat [s,formatMml(first args,minPrec)]
+        else s := concat [s,formatMml(first args,minPrec)]
       else
         hold := group concat [hold,formatMml(first args,minPrec)]
         s := concat [s,hold]
@@ -1178,7 +1195,16 @@
       p : I := position(op,binaryOps)
       p < 1 => error "unknown binary op"
       opPrec := binaryPrecs.p
-      s1 : S := formatMml(first args, opPrec)
+      -- if base op is product or sum need to add parentheses
+      if ATOM(first args)address@hidden then
+        opa:S := stringify first args
+      else
+        la : L E := (first args pretend L E)
+        opa : S := stringify first la
+      if (opa = "SIGMA" or opa = "SIGMA2" or opa = "PI" or opa = "PI2") and op 
= "**" then
+        s1 : S := concat ["<mo>(</mo>",formatMml(first args, 
opPrec),"<mo>)</mo>"]
+      else 
+       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>"]
@@ -1197,6 +1223,8 @@
       group formatNaryNoGroup(op, args, prec)
 
     formatNaryNoGroup(op : S, args : L E, prec : I) : S ==
+--      WriteLine$Lisp "formatNaryNoGroup start"
+      checkargs:Boolean := false
       null args => ""
       p : I := position(op,naryOps)
       p < 1 => error "unknown nary op"
@@ -1230,20 +1258,51 @@
           position("ZAG",tmpS,1) > 0 => formatZag(args)
 --        position("ZAG",tmpS,1) > 0 => formatZag1(args)
           concat [formatMml(first args,minPrec) "<mo>+</mo>" formatZag(rest 
args)]
+      -- At least for the ops "*","+","-" we need to test to see if a sigma or 
pi
+      -- is one of their arguments because we might need parentheses as 
indicated
+      -- by the problem with summation(operator(f)(i),i=1..n)+1 versus 
+      -- summation(operator(f)(i)+1,i=1..n) having identical displays as of
+      -- 2007-12-21
       op :=
         op = ","     => "<mo>,</mo>" --originally , \:
         op = ";"     => "<mo>;</mo>" --originally ; \: should figure these out
-        op = "*"     => "<mo>&#x02062;</mo>"
+        op = "*"     =>
+           checkargs := true
+           "<mo>&#x02062;</mo>"
        -- InvisibleTimes
         op = " "     => "<mspace width='0.5em'/>"
         op = "ROW"   => "</mtd><mtd>"
-       op = "+"     => "<mo>+</mo>"
-       op = "-"     => "<mo>-</mo>"
+       op = "+"     => 
+           checkargs := true
+           "<mo>+</mo>"
+       op = "-"     => 
+           checkargs := true
+           "<mo>-</mo>"
         op
       l : L S := nil
       opPrec := naryPrecs.p
+      -- if checkargs is true check each arg except last one to see if it's
+      -- a sigma or pi and if so add parentheses. Other op's may have to be
+      -- checked for in future
+      count:I := 1
       for a in args repeat
-        l := concat(op,concat(formatMml(a,opPrec),l)$L(S))$L(S)
+--        WriteLine$Lisp "checking args"
+        if checkargs then
+         if count < #args then
+           -- check here for sum or product
+           if ATOM(a)address@hidden then
+             opa:S := stringify a
+           else
+             la : L E := (a pretend L E)
+             opa : S := stringify first la
+--            la : L E := (a pretend L E)
+--            opa : S := stringify first la
+           if opa = "SIGMA" or opa = "SIGMA2" or opa = "PI" or opa = "PI2" then
+             l := concat(op,concat(concat 
["<mo>(</mo>",formatMml(a,opPrec),"<mo>)</mo>"],l)$L(S))$L(S)
+           else l := concat(op,concat(formatMml(a,opPrec),l)$L(S))$L(S)
+         else l := concat(op,concat(formatMml(a,opPrec),l)$L(S))$L(S)
+       else l := concat(op,concat(formatMml(a,opPrec),l)$L(S))$L(S)
+       count := count + 1
       s : S := concat reverse rest l
       opPrec < prec => parenthesize s
       s