

Nl():=
"
";

NewLine() := WriteN(Nl(),1);
NewLine(n):= WriteN(Nl(),n);
Space() := WriteN(" ",1);
Space(n):= WriteN(" ",n);

WriteN(string,n) :=
[
  Local(i);
  For(i:=1,i<=n,i++) WriteString(string);
  True;
];

UniqueConstant() <--
[
  Local(result);
  result := String(LocalSymbols(C)(C));
  Atom(StringMid(2,Length(result)-1,result));
];


1 # IsFreeOf(_expr,{}) <-- True;
2 # IsFreeOf(_expr,var_IsList) <-- MathAnd(IsFreeOf(expr,Head(var)), IsFreeOf(expr,Tail(var)));

4 # IsFreeOf({},_var) <-- True;
5 # IsFreeOf(expr_IsList,_var) <-- MathAnd(IsFreeOf(Head(expr),var), IsFreeOf(Tail(expr),var));

/* Accept any variable. */
10 # IsFreeOf(_expr,_expr) <-- False;

/* Otherwise check all leafs of a function. */
11 # IsFreeOf(expr_IsFunction,_var) <-- IsFreeOf(Tail(Listify(expr)),var);

/* Else it doesn't depend on any variable. */
12 # IsFreeOf(_expr,_var) <-- True;


Function("IsZeroVector",{aList}) aList = ZeroVector(Length(aList));

TemplateFunction("WithValue",{var,val,expr})
[
  If(IsList(var),
     ApplyPure("MacroLocal",var),
     MacroLocal(var)
    ); 
  ApplyPure(":=",{var,val});
  Eval(expr);
];

/*TODO remove
10 # LimitChange((_xex)/(_yex))_
     ((IsZero(WithValue(var,lim,xex)) And
       IsZero(WithValue(var,lim,yex))) Or
      (IsInfinity(WithValue(var,lim,xex)) And
       IsInfinity(WithValue(var,lim,yex)))) <--
    LimitChange(Apply("D",{var,xex})/Apply("D",{var,yex}));
20 # LimitChange(_xex) <--
    [
     WithValue(var,lim,xex);
    ];
UnFence("LimitChange",1);

10 # LimitPredicate((_xex)/(_yex))_
     ((IsZero(WithValue(var,lim,xex)) And
       IsZero(WithValue(var,lim,yex))) Or
      (IsInfinity(WithValue(var,lim,xex)) And
       IsInfinity(WithValue(var,lim,yex)))) <-- True;
20 # LimitPredicate(_x) <-- False;
UnFence("LimitPredicate",1);

(Limit(_var,_lim)(_fie)) <--
    [
     Local(ll);
     ll:= WithValue(var,lim,fie);
     If(IsInfinity(ll),
        [
         ll:=(Substitute(fie,"LimitPredicate","LimitChange"));
         ll:=WithValue(var,lim,ll);
        ]);
     ll;
     ];
UnFence("Limit",3);

*/



Function("CharacteristicEquation",{matrix,var})
   Determinant(matrix-var*Identity(Length(matrix)));
HoldArg("CharacteristicEquation",var);

EigenValues(matrix_IsMatrix) <-- Roots(CharacteristicEquation(matrix,xx));

EigenVectors(_matrix,_eigenvalues) <--
[
  Local(result,n);
/*  eigenvalues:=N(Eval(eigenvalues));  */
  n:=Length(eigenvalues);
  result:={};
  ForEach(e,eigenvalues)
  [
    Local(possible);
/* Echo({"1...",result}); */
    possible:=Solve(matrix*MakeVector(k,n)==e*MakeVector(k,n),MakeVector(k,n))[1];
/* Echo({"2..."}); */
/* Echo({"2..."}); */

    If(Not(IsZeroVector(possible)),
      DestructiveAppend(result,possible)
      );
/* Echo({"3..."}); */
  ];
  result;
];



Function("RationalizeNumber",{x})
[
  Check(IsNumber(x),"Not a number");
  Local(n);
  n:=1;
  While(Not(IsInteger(x)))  [ n:=n*10; x:=x*10; ];
  x/n;
];

Function("Rationalize",{a})
  Substitute(a,{{x},IsNumber(x) And Not(IsInteger(x))},"RationalizeNumber");


10 # ContFrac(_n) <-- ContFrac(n,6);
10 # ContFrac(n_IsInteger,_depth) <-- n+rest;
20 # ContFrac(n_IsNumber,_depth) <-- ContFrac(Rationalize(n),depth);
30 # ContFrac((n_IsInteger) / (m_IsInteger),_depth) <--
     ContFracDo(n,m,depth+1);


40 # ContFrac(n_CanBeUni,_depth)_(Length(VarList(n)) = 1) <--
[
  ContFracDoPoly(n,depth,VarList(n)[1]);
];

5  # ContFracDoPoly(_exp,0,_var) <-- rest;
5  # ContFracDoPoly(0,0,_var) <-- rest;
10 # ContFracDoPoly(_exp,_depth,_var) <--
[
  Local(content,exp2,first,second);
  first:=Coef(exp,var,0);
  exp:=exp-first;
  content:=Content(exp);
  exp2:=DivPoly(1,PrimitivePart(exp),var,5+3*depth)-1;
  second:=Coef(exp2,0);
  exp2 := exp2 - second;
  first+content/((1+second)+ContFracDoPoly(exp2,depth-1,var));
];



/* n/m = 1/ (m/n) = 1/(Div(m,n)+Mod(m,n)/n) */
     
10 # ContFracDo(0,_m,_depth) <-- rest;
15 # ContFracDo(_n,_m,0) <-- rest;
20 # ContFracDo(_n,_m,_depth) <-- 1/(Div(m,n) + ContFracDo(Mod(m,n),n,depth-1));
    
