%mathpiper,def="PrettyForm;EvalFormula"

/* def file definitions
EvalFormula
*/


/*
TODO:
- Func(a=b) prematurely evaluates a=b
- clean up the code!
  - document the code!!!
- prefix/postfix currently not used!!!
- some rules for rendering the formula are slooooww....

- bin, derivative, sqrt, integral, summation, limits,
      ___
     / a |
 \  /  -
  \/   b

   /
   |
   |
   |
   /

  d
 --- f( x )
 d x

   2
  d
 ----  f( x )
    2
 d x

  Infinity
    ___
    \
     \    n
     /   x
    /__
    n = 0
                 Sin(x)
     lim         ------
 x -> Infinity    x



*/

/*
NLog(str):=
[
  WriteString(str);
  NewLine();
];
*/




CharList(length,item):=
[
  Local(line,i);
  line:="";
  For(Bind(i,0),IsLessThan(i,length),Bind(i,AddN(i,1)))
    Bind(line, line:item);
  line;
];




CharField(width,height) := ArrayCreate(height,CharList(width," "));




WriteCharField(charfield):=
[
  Local(i,len);
  len:=Length(charfield);
  For(Bind(i,1),i<=len,Bind(i,AddN(i,1)))
  [
    WriteString(charfield[i]);
    NewLine();
  ];
  True;
];




ColumnFilled(charfield,column):=
[
  Local(i,result,len);
  result:=False;
  len:=Length(charfield);
  For(Bind(i, 1),(result = False) And (i<=len),Bind(i,AddN(i,1)))
  [
    If(StringMidGet(column,1,charfield[i]) != " ",result:=True);
  ];
  result;
];




WriteCharField(charfield,width):=
[
  Local(pos,length,len);
  Bind(length, Length(charfield[1]));
  Bind(pos, 1);
  While(pos<=length)
  [
    Local(i,thiswidth);
    Bind(thiswidth, width);
    If(thiswidth>(length-pos)+1,
      [
        Bind(thiswidth, AddN(SubtractN(length,pos),1));
      ],
      [
        While (thiswidth>1 And ColumnFilled(charfield,pos+thiswidth-1))
        [
          Bind(thiswidth,SubtractN(thiswidth,1));
        ];
        If(thiswidth = 1, Bind(thiswidth, width));
      ]
    );
    len:=Length(charfield);
    For(Bind(i, 1),i<=len,Bind(i,AddN(i,1)))
    [
      WriteString(StringMidGet(pos,thiswidth,charfield[i]));
      NewLine();
    ];
    Bind(pos, AddN(pos, thiswidth));
    NewLine();
  ];
  True;
];




PutString(charfield,x,y,string):=
[
  cf[y] := StringMidSet(x,string,cf[y]);
  True;
];




MakeOper(x,y,width,height,oper,args,base):=
[
  Local(result);
  Bind(result,ArrayCreate(7,0));
  ArraySet(result,1,x);
  ArraySet(result,2,y);
  ArraySet(result,3,width);
  ArraySet(result,4,height);
  ArraySet(result,5,oper);
  ArraySet(result,6,args);
  ArraySet(result,7,base);
  result;
];




MoveOper(f,x,y):=
[
  f[1]:=AddN(f[1], x); /* move x */
  f[2]:=AddN(f[2], y); /* move y */
  f[7]:=AddN(f[7], y); /* move base */
];




AlignBase(i1,i2):=
[
  Local(base);
  Bind(base, Maximum(i1[7],i2[7]));
  MoveOper(i1,0,SubtractN(base,(i1[7])));
  MoveOper(i2,0,SubtractN(base,(i2[7])));
];




10 # BuildArgs({}) <-- Formula(ToAtom(" "));




20 # BuildArgs({_head}) <-- head;




30 # BuildArgs(_any)    <--
     [
        Local(item1,item2,comma,base,newitem);
        Bind(item1, any[1]);
        Bind(item2, any[2]);
        Bind(comma, Formula(ToAtom(",")));
        Bind(base, Maximum(item1[7],item2[7]));
        MoveOper(item1,0,SubtractN(base,(item1[7])));
        MoveOper(comma,AddN(item1[3],1),base);

        MoveOper(item2,comma[1]+comma[3]+1,SubtractN(base,(item2[7])));
        Bind(newitem, MakeOper(0,0,AddN(item2[1],item2[3]),Maximum(item1[4],item2[4]),"Func",{item1,comma,item2},base));
        BuildArgs(newitem:Rest(Rest(any)));
      ];




FormulaBracket(f):=
[
  Local(left,right);
  Bind(left, Formula(ToAtom("(")));
  Bind(right, Formula(ToAtom(")")));
  left[4]:=f[4];
  right[4]:=f[4];
  MoveOper(left,f[1],f[2]);
  MoveOper(f,2,0);
  MoveOper(right,f[1]+f[3]+1,f[2]);
  MakeOper(0,0,right[1]+right[3],f[4],"Func",{left,f,right},f[7]);
];