10 # Decimal( n_IsInteger ) <-- {n,{0}};
10 # Decimal( (n_IsPositiveInteger) / (d_IsPositiveInteger) ) <--
[
  Local(result,rev,first,period,repeat,static);
  result:={Div(n,d)};
  Decimal(result,Mod(n,d),d,350);
  rev:=DecimalFindPeriod(result);
  first:=rev[1];
  period:=rev[2];
  repeat:=result[first .. (first+period-1)];
  static:=result[1 .. (first-1)];
  DestructiveAppend(static,repeat);
];
20 # Decimal(_n/_m)_((n/m)<0) <-- "-":Decimal(-n/m);

10 # Decimal(_result , _n , _d,_count ) <--
[
  While(count>0)
  [
    DestructiveAppend(result,Div(10*n,d));
    n:=Mod(10*n,d);
    count--;
  ];
];

DecimalFindPeriod(_list) <--
[
  Local(period,nr,reversed,first,i);
  reversed:=Tail(DestructiveReverse(FlatCopy(Tail(list))));
  nr:=Length(reversed)>>1;
  period:=1;
  first:=reversed[1];

  For(i:=1,i<nr,i++)
  [
    If(reversed[i+1] = first And DecimalMatches(reversed,i),
      [
        period:=i;
        i:=nr;
      ]  
      );
  ];

  first:=Length(list)-period;
  While(first>1 And list[first] = list[first+period]) first--;
  first++;

  {first,period};
];

DecimalMatches(_reversed,_period) <--
[
  Local(nr,matches,first);
  nr:=0;
  matches:=True;
  first:=1;
  While((nr<100) And matches)
  [
    matches := (matches And
       (reversed[first .. (first+period-1)] = reversed[(first+period) .. (first+2*period-1)]));
    first:=first+period;
    nr:=nr+period;
  ];
  matches;
];






LagrangeInt(_var,_list) <--
[
  Local(nr);
  nr:=Length(list);
  Factorize(FillList(var,nr)-list);
];

LagrangeInterpolant(list_IsList,_values,_var) <--
[
  Local(i,nr,sublist);
  nr:=Length(list);
  result:=0;
  For(i:=1,i<=nr,i++)
  [
    sublist:=FlatCopy(list);
    DestructiveDelete(sublist,i);
    result:=result + values[i]*LagrangeInt(var,sublist)/LagrangeInt(list[i],sublist);
  ];
  result;
];


/* Lagrangian power series reversion. Copied
   from Knuth seminumerical algorithms */

ReversePoly(_f,_g,_var,_newvar,_degree) <--
[
  Local(orig,origg,V,W,U,n,initval,firstder,k,newsum);
  orig:=MakeUni(f,var);
  origg:=MakeUni(g,var);
  initval:=Coef(orig,0);
  firstder:=Coef(orig,1);
  V:=Coef(orig,1 .. Degree(orig));
  V:=Concat(V,FillList(0,degree));
  G:=Coef(origg,1 .. Degree(origg));
  G:=Concat(G,FillList(0,degree));
  W:=FillList(0,Length(V)+2);
  W[1]:=G[1]/firstder;
  U:=FillList(0,Length(V)+2);
  U[1]:=1/firstder;
  n:=1;
  While(n<degree-1)
  [
    n++;
    For(k:=0,k<n-1,k++)
    [
      newsum:=U[k+1];
      For(j:=2,j<=k+1,j++)
      [
        newsum:=newsum-U[k+2-j]*V[j];
      ];
      U[k+1]:=newsum/firstder;
    ];
    newsum:=0;
    For(k:=2,k<=n,k++)
    [
      newsum:=newsum - k*U[n+1-k]*V[k];
    ];
    U[n]:=newsum/firstder;
    newsum:=0;
    For(k:=1,k<=n,k++)
    [
      newsum:=newsum + k*U[n+1-k]*G[k]/n;
    ];
    W[n]:=newsum;
  ];
  DestructiveInsert(W,1,Coef(origg,0));
  Subst(newvar,newvar-initval) 
    NormalForm(UniVariate(newvar,0,W));
];



/* InverseTaylor : given a function y=f(x), determine the Taylor series
 * expansion of the inverse f^-1(y)=x this function around y0=f(x0).
 *
 */
Function("InverseTaylor",{var,val,degree,func})
[
  Local(l1);
  l1:=UniTaylor(func,var,val,degree);
  ReversePoly(l1,var,var,var,degree);
];



/*
TRun(_f,_g,_degree)<--
[
  Local(l2,l3,l4);
  l2:=ReversePoly(f,g,t,z,degree);
  l3:=Subst(z,f)l2;
  l4:=BigOh(l3,t,degree);
  Echo({g," == ",l4});
  NewLine();
];

TRun(t+t^2,t,10);
TRun(t/2-t^2,t,10);
TRun(t/2-t^2,3+t+t^2/2,10);
TRun(2+t/2-t^2,t,10);
*/

/*
TRun(_f,_degree)<--
[
  Local(l2,l3,l4);
  l2:=InverseTaylor(t,0,degree)f;
  l3:=Subst(t,Taylor(t,0,degree)f)l2;
  l4:=BigOh(l3,t,degree);

  Echo({t," == ",Simplify(l4)});
  NewLine();
];
TRun(Sin(a*t),3);
TRun(a^t,3);
TRun(a^t,3);
TRun(t+t^2,10);
TRun(t/2-t^2,10);
TRun(t/2-t^2,10);
TRun(2+t/2-t^2,10);
*/