/* Rulebase("Formula",{f}); */

1 # Formula(f_IsAtom) <--
  MakeOper(0,0,Length(ToString(f)),1,"ToAtom",ToString(f),0);




2 # Formula(_xx ^ _yy) <--
[
  Local(l,r);
  Bind(l, BracketOn(Formula(xx),xx,LeftPrecedenceGet("^")));
  Bind(r, BracketOn(Formula(yy),yy,RightPrecedenceGet("^")));
  MoveOper(l,0,r[4]);
  MoveOper(r,l[3],0);
  MakeOper(0,0,AddN(l[3],r[3]),AddN(l[4],r[4]),"Func",{l,r},l[2]+l[4]-1);
];




10 # FormulaArrayItem(xx_IsList) <--
[
  Local(sub,height);
  sub := {};
  height := 0;
  ForEach(item,xx)
  [
    Local(made);
    made := FormulaBracket(Formula(item));
    If(made[4] > height,Bind(height,made[4]));
    DestructiveAppend(sub,made);
  ];
  MakeOper(0,0,0,height,"List",sub,height>>1);
];



20 # FormulaArrayItem(_item) <-- Formula(item);




2 # Formula(xx_IsList) <--
[
  Local(sub,width,height);
  sub:={};
  width := 0;
  height := 1;

  ForEach(item,xx)
  [
    Local(made);
    made := FormulaArrayItem(item);

    If(made[3] > width,Bind(width,made[3]));
    MoveOper(made,0,height);
    Bind(height,AddN(height,AddN(made[4],1)));
    DestructiveAppend(sub,made);
  ];

  Local(thislength,maxlength);
  maxlength:=0;
  ForEach(item,xx)
  [
    thislength:=0;
    if(IsList(item)) [thislength:=Length(item);];
    if (maxlength<thislength) [maxlength:=thislength;];
  ];

  If(maxlength>0,
  [
    Local(i,j);
    width:=0;
    For(j:=1,j<=maxlength,j++)
    [
      Local(w);
      w := 0;
      For(i:=1,i<=Length(sub),i++)
      [
        if (IsList(xx[i]) And j<=Length(xx[i]))
          If(sub[i][6][j][3] > w,w := sub[i][6][j][3]);
      ];

      For(i:=1,i<=Length(sub),i++)
      [
        if (IsList(xx[i]) And j<=Length(xx[i]))
          MoveOper(sub[i][6][j],width,0);
      ];
      width := width+w+1;
    ];
    For(i:=1,i<=Length(sub),i++)
    [
      sub[i][3] := width;
    ];
  ]
  );

  sub := MakeOper(0,0,width,height,"List",sub,height>>1);
  FormulaBracket(sub);
];





2 # Formula(_xx / _yy) <--
[
  Local(l,r,dash,width);
/*
  Bind(l, BracketOn(Formula(xx),xx,LeftPrecedenceGet("/")));
  Bind(r, BracketOn(Formula(yy),yy,RightPrecedenceGet("/")));
*/
  Bind(l, Formula(xx));
  Bind(r, Formula(yy));
  Bind(width, Maximum(l[3],r[3]));
  Bind(dash, Formula(ToAtom(CharList(width,"-"))));
  MoveOper(dash,0,l[4]);
  MoveOper(l,(SubtractN(width,l[3])>>1),0);
  MoveOper(r,(SubtractN(width,r[3])>>1),AddN(dash[2], dash[4]));
  MakeOper(0,0,width,AddN(r[2], r[4]),"Func",{l,r,dash},dash[2]);
];




Rulebase("BracketOn",{op,f,prec});

Rule("BracketOn",3,1,IsFunction(f) And ArgumentsCount(f) = 2
     And IsInfix(Type(f)) And PrecedenceGet(Type(f)) > prec)
[
 FormulaBracket(op);
];




Rule("BracketOn",3,2,True)
[
  op;
];





10 # Formula(f_IsFunction)_(ArgumentsCount(f) = 2 And IsInfix(Type(f))) <--
[
  Local(l,r,oper,width,height,base);
  Bind(l, Formula(f[1]));
  Bind(r, Formula(f[2]));

  Bind(l, BracketOn(l,f[1],LeftPrecedenceGet(Type(f))));
  Bind(r, BracketOn(r,f[2],RightPrecedenceGet(Type(f))));

  Bind(oper, Formula(f[0]));
  Bind(base, Maximum(l[7],r[7]));
  MoveOper(oper,AddN(l[3],1),SubtractN(base,(oper[7])));
  MoveOper(r,oper[1] + oper[3]+1,SubtractN(base,(r[7])));
  MoveOper(l,0,SubtractN(base,(l[7])));
  Bind(height, Maximum(AddN(l[2], l[4]),AddN(r[2], r[4])));

  MakeOper(0,0,AddN(r[1], r[3]),height,"Func",{l,r,oper},base);
];




11 # Formula(f_IsFunction) <--
[
  Local(head,args,all);
  Bind(head, Formula(f[0]));
  Bind(all, Rest(FunctionToList(f)));

  Bind(args, FormulaBracket(BuildArgs(MapSingle("Formula",Apply("Hold",{all})))));
  AlignBase(head,args);
  MoveOper(args,head[3],0);

  MakeOper(0,0,args[1]+args[3],Maximum(head[4],args[4]),"Func",{head,args},head[7]);
];



Rulebase("RenderFormula",{cf,f,x,y});

/*
/   /  /
\   |  |
    \  |
       \
*/

Rule("RenderFormula",4,1,f[5] = "ToAtom" And f[6] = "(" And f[4] > 1)
[
  Local(height,i);
  Bind(x, AddN(x,f[1]));
  Bind(y, AddN(y,f[2]));
  Bind(height, SubtractN(f[4],1));

  cf[y] := StringMidSet(x, "/", cf[y]);
  cf[AddN(y,height)] := StringMidSet(x, "\\", cf[AddN(y,height)]);
  For (Bind(i,1),IsLessThan(i,height),Bind(i,AddN(i,1)))
    cf[AddN(y,i)] := StringMidSet(x, "|", cf[AddN(y,i)]);
];




Rule("RenderFormula",4,1,f[5] = "ToAtom" And f[6] = ")" And f[4] > 1)
[
  Local(height,i);
  Bind(x, AddN(x,f[1]));
  Bind(y, AddN(y,f[2]));
  Bind(height, SubtractN(f[4],1));
  cf[y] := StringMidSet(x, "\\", cf[y]);
  cf[y+height] := StringMidSet(x, "/", cf[y+height]);
  For (Bind(i,1),IsLessThan(i,height),Bind(i,AddN(i,1)))
    cf[AddN(y,i)] := StringMidSet(x, "|", cf[AddN(y,i)]);
];




Rule("RenderFormula",4,5,f[5] = "ToAtom")
[
  cf[AddN(y, f[2]) ]:=
    StringMidSet(AddN(x,f[1]),f[6],cf[AddN(y, f[2]) ]);
];




Rule("RenderFormula",4,6,True)
[
  ForEach(item,f[6])
  [
    RenderFormula(cf,item,AddN(x, f[1]),AddN(y, f[2]));
  ];
];




LocalSymbols(formulaMaxWidth) [
  SetFormulaMaxWidth(width):=
  [
    formulaMaxWidth := width;
  ];
  FormulaMaxWidth() := formulaMaxWidth;
  SetFormulaMaxWidth(60);
]; // LocalSymbols(formulaMaxWidth)




Function("PrettyForm",{ff})
[
  Local(cf,f);

  f:=Formula(ff);

  cf:=CharField(f[3],f[4]);
  RenderFormula(cf,f,1,1);

  NewLine();
  WriteCharField(cf,FormulaMaxWidth());

  DumpErrors();
  True;
];
/*
HoldArgument("PrettyForm",ff);
*/




EvalFormula(f):=
[
  Local(result);
  result:= ListToFunction({ToAtom("="),f,Eval(f)});
  PrettyForm(result);
  True;
];
HoldArgument("EvalFormula",f);

/*
{x,y,width,height,oper,args,base}
*/

%/mathpiper



%mathpiper_docs,name="PrettyForm",categories="User Functions;Input/Output"
*CMD PrettyForm --- print an expression nicely with ASCII art
*STD
*CALL
	PrettyForm(expr)

*PARMS

{expr} -- an expression

*DESC

{PrettyForm} renders an expression in a nicer way, using ascii art.
This is generally useful when the result of a calculation is more
complex than a simple number.

*E.G.

In> Taylor(x,0,9)Sin(x)
Result: x-x^3/6+x^5/120-x^7/5040+x^9/362880;
In> PrettyForm(%)
	
	     3    5      7       9
	    x    x      x       x
	x - -- + --- - ---- + ------
	    6    120   5040   362880
	
Result: True;

*SEE EvalFormula, PrettyPrinterSet
%/mathpiper_docs



%mathpiper_docs,name="EvalFormula",categories="User Functions;Input/Output"
*CMD EvalFormula --- print an evaluation nicely with ASCII art
*STD
*CALL
	EvalFormula(expr)

*PARMS

{expr} -- an expression

*DESC

Show an evaluation in a nice way, using {PrettyPrinterSet}
to show 'input = output'.

*E.G.

In> EvalFormula(Taylor(x,0,7)Sin(x))
	
	                                      3    5
	                                     x    x  
	Taylor( x , 0 , 5 , Sin( x ) ) = x - -- + ---
	                                     6    120


*SEE PrettyForm
%/mathpiper_docs