<<<>>>
2 + 3 * 4;
<<<>>>
333/450 + 234/900;
<<<>>>
PRETTY_PRINT := FALSE:  (a+b)/(c+d);
<<<>>>
PRETTY_PRINT := TRUE:  (a+b)/(c+d);
<<<>>>
333 + 42566; 476-88384; 45*678; 45/678; 2^66; sign(-5);
abs(-5); max(4, 5, 6); min(-2, 6, 78); fact(43); round(3.5);
ceil(4.3); floor(4.3); trunc(8/3); frac(8/3); float(8/3);
<<<>>>
333 + 42566: 476-88384: 45*678: 2^66: sign(-5): abs(-5):
max(4, 5, 6): min(-2, 6, 78): fact(43): ceil(4.3): floor(4.3):
round(3.5): trunc(8/3): frac(8/3): float(8/3):
<<<>>>
%; %2; last(4);
<<<>>>
reset(): round(3.4): fact(3): 2*3: 4 + 8: history();
<<<>>>
max(1, 2, a);
<<<>>>
a := 14;
<<<>>>
max(1, 2, a);
<<<>>>
float(1/3);
<<<>>>
DIGITS := 50;
<<<>>>
float(1/3);
<<<>>>
DIGITS:=10:
<<<>>>
frac(8/3) + trunc(8/3);
<<<>>>
time(fact(10000));
<<<>>>
fact(500);
<<<>>>
9 div 7;
<<<>>>
9 mod 7;
<<<>>>
ifactor(355355538452);
<<<>>>
igcd(345, 867);
<<<>>>
igcdex(345, 867);
<<<>>>
ilcm(34, 6);
<<<>>>
ithprime(56);
<<<>>>
nextprime(6778);
<<<>>>
isprime(3447);
<<<>>>
phi(51);
<<<>>>
ifactor(355355538452);
<<<>>>
1*2^2*59^1*9587^1*157061^1;
<<<>>>
igcdex(345, 867);
<<<>>>
igcd(345, 867);
<<<>>>
345*(-98) + 867*(39);
<<<>>>
ithprime(n) $ n=1..100;
<<<>>>
sqrt(5);
<<<>>>
5^(1/3);
<<<>>>
float(sqrt(5)); float(5^(1/3));
<<<>>>
sqrt(5.0); 5.0^(1/3); 5^(1/3);
<<<>>>
ln(2.0);
<<<>>>
exp(5);
<<<>>>
sin(3.0);
<<<>>>
cos(PI);
<<<>>>
tan(5.1);
<<<>>>
sinh(E);
<<<>>>
tanh(3.1);
<<<>>>
acos(5.0);
<<<>>>
atanh(3.1);
<<<>>>
float(PI);
<<<>>>
float(E);
<<<>>>
float(I^2);
<<<>>>
cos(PI) := -1;
<<<>>>
3*cos(PI);
<<<>>>
reset():
<<<>>>
a + b;
<<<>>>
domtype(a); domtype(b);
<<<>>>
domtype(a + b);
<<<>>>
y := 2 * z + 1;
<<<>>>
x := y^2 - y;
<<<>>>
a := b^2 * x + c * y;
<<<>>>
b := 2: c := 2: a;
<<<>>>
expand(a);
<<<>>>
a := 3: a^2;
<<<>>>
a := A: a^2;
<<<>>>
a := 1234: a;
<<<>>>
a := NIL: a;
<<<>>>
reset():
<<<>>>
Q:=poly(x^2+3*x*y, [x,y]); P:=poly(x*y^2+3*x*y+3*y, [x,y]);
<<<>>>
expr(P);
<<<>>>
P+Q;
<<<>>>
P*Q;
<<<>>>
P^2;
<<<>>>
diff(Q,x);
<<<>>>
P+1;
<<<>>>
P+poly(1,[x,y]);
<<<>>>
domtype(P+1);
<<<>>>
domtype(P+poly(1,[x,y]));
<<<>>>
op(P);
<<<>>>
q:=poly(x^2+12*x*y,[x,y],IntMod(5));
p:=poly(x*y^2+13*x*y+3*y,[x,y],IntMod(5));
<<<>>>
p+p+p+p+p;
<<<>>>
i^2 $ i=1..10;
<<<>>>
random() $ i=1..7;
<<<>>>
print("I am not supposed to contradict my teacher") $ i=1..6;
<<<>>>
a := 1: (a := a*(i + 1)) $ i=1..125: a;
<<<>>>
a := 1: for i from 1 to 125 do a := a*(i + 1) end_for: a;
<<<>>>
time(fact(701));
<<<>>>
i := 2: i^2 $ i=1..5;
<<<>>>
i := 2: i^2 $ hold(i)=1..5;
<<<>>>
domtype(2.3);
<<<>>>
domtype(3/2);
<<<>>>
domtype(7);
<<<>>>
3/2 + 4.2*I;
<<<>>>
domtype(%);
<<<>>>
d+4;
<<<>>>
domtype(%);
<<<>>>
4+"f";
<<<>>>
domtype("f");
<<<>>>
reset():
<<<>>>
L := [a, b];
<<<>>>
domtype(%);
<<<>>>
L := [e, b]: e := (c, d);
<<<>>>
L;
<<<>>>
[a, g].[f, k];
<<<>>>
append([a, b], c);
<<<>>>
{a, b, c};
<<<>>>
domtype(%);
<<<>>>
A := array(1..2, 1..2, (1,2)=123);
<<<>>>
domtype(%);
<<<>>>
{1, 2, 3, 2};
<<<>>>
bool({C, B}={B, C});
<<<>>>
{A, "string", {j, K}};
<<<>>>
reset();
<<<>>>
M1 := {a, b, c, d}: M2 := {A, B, c, d}:
<<<>>>
M1 union M2;
<<<>>>
M1 minus M2;
<<<>>>
((1, 2), g);
<<<>>>
a := (1, 2): M := {a, b}: M;
<<<>>>
A := [1, 4, 55664]:
<<<>>>
B := array(1..2, 1..3, 1..5, (1,2,4)=423, (2,1,1)=TTT):
<<<>>>
a := (1, 2, 3):
<<<>>>
A[3];
<<<>>>
B[1, 2, 4];
<<<>>>
a[2];
<<<>>>
M := {1, 2}:  M[1];
<<<>>>
B[1, 2, 3];
<<<>>>
domtype(%);
<<<>>>
a := NIL:
<<<>>>
L := [a, b, c]: L[4];
<<<>>>
T[1] := value: T;
<<<>>>
T[MUPAD] := fun: T;
<<<>>>
T[MUPAD];
<<<>>>
Tab[s] := a: s := 34: Tab[34]; Tab[s];
<<<>>>
Tab;
<<<>>>
Tab[hold(s)];
<<<>>>
domtype(print());
<<<>>>
domtype(null());
<<<>>>
domtype(a*b); domtype(a+b);
<<<>>>
type(a*b);
<<<>>>
type(a+b);
<<<>>>
type(a^b);
<<<>>>
Z7 := domain():
<<<>>>
Z7::name := "Z7":
<<<>>>
Z7::new := proc(x)
           begin
              new(Z7, x mod 7);
           end_proc:
<<<>>>
newel:= Z7::new(12);
<<<>>>
Z7::print := proc(x)
                local expr;
                begin
                  expr := subs(hold(Z7(q)), hold(q)=extop(x,1));
                  print(expr);
                end_proc:
<<<>>>
newel;
<<<>>>
domel := Z7::new(2);
<<<>>>
extop(domel,0);extop(domel,1);
<<<>>>
Z7::_plus := proc()
             local x, i;
             begin
                x := extop(args(1), 1);
                for i from 2 to args(0) do
                   x := (x + extop(args(i), 1)) mod 7;
                end_for;
                Z7::new(x);
             end_proc:

Z7::_mult := proc()
             local x, i;
             begin
                x := extop(args(1), 1);
                for i from 2 to args(0) do
                   x := (x * extop(args(i), 1)) mod 7;
                end_for;
                Z7::new(x);
             end_proc:
<<<>>>
Z7::type := proc(x)
            begin
               "Z7"
            end_proc:

Z7::testtype := proc(x,y)
                begin
                   bool(extop(x,0) = y);
                end_proc:

Z7::domtype := proc(x)
               begin
                 Z7
               end_proc:
<<<>>>
a2 := Z7::new(2); a3 := Z7::new(3);
a4 := Z7::new(4); a5 := Z7::new(5);
<<<>>>
a2 + a4; a2 + a3 + a4 + a5;
<<<>>>
a4 * a5; a2 * a3 * a4 * a5;
<<<>>>
Z7::zero := Z7::new(0):
Z7::one := Z7::new(1):
<<<>>>
Z7::divide := proc(x,y)
              begin
                 Z7::new((extop(x,1) / extop(x,2)) mod 7);
              end_proc:

Z7::negate := proc(x)
              begin
                 Z7::new( - extop(x,1) mod 7)
              end_proc:

Z7::invert := proc(x)
              begin
                Z7::new((1/extop(x,1)) mod 7)
              end_proc:

Z7::_power := proc(x,y)
              local help, i;
              begin
                 if y=0 then return (Z7::one) end_if;
                 if y>0 then
                    help := x;
                 else
                    help := Z7::invert(x);
                    x := help;
                 end_if;
                 for i from 2 to abs(y) do
                    help := Z7::_mult(help, x);
                 end_for;
              end_proc:
<<<>>>
a2^2 + a3^3 - a4;
<<<>>>
Z7::print := proc(x)
             local expr;
             begin
                extop(x,1)
             end_proc:
<<<>>>
a := Z7::new(34);
b := Z7::new(411);
<<<>>>
a+b;
<<<>>>
reset():
<<<>>>
op(a * b + b * e* d^2 , [2, 3]);
<<<>>>
op(op(a * b + b * e * d^2, [2]), [3]);
<<<>>>
op(a*b+y, [2]);
<<<>>>
a*b+y;
<<<>>>
op(a * b + b * d^2 * e, [0]);
<<<>>>
op(sin(a*b), 0);
<<<>>>
op(a * b + b * d^2 * e, [1, 0]);
<<<>>>
op(a * b + b * d^2 * e, [2, 0]);
<<<>>>
Matrix := array(1..2, 1..3, 1..7, (2,3,3) = 9):
<<<>>>
op(Matrix, 0);
<<<>>>
op(a * b + b * d^2 * e, [2]);
<<<>>>
op(a * b + b * d^2 * e, 2);
<<<>>>
op([a, b], 0);
<<<>>>
nops(a * b + b * d^2 * e);
<<<>>>
nops(op(a * b + b * d^2 * e, 2));
<<<>>>
op(a*b*c*d*e);
<<<>>>
a1 + a2 + a3 + a4 + a5 + a6 + a7 + a8 + a9;
<<<>>>
_mult(op(%));
<<<>>>
nops_own(a * b + b * d^2 * e);
<<<>>>
nops(a * b + b * d^2 * e);
<<<>>>
nops_own(a);
<<<>>>
nops(a);
<<<>>>
ausdr := A^G*(A+h);
<<<>>>
subs(ausdr, A^G = 123);
<<<>>>
ausdr;
<<<>>>
subs(ausdr, A = 123, G = NN);
<<<>>>
subs(ausdr, A=G, G=A);
<<<>>>
subs (ausdr, [A=G, G=A]);
<<<>>>
subsop(ausdr, [2,1]=a);
<<<>>>
subsop(ausdr, [1,1]=a, [2,1]=aa);
<<<>>>
A := a^b; subsop(A, [1]=c^d, [1,2]=123);
<<<>>>
A:=NIL: B:=NIL: ausdr := A^G*(A+h):
<<<>>>
subsop(ausdr, [2,1]=(B+C));
<<<>>>
subsop(ausdr, [2,1]=(B+C), [2,2]=g);
<<<>>>
subsex(a*b*c, a*b=46);
<<<>>>
subs(a*b*c, a*b=46);
<<<>>>
EVAL_STMT := FALSE:
<<<>>>
op((A := b*c), 0..nops((A := b*c)));
<<<>>>
 EVAL_STMT := TRUE:
<<<>>>
LEVEL;
<<<>>>
MAXLEVEL;
<<<>>>
B := C: C := B:
<<<>>>
B;
<<<>>>
(b.i := b.(i+1)) $ i=1..100:
<<<>>>
b1;
<<<>>>
LEVEL := 99: MAXLEVEL := 100: B := C: C := B:
<<<>>>
B;
<<<>>>
a := b: b := a:
<<<>>>
level(a, 3);
<<<>>>
level(a, 4);
<<<>>>
level(a, MAXLEVEL);
<<<>>>
reset();
<<<>>>
a := b: b := 1:
<<<>>>
val(a+b+2);
<<<>>>
level(a+b+2, 1);
<<<>>>
sqrt(4);
<<<>>>
hold(sqrt(4));
<<<>>>
hold(1+2);
<<<>>>
hold(1+2);
<<<>>>
level(%);
<<<>>>
reset():
<<<>>>
a := b: b := c: c := d;
<<<>>>
hold(a);
<<<>>>
eval(%);
<<<>>>
reset();
<<<>>>
f(x,y)=x*y;
<<<>>>
type(%);
<<<>>>
FUNC(f(x,y)=x*y):
<<<>>>
f(2, 3); f(91233, 778);
<<<>>>
f;
<<<>>>
h := proc(x, y)
       begin
         x*y
       end_proc:
<<<>>>
h(456, 776);
<<<>>>
op(f);
<<<>>>
quad := proc(x, y)
          begin
            x*y;
            %^2
          end_proc:
<<<>>>
quad(2, 3);
<<<>>>
op(quad);
<<<>>>
op(quad, [4, 1]);
<<<>>>
op(quad, [4, 2]);
<<<>>>
x := 15: FUNC(g(x)=x^10):
<<<>>>
g(2);
<<<>>>
quad_mod := proc(x, y)
              begin
                A := x*y;
                A^2
              end_proc:
<<<>>>
quad_mod(2, 3);
<<<>>>
A;
<<<>>>
quad_better := proc(x, y)
                 local b, c;
                 begin
                   b := x*y;
                   b^2
                 end_proc:
<<<>>>
quad_better(2, 3);
<<<>>>
b; c;
<<<>>>
op(quad_better, 2);
<<<>>>
a := 15:
<<<>>>
test := proc(e)
          local a;
          begin
            a := 2323243545; a*e
          end_proc:
<<<>>>
test(s); a;
<<<>>>
illustrate_en_var :=  proc(x)
                        local DIGITS;
                        begin
                          print(float(x));
                          DIGITS := 50;
                          print(float(x))
                        end_proc:
<<<>>>
illustrate_en_var(1/3);
<<<>>>
DIGITS;
<<<>>>
float(1/3);
<<<>>>
a := 0:
<<<>>>
illustrate_hold := proc (b) option hold;
                     begin
                       b
                     end_proc:
<<<>>>
illustrate_hold(a);
<<<>>>
a := 0: no_hold := proc (b) begin  b end_proc:
<<<>>>
no_hold(a);
<<<>>>
illustrate_hold(a); eval(%);
<<<>>>
sin_quad := proc(x)
                option remember;
              begin
                float(sin(x)^2)
              end_proc:
<<<>>>
sin_quad(3); sin_quad(PI); sin_quad(1.1);
<<<>>>
op(sin_quad, 5);
<<<>>>
Proc_with_side_effect := proc(i)
                             option remember;
                           begin
                             A*i
                           end_proc:
<<<>>>
A := 15: Proc_with_side_effect(5);
<<<>>>
A := 25: Proc_with_side_effect(5);
<<<>>>
sin_quad(PI) := "wrong result": sin_quad(PI);
<<<>>>
reset():
<<<>>>
ff(1) := 23234;
<<<>>>
ff;
<<<>>>
op(ff, 5);
<<<>>>
ff(z);
<<<>>>
ff(1);
<<<>>>
f := _procdef((x, y), (a, b), hold, x^y, NIL, f);
<<<>>>
f := proc(x)
       begin
         sin(x)
       end_proc:
<<<>>>
fdiff := proc(x) local y;
           begin
             subs(diff(f(y), y), [y = x])
           end_proc:
<<<>>>
fdiff(x);
<<<>>>
fdiff(1.5);
<<<>>>
eval_1level := proc()
                 begin
                   a := b;
                   b := c;
                   c := d;
                   a
                 end_proc:
<<<>>>
eval_1level();
<<<>>>
a := b:   b := c:   c := d:  a;
<<<>>>
eval_all_level := proc()
                    begin
                      a := b;
                      b := c;
                      c := d;
                      level(a)
                    end_proc:
<<<>>>
eval_all_level();
<<<>>>
a := 2: if a>4 then a else 4 end_if;
<<<>>>
a := 34: if a>4 then a else 4 end_if;
<<<>>>
a := (beginning):
<<<>>>
for i from 12 to 32 step 2 do a := (a, i) end_for;
<<<>>>
a := -3: while a<6 do a := a + 1 end_while;
<<<>>>
a := -3: repeat a := a + 1 until a>6 end_repeat;
<<<>>>
a := 11:
<<<>>>
if a < 4 then a elif a < 3 then "hallo" else 4 end_if;
<<<>>>
for i in A*B*C do print(i^2) end_for;
<<<>>>
i := NIL: a := (beginning):
<<<>>>
for i from 32 downto 12 step 2 do a := (a, i) end_for;
<<<>>>
for i from 1 to 30 do i; break end_for;
<<<>>>
a := 2:
<<<>>>
while a < 30 do a := a+1; break end_while;
<<<>>>
a := 2:
<<<>>>
while a<7 do
     a := a+1;
     if a<5 then
       next
     end_if;
     print(a)
  end_while;
<<<>>>
illustrate_break := proc(x)
                    begin
                      print(x);
                      break;
                      "hallo"
                    end_proc:
<<<>>>
illustrate_break(x);
<<<>>>
illustrate_case := proc(a)
                   begin
                     case a
                       of 1 do print(1)
                       of 2 do print(2)
                       of 3 do print(3)
                       otherwise print("no case")
                     end_case
                   end_proc:
<<<>>>
illustrate_case(5);
<<<>>>
illustrate_case(1);
<<<>>>
illustrate_case := proc(a)
                   begin
                     case a
                       of 1 do print(1); break
                       of 2 do print(2); break
                       of 3 do print(3); break
                       otherwise print("no case")
                     end_case
                   end_proc:
<<<>>>
illustrate_case(1);
<<<>>>
probe :=  proc (a)
          begin
            case a
              of 1 do print( 1 ); break
              of 2 do print( 2 ); next
              of 3 do print( 3 )
              of 2 do print( 2 ); break
              of 4 do print( 4 )
            end_case
          end_proc:
<<<>>>
probe(1);
<<<>>>
probe(2);
<<<>>>
probe(3);
<<<>>>
probe(4);
<<<>>>
probe(5);
<<<>>>
case_proc := proc (a)
                begin
                   case a
                     of 0 do 0; break
                     of 1 do 1; break
                     of 2 do 2; break
                     of 3 do 3; break
                   end_case
                end_proc:
<<<>>>
if_proc := proc ( a )
              begin
                if a = 0 then
                   0
                elif a = 1 then
                   1
                elif a = 2 then
                   2
                elif a = 3 then
                   3
                end_if
              end_proc:
<<<>>>
input("Please, insert value for A", A);
<<<>>>
A;
<<<>>>
textinput("Please insert string as value for B", B):
<<<>>>
B;
<<<>>>
A := 124: B := "hallo":
<<<>>>
write(Text, "filename", A, B);
<<<>>>
A := 0;
<<<>>>
read("filename"): A;
<<<>>>
readtext := proc(fname)
              local fid, text, line;
              begin
                if args(0) <> 1 then
                  error("wrong no of args")
                end_if;
                if domtype(fname) <> DOM_STRING then
                  error("no filename")
                end_if;
                fid:= fopen(fname);
                text:= ftextinput(fid);
                if text = null() then return("")
                end_if;
                while (line:= ftextinput(fid)) <> null() do
                  text:= text . "\n" . line
                end_while;
                text
              end_proc:
<<<>>>
readtext("filename");
<<<>>>
protocol("newfile"):
<<<>>>
"now do something with MuPAD";
<<<>>>
2*8*9927726265;
<<<>>>
protocol():
<<<>>>
readtext("newfile");
<<<>>>
print(Unquoted,%);
<<<>>>
A := "This is a short text";
<<<>>>
write(Text, "newfile", A);
<<<>>>
B := readtext("newfile"):
<<<>>>
B; print(Unquoted, B);
<<<>>>
text2tbl(B, [" "]);
<<<>>>
text2tbl(B, [" ", "s"]);
<<<>>>
text2tbl(B, [" ", "r"], Cyclic);
<<<>>>
text2expr("AA := x+y");
<<<>>>
AA;
<<<>>>
eval(text2expr("AA := x+y"));
<<<>>>
AA;
<<<>>>
plot2d(Axes = Origin, [Mode = Curve,
    [u, sin(u)], u = [-PI, PI],
    Grid = [40], Color = [Flat]
    ]);
<<<>>>
plot2d(Axes = Corner, [Mode = Curve,
    [u*cos(u), u*sin(u)], u = [0, 2*PI],
    Grid = [40], Color = [Height]
    ]);

<<<>>>
plot2d(Axes = None,
    [Mode = Curve,
    [sin(u)*sin(2*u)*sin(3*u),
     0.5*sin(4*u)*sin(5*u)*sin(6*u)],
    u = [0, 2*PI], Grid = [50], Smoothness = [5],
    Style = [LinesPoints],
    Color = [Height, [1, 0, 0], [0, 0.6, 1]]
    ]);
<<<>>>
pascal_x := proc(a, l, u)
    begin
      a*cos(u)^2 + l*cos(u):
    end_proc:

pascal_y := proc(a, l, u)
    begin
      a*cos(u)*sin(u) + l*cos(u):
    end_proc:
epiz_x := proc(a, b, u)
    begin
      (a+b)*cos(u) - a*cos((a+b)*u/a):
    end_proc:

epiz_y := proc(a, b, u)
    begin
      (a+b)*sin(u) + a*sin((a+b)*u/a):
    end_proc:
<<<>>>
plot2d(Axes = Corner, Ticks = 0,
    [Mode = Curve,
         [hold(pascal_x(1, 1, u)),
          hold(pascal_y(1, 1, u))],
         u = [0, 2*PI], Grid = [50],
         Smoothness = [1],
         Style = [Points], Color = [Flat]],
    [Mode = Curve,
         [hold(pascal_x(1.5, 1, u)),
          hold(pascal_y(1.5, 1, u))],
         u = [0, 2*PI], Grid = [50],
         Smoothness = [1],
         Style = [Lines], Color = [Flat]],
    [Mode = Curve,
         [hold(pascal_x(2, 1, u)),
          hold(pascal_y(2, 1, u))],
         u = [0, 2*PI], Grid = [50],
         Smoothness = [1],
         Style = [LinesPoints], Color = [Flat]
    ]);
<<<>>>
plot2d([Mode = Curve,
         [hold(epiz_x(0.2, 3, u)),
          hold(epiz_y(0.2, 3, u))],
         u = [0, 2*PI], Grid = [50], Smoothness = [5],
         Color = [Flat, [1, 0, 0]]],
    [Mode = Curve,
         [hold(epiz_x(0.6, 3, u)),
          hold(epiz_y(0.6, 3, u))],
         u = [0, 2*PI], Grid = [50], Smoothness = [5],
         Color = [Flat, [0, 1, 0]]],
    [Mode = Curve,
         [hold(epiz_x(1.0, 3, u)),
          hold(epiz_y(1.0, 3, u))],
         u = [0, 2*PI], Grid = [50], Smoothness = [5],
         Color = [Flat, [1, 1, 0]]
    ]);
<<<>>>
plot2d(Axes = Corner, Ticks = 0,
    [Mode = Curve,
         [u, 3*exp(-u/3)*sin(3*u)],
         u = [0, 2*PI], Grid = [50],
         Smoothness = [1], Color = [Height,
         [0, 0.4, 1], [1, 0, 1]]],
    [Mode = Curve,
         [u, 3*exp(-u/3)],
         u = [0, 2*PI], Grid = [50],
         Color = [Flat, [1, 0, 1]]],
    [Mode = Curve,
         [u, -3*exp(-u/3)],
         u = [0, 2*PI], Grid = [50],
         Color = [Flat, [0, 0.4, 1]]
    ]);
<<<>>>
kdv := proc(u, v, c)
    begin
       e    := exp(c*u -c^3*v):
       f    := 1 + e;
       fx   := c*e;
       fxx  := c*fx;
       3*(fxx/f - (fx/f)^2);
    end_proc:

    plot3d(Axes = Box, Ticks = 0,
           [Mode = Surface,
                 [u, v, hold(20*kdv(u, v, 3/5))],
                 u = [-10, 10], v = [-10, 10],
                 Grid = [40, 30], Style = [HiddenLine, VLine],
                 Color = [Height]
           ]);
<<<>>>
kdv := proc(u, v, c1, c2)
    begin
      e1   := exp(c1*u - c1^3*v);
      e2   := exp(c2*u - c2^3*v);
      c12  := ((c1 - c2)/(c1 + c2))^2;
      e12  := c12*e1*e2;
      f    := 1    +    e1 +      e2 +           e12;
      fx   :=        c1*e1 +   c2*e2 +   (c1+c2)*e12;
      fxx  :=      c1^2*e1 + c2^2*e2 + (c1+c2)^2*e12;
      3*(fxx/f - (fx/f)^2):
    end_proc:

plot3d(Axes = Box, Ticks = 0,
    [Mode = Surface,
         [u, v, hold(30*kdv(u, 2*v, 3/5, 2/5))],
         u = [-30, 30], v = [-25, 25],
         Grid = [40, 40], Smoothness = [1, 0],
         Style = [HiddenLine, VLine], Color = [Height,
         [0.2, 0.2, 1], [0.8, 0.8, 1]]
    ]);
<<<>>>
epiz_x := proc(a, b, u)
    begin
      (a+b)*cos(u) - a*cos((a+b)*u/a):
    end_proc:

epiz_y := proc(a, b, u)
    begin
      (a+b)*sin(u) + a*sin((a+b)*u/a):
    end_proc:

    plot3d(Axes = Box, Ticks = 0,
           [Mode = Surface,
                 [sin(v)*hold(epiz_x(1, 3, u)),
                  sin(v)*hold(epiz_y(1, 3, u)),
                  2*v],
                 u = [0, 2*PI], v = [0, PI], Grid = [50, 20],
                 Smoothness = [1, 1],
                 Style = [HiddenLine, Mesh], Color = [Height]
          ]);
<<<>>>
epiz_x := proc(a, b, u)
    begin
      (a+b)*cos(u) - a*cos((a+b)*u/a):
    end_proc:

    epiz_y := proc(a, b, u)
    begin
      (a+b)*sin(u) + a*sin((a+b)*u/a):
    end_proc:

    plot3d(Axes = Box, Ticks = 0,
         [Mode = Surface,
              [v/3*hold(epiz_x(1, 3, u)),
               v/3*hold(epiz_y(1, 3, u)),
               v],
              u = [0, 2*PI], v = [-3, 3], Grid = [50, 20],
              Style = [HiddenLine, Mesh], Color = [Height]
         ]);
<<<>>>
sphere_x := proc(u, v)
    begin
       sin(u)*cos(v):
    end_proc:

    sphere_y := proc(u, v)
    begin
      sin(u)*sin(v):
    end_proc:

    sphere_z := proc(u, v)
    begin
      cos(u):
    end_proc:

    plot3d(Axes = Box, Ticks = 0,
    Title = "Different Mesh Styles",
           [Mode = Surface,
                 [3*hold(sphere_x(u, v)), 3*hold(sphere_y(u, v)),
                  3*hold(sphere_z(u, v))],
                 u = [PI/2, PI], v = [-PI, PI],
                 Grid = [20, 30], Style = [HiddenLine, Mesh],
                 Color = [Height]],
           [Mode = Surface,
                 [2*hold(sphere_x(u, v)), 2*hold(sphere_y(u, v)),
                  2*hold(sphere_z(u, v))],
                 u = [0, PI], v = [0, PI],
                 Grid = [20, 20], Style = [HiddenLine, VLine],
                 Color = [Flat]],
           [Mode = Surface,
                 [hold(sphere_x(u, v)), hold(sphere_y(u, v)),
                  hold(sphere_z(u, v))],
                 u = [0, PI], v = [-PI, PI],
                 Grid = [20, 20], Style = [HiddenLine, ULine],
                 Color = [Flat]
           ]);
<<<>>>
plot3d(Axes = Box, Ticks = 0,
           [Mode = Curve,
                 [u, u, sin(u)],
                 u = [-3.0, 3.0], Grid = [50],
                 Smoothness = [2], Style = [Impulses],
                 Color = [Height, [0, 1, 0],
                 [1, 1, 0]]
           ]);
<<<>>>
plot3d(Axes = Box, Ticks = 0,
           Title = "Different Curve Styles",
           [Mode = Curve,
                 [u, -PI, sin(u)], u = [-PI, PI],
                 Grid = [50], Style = [Points],
                 Color = [Flat, [1, 0, 0]]],
           [Mode = Curve,
                 [u, -PI/3, sin(u)], u = [-PI, PI],
                 Grid = [50], Style = [Lines],
                 Color = [Flat, [1, 1, 0]]],
           [Mode = Curve,
                 [u, PI/3, sin(u)], u = [-PI, PI],
                 Grid = [50], Style = [LinesPoints],
                 Color = [Flat, [0, 1, 0]]],
           [Mode = Curve,
                 [u, PI, sin(u)], u = [-PI, PI],
                 Grid = [50], Style = [Impulses],
                 Color = [Flat, [0, 0, 1]]
           ]);
<<<>>>
plot3d(Axes = Corner, Ticks = 0,
           [Mode = Surface,
                 [u, v, 0.5*sin(u^2 + v^2)],
                 u = [0, PI], v = [0, PI],
                 Grid = [30, 30], Color = [Height,
                 [0.2, 0.2, 0.2], [0.9, 0.9, 0.9]]
           ]);

<<<>>>
plot3d(Axes = None, Scaling = UnConstrained,
          [Mode = Surface,
                [u*cos(v)*sin(u), u*cos(u)*cos(v), -u*sin(v)],
                u = [0, 3*PI], v = [0, PI],
                Grid = [20, 20], Smoothness = [2, 0],
                Style = [HiddenLine, Mesh], Color = [Height]
          ]);
<<<>>>
plot3d(Axes = None,
           [Mode = Surface,
                 [(1.2)^v*sin(u)^2*cos(v),
                  (1.2)^v*sin(u)*cos(u),
                  (1.2)^v*sin(u)^2*sin(v)],
                 u = [0, PI], v = [-1, 2*PI],
                 Grid = [30, 30],
                 Style = [HiddenLine, Mesh],
                 Color = [Height, [0.4, 0, 0], [1, 0, 0]]
           ]);
<<<>>>
plot3d([Mode = Surface,
                 [u, v, sin(u*v)],
                 u = [-PI, PI], v = [-PI, PI],
                 Grid = [35, 35],
                 Style = [HiddenLine, Mesh],
                 Color = [Height]
           ]);
<<<>>>
x := proc(u, v)
    begin v*sin(u): end_proc:

   y := proc(u, v)
   begin v*cos(u): end_proc:

   z := proc(u, v)
   begin 1.5*sin(v): end_proc:

   plot3d(Scaling = UnConstrained,
          [Mode = Surface,
                [hold(x(u, v)), hold(y(u, v)), hold(z(u, v))],
                u = [0, 2*PI], v = [0, 3*PI], Grid = [40, 40],
                Color = [Flat]
          ]);
<<<>>>
plot3d(Axes = Box, Ticks = 0,
           CameraPoint = [-3.6, -4.9, 2.6],
           [Mode = Surface,
                 [u, v, u^2], u = [-1, 1], v = [-1, -0.5],
                 Grid = [30, 2], Style = [HiddenLine, Mesh],
                 Color = [Flat, [0, 0, 1]]
            ],
            [Mode = Surface,
                 [u, v, u^3], u = [-1, 1], v = [-0.5, 0],
                 Grid = [30, 2], Style = [HiddenLine, Mesh],
                 Color = [Flat, [0, 1, 0]]
            ],
            [Mode = Surface,
                 [u, v, u^4], u = [-1, 1], v = [0, 0.5],
                 Grid = [30, 2], Style = [HiddenLine, Mesh],
                 Color = [Flat, [1, 1, 0]]
            ],
            [Mode = Surface,
                 [u, v, u^5], u = [-1, 1], v = [0.5, 1],
                 Grid = [30, 2], Style = [HiddenLine, Mesh],
                 Color = [Flat, [1, 0, 0]]
            ]);
<<<>>>
imaginary := proc(c)
    begin
      if domtype(c) =  DOM_COMPLEX
      then
        op(c, 2):
      else
        0:
      end_if:
    end_proc:

    plot3d(Axes = None, Scaling = UnConstrained,
           [Mode = Surface,
                 [u, v, hold(imaginary(asin(u+v*I)))],
                 u = [-4, 4], v = [-4, 4],
                 Grid = [30, 30],
                 Style = [HiddenLine, Mesh],
                 Color = [Height]
           ]);
<<<>>>
real := proc(c)
    begin
      if domtype(c) = DOM_COMPLEX
      then
        op(c, 1):
      else
        0:
      end_if:
    end_proc:

    plot3d(Axes = None, Scaling = UnConstrained,
           [Mode = Surface,
                 [u, v, hold(real(asin(u+v*I)))],
                 u = [-4, 4], v = [-4, 4],
                 Grid = [30, 30],
                 Style = [HiddenLine, Mesh],
                 Color = [Height]
           ]);
<<<>>>
plot3d(Axes = Box, Ticks = 0,
           [Mode = Surface,
                 [(3*u+3*u*v^2-u^3),
                  (3*v+3*u^2*v-v^3),
                  3*u^2-3*v^2],
                 u = [-1.5, 1.5], v = [-1.5, 1.5],
                 Grid = [30, 30],
                 Style = [HiddenLine, Mesh], Color = [Height,
                 [0, 1, 1], [1, 1, 0]]
           ]);
<<<>>>
plot3d(Axes = Box, Ticks = 0,
           CameraPoint = [0, 10, 4],
           [Mode = Surface,
                 [1.2+sin(u)*cos(v), sin(u)*sin(v), cos(u)],
                 u = [0, PI], v = [-PI, PI],
                 Grid = [20, 15],
                 Style = [HiddenLine, Mesh],
                 Color = [Height]
           ],
           [Mode = Surface,
                 [-1.2+sin(u)*cos(v), sin(u)*sin(v), cos(u)],
                 u = [0, PI], v = [-PI, PI],
                 Grid = [20, 15], Smoothness = [0, 2],
                 Style = [HiddenLine, Mesh],
                 Color = [Height]
           ]);
<<<>>>
plot3d(Axes = Box, Ticks = 0,
           [Mode = Surface,
                 [u, v, sin(u + sin(v))],
                 u = [-PI, PI], v = [-PI, PI],
                 Grid = [30, 30],
                 Style = [HiddenLine, Mesh],
                 Color = [Height, [0, 0, 1],
                         [1, 1, 1]]
           ]);
<<<>>>
reset():
<<<>>>
(1;
<<<>>>
 2;
<<<>>>
"What shall I do, MuPAD is not responding?";
<<<>>>
"Try with input of a bracket";
<<<>>>
"Now a sine-function and then a bracket";
<<<>>>
sin(3.5);
<<<>>>
);
<<<>>>
F := proc() local i; option remember; begin procname(args());
<<<>>>
3;
<<<>>>
4;
<<<>>>
end_proc;
<<<>>>
minus_list := proc(list1, list2)                       #  1 #
                 local i, j;                              #  2 #
                 begin                                    #  3 #
                   for i from 1 to nops(list1) do         #  4 #
                     for j from 1 to nops(list2) do       #  5 #
                       if list1[i] = list2[j] then        #  6 #
                         list1[i] := NIL;                 #  7 #
                       end_if                             #  8 #
                     end_for                              #  9 #
                   end_for;                               # 10 #
                   list1                                  # 11 #
                 end_proc:                                # 12 #
<<<>>>
minus_list([a,c,b], [b,a]);
<<<>>>
minus_list := proc(list1, list2)
                 local i, j, offset;
                 begin
                   offset := 0;
                   for i from 1 to nops(list1) do
                     for j from 1 to nops(list2) do
                       if list1[i-offset] = list2[j] then
                         list1[i-offset] := NIL;
                         offset := offset + 1;
                         break
                       end_if
                     end_for
                   end_for;
                   list1
                 end_proc:
<<<>>>
mistake:= proc(n)                      #112#
             local a, b, c;               #113#
             begin                        #114#
               n;                         #115#
               nops_own(sin(x));          #116#
               c:=(12*n;float(PI)*n;144); #117#
               a:=last(2);                #118#
               b:=last(3);                #119#
               a*b                        #120#
             end_proc:                    #121#
<<<>>>
mistake(12);
<<<>>>
bool((2; 4; 7)=7);
<<<>>>
(2; 3; 4);
<<<>>>
print(%, %2, %3);
<<<>>>
PRINTLEVEL := 40:
<<<>>>
mistake(12);
<<<>>>
reset():
<<<>>>
fib1:=proc(n)
begin
   if n<2 then n else fib1(n-1)+fib1(n-2) end_if:
end_proc:
<<<>>>
profile(fib1(10));
<<<>>>
fib2:=proc(n)
   option remember;
begin
   if n<2 then n else fib2(n-1)+fib2(n-2) end_if:
end_proc:
<<<>>>
profile(fib2(10));
<<<>>>
V:={v1,v2,v3,v4,v5,v6}:
U:={u1,u2,u3,u4,u5,u6}:

EDGE:={[v1,u1], [v1,u2], [v1,u4], [v2,u2], [v2,u6], [v3,u2],
       [v3,u3], [v4,u3], [v4,u5], [v4,u6], [v5,u3], [v5,u4],
       [v5,u5], [v5,u6], [v6,u2], [v6,u5]}:
<<<>>>
profile(bipartite_matching(V, U, EDGE));
<<<>>>
a := poly(
  9*x^5 + 2*x^4*y*z - 189*x^3*y^3*z + 117*x^3*y*z^2 + 3*x^3 -
  42*x^2*y^4*z^2 + 26*x^2*y^2*z^3 + 18*x^2 - 63*x*y^3*z +
  39*x*y*z^2 + 4*x*y*z + 6,
  [x, y, z]
):

b := poly(
  6*x^6 - 126*x^4*y^3*z + 78*x^4*y*z^2 + x^4*y + x^4*z + 13*x^3 -
  21*x^2*y^4*z - 21*x^2*y^3*z^2 + 13*x^2*y^2*z^2 + 13*x^2*y*z^3 -
  21*x*y^3*z + 13*x*y*z^2 + 2*x*y + 2*x*z + 2,
  [x,y, z]
):
<<<>>>
profile(heu_gcd(a, b));
<<<>>>
igcd_sys := igcd:
igcd := proc() begin igcd_sys(args()) end_proc:
genpoly_sys := genpoly:
genpoly := proc() begin genpoly_sys(args()) end_proc:
evalp_sys := evalp:
evalp := proc() begin evalp_sys (args()) end_proc:
<<<>>>
profile(heu_gcd(a, b));
<<<>>>
reset():
<<<>>>
get_ufunc();
<<<>>>
_plus(a, b);
<<<>>>
_assign(A, 12): A;
<<<>>>
op(hold((for a from 2 to 8 do print(a) end_for)), 0);
<<<>>>
op(hold((for a from 2 to 8 do print(a) end_for)));
<<<>>>
_for(a, 2, 8, NIL, print(a));
<<<>>>
12 := 24;
<<<>>>
_assign(12, 24);
<<<>>>
_plus := _power:
<<<>>>
2+10;
<<<>>>
reset():
<<<>>>
plus_localnew := proc(a, b)
                     local _plus;
                   begin
                     _plus := _mult;
                     a+b
                   end_proc:
<<<>>>
plus_localnew(12, 12);
<<<>>>
12+12;
<<<>>>
arithm_series := proc(start, stepp, count)
                     local i;
                   begin
                     _plus(start+i*stepp $ i=0..(count-1))
                   end_proc:
<<<>>>
arithm_series(2, 3, 2);
<<<>>>
op(_exprseq);
<<<>>>
op(op(_exprseq, 1));
<<<>>>
op(op(_exprseq, 2));
<<<>>>
_exprseq := func_env(built_in(55, NIL, "_exprseq", NIL),
                     built_in(51, 2, " Separator ", "_exprseq"),
                     NIL):
<<<>>>
(a, b, c, (d, k));
<<<>>>
_exprseq := subsop(_exprseq, [2,3] = ", "):
<<<>>>
(a, b, c, (d, k));
<<<>>>
abs(2); abs(a);
<<<>>>
f := proc(x)
        local h;
        begin
           h := expr2text(op(x,1));
           "| ".h." |";
        end_proc:
<<<>>>
abs := subsop(abs, 2 = f):
<<<>>>
abs(1); abs(-2); abs(a); abs(x+y);
<<<>>>
|a|;
<<<>>>
sin(-4); sin(asin(x)); sin(atan(x));
<<<>>>
_sin := sin:
<<<>>>
f := proc(x)
    local f;
begin
    if args(0) <> 1 then error("wrong no of args") end_if;

    case type(x)
    of DOM_INT do
    of DOM_RAT do
          if x < 0 then return(-_sin(-x)) end_if;
          break;

    of "asin" do
          if nops(x) <> 1 then break end_if;
          f:= op(x,1);
          return(f);

    of "acos" do
          if nops(x) <> 1 then break end_if;
          f:= op(x,1);
          return(sqrt(1-f^2));

    of "atan" do
          if nops(x) <> 1 then break end_if;
          f:= op(x,1);
          return(f/sqrt(1+f^2));
    end_case;

    _sin(x)
end_proc:
<<<>>>
sin:= subsop(_sin, 1=f):
sin:= subsop(sin, [1,5]=op(_sin, [1,4])):
<<<>>>
sin(-4); sin(asin(x)); sin(atan(x));
<<<>>>
diff(sin(x^2), x);
<<<>>>
reset():
<<<>>>
_plus;
<<<>>>
_plus := funcattr(_plus, "print", "Addition"):
<<<>>>
_plus;
<<<>>>
a+b; [a, _plus, b];
<<<>>>
diff(abs(x), x);
<<<>>>
abs := funcattr(abs, "diff",
        proc(expr,var)
        local e1;
        begin
            e1 := op(expr,1);
           (expr/e1) * diff(e1, var)
        end_proc):
<<<>>>
diff(abs(x),x);
<<<>>>
diff(abs(x^2),x);
<<<>>>
reset():
<<<>>>
factorial := proc(n)
               local i, p;
             begin
               p := 1;
               for i from 2 to n do p := p*i end_for
             end_proc:
<<<>>>
factorial(80);
<<<>>>
sum := subsop(factorial, [4, 1, 2]=0, [4, 2, 2]=1,
              [4, 2, 5, 2]=p+i, 6 = sum);
<<<>>>
sum(500);
<<<>>>
purge_locals :=  proc(f)
                   local dummy, a, i;
                 begin
                   a := {};
                   for i in op(f, 2) do
                     if subs(op(f,4), i=dummy) <> op(f,4) then
                       a := {i, op(a)}
                     end_if
                   end_for;
                   subsop(f, 2=op(a))
                 end_proc:
<<<>>>
function := proc(a)
                local i, G, DIGITS, LEVEL;
              begin
                i := a^2;
                DIGITS := 20;
                print(i)
              end_proc:
<<<>>>
function(3.2);
<<<>>>
function := purge_locals(function): function;
<<<>>>
CASE := proc ( a )
          begin
            case a
              of 0 do 0; break
              of 1 do 1; break
              of 2 do 2; break
              of 3 do 3; break
            end_case
          end_proc:
<<<>>>
IF := proc ( a )
        begin
          if a<=0 then
            0
          else
            if a<= 1 then
              1
            else
              if a<= 2 then
                2
              else
                AA
              end_if
            end_if
          end_if
        end_proc:
<<<>>>
pp := proc(a)  begin AAA end_proc:
<<<>>>
FF(a, subs(hold((LL, (LL; break))), LL=LL + k) $ k=0..500):
<<<>>>
CASE := subs(pp, AAA=%):
<<<>>>
CASE := subs(CASE, LL=0, FF=_case):
<<<>>>
LL := NIL: FF := NIL:
<<<>>>
IF := proc(a) begin FF(a<=LL, LL, AA) end_proc:
<<<>>>
(IF := subs(IF, AA=FF(a<=LL + k, LL + k, AA))) $ k=1..500:
<<<>>>
IF := subs(IF, LL=0, FF=_if):
<<<>>>
time(IF(501));
<<<>>>
time(CASE(501));
<<<>>>
fib := proc(n)
         begin
           if n<2 then n else fib(n-1)+fib(n-2) end_if;
         end_proc:
<<<>>>
fib_remember := proc(n)
                     option remember;
                   begin
                     if n<2 then n else fib_remember(n-1)
                           +fib_remember(n-2) end_if;
                   end_proc:
<<<>>>
fib_fast := proc(n) local i ;
              begin 0; 1;
                for i from 1 to n-1 do eval(%1+%2) end_for;
              end_proc:
<<<>>>
reset():
<<<>>>
s_seq := proc(ex, range)
            local last;
            option hold;
            begin
              level(hold(_stmtseq)(op(args(),
                 3..nops(args())), ex$range));
            end_proc:
<<<>>>
s_seq(i^2, i=1..5);
<<<>>>
eval(%);
<<<>>>
s_seq(i*5, i=1..5, 124, 125);
<<<>>>
s_seq(%*5, i=1..4, 124, 125);
<<<>>>
eval(%);
<<<>>>
stmt_seq:= proc(ex, ber)
             local  last, A;
             option hold;
             begin
                 A:=level(hold(_stmtseq)(op(args(),
                 3..nops(args())), eval(ex)$ber), 2);
             context(A);
             end_proc:
<<<>>>
stmt_seq(i*5, i=1..5, 124, 125);
<<<>>>
stmt_seq(%*5, i=1..4, 124, 125);
<<<>>>
124: 125: stmt_seq(%*5, i=1..4);
<<<>>>
stmt_seq(%1+%2, i=1..5, 0, 1);
<<<>>>
0: 1: stmt_seq(%1+%2, i=1..150);
<<<>>>
compare := proc(A, B)
              local m, n, i, k, z;
              begin
                z:=0;
                m:=nops(A);
                n:=nops(B);
                for i from 1 to m do
                  for k from 1 to n do
                    if A[i]=B[k] then
                      z:=z+1
                    end_if
                  end_for
                end_for;
                z;
              end_proc:
<<<>>>
compare([a, b], [a, g]);
<<<>>>
compare2 := proc(A, B)
               local a, b, z;
               begin
                 z := 0;
                 for a in val(A) do
                   for b in val(B) do
                      if a = b then
                        z := z + 1
                      end_if
                   end_for
                 end_for;
                 z;
               end_proc:
<<<>>>
compare2([a, b], [a, g]);
<<<>>>
M := [a.i $ i=1..100]: N := [b.k $ k=1..100]:
<<<>>>
time(compare(M, N)); time(compare2(M, N));
<<<>>>
S:=0:
time((for i from 1 to 200 do S:=S+a*x^i + b*x^i  end_for));
<<<>>>
0:
time((for i from 1 to 200 do % + a*x^i + b*x^i end_for));
<<<>>>
sum1 := proc(n)
             local i, S;
           begin
             S:=0;
             for i from 1 to n do
               S:=S+a*x^i + b*x^i;
             end_for;
           end_proc:
<<<>>>
sum2 := proc(n)
             local i, S;
           begin
             0;
             for i from 1 to n do
                % + a*x^i + b*x^i;
             end_for;
           end_proc:
<<<>>>
time(sum1(200));
time(sum2(200));
<<<>>>
sum := proc(n)
            local i;
          begin
              a*x^i + b*x^i $ i = 1..n:
              _plus(%);
          end_proc:
time(sum(200));
<<<>>>
binom1 := proc(n, k)
             local bk;
             begin
               bk:=0;
               if k>n then bk;
               else  bk:=1;
                 case k
                 of 0 do bk:=1; break
                 of 1 do bk:=n; break
                 otherwise
                   for i from 1 to k-1 do bk:=bk*(n-i)/i; end_for;
                   bk:=bk*n/k;
                 end_case;
               end_if;
               bk;
             end_proc:
<<<>>>
binom2 := proc(n, k)
             local i;
             begin
               if k = 0 then return(1) end_if;
               if k > n then return(0) end_if;
               if k>n div 2 then binom2(n, n-k) end_if;
               _mult(n+1-i$i=1..k);
               %/fact(k);
             end_proc:
<<<>>>
taylor := proc(f, eqn, n)
              local a, k, x;
            begin
              x := op(eqn, 1);
              a := op(eqn, 2);
              _plus(eval(subs(f, eqn)),
              eval(subs(diff(f, x $ k ), eqn)) / fact(k)
                          * (x-a)^k $ k = 1..n);
            end_proc:
<<<>>>
taylor(sin(x^2), x=0, 20);
<<<>>>
taylor_fast := proc(f, eqn, n)
               local x, y, a, i, xi;
               begin
                 x := op(eqn, 1);
                 y := op(eqn, 2);
                 a:=f; xi:=NIL;
                 (a:=diff(val(a), x)/i*xi) $ i=1..n;
                 _plus(eval(subs((f,level(%,1)), [x=y, xi=x-y])));
               end_proc:
<<<>>>
taylor_fast(sin(x^2), x=0, 20);
<<<>>>
time(fact(10000));
<<<>>>
time(fact(10000));
<<<>>>
a &F (g, k);
<<<>>>
a &t b;
<<<>>>
a &t (b+c);
<<<>>>
(a+b) &t (a+c);
<<<>>>
(a+b) &t (c+d) + e;
<<<>>>
_write := subsop(_exprseq, [1,3] = "_write", [2,2] = 15,
[2,3] = " &t ",[2,4] = "_write"):
<<<>>>
t:= proc()
local a,b, i;
begin
     if args(0) > 2 then
        t(args(1), t(op(args(),2..args(0))))
     else
        case args(0)
          of 1 do args(1); break
          of 2 do a:=args(1); b:= args(2);
             if type(a) = "_plus" then
                _plus(t(op(a,i),b) $ i=1..nops(a))
             elif type(b)= "_plus" then
                 _plus(t(a,op(b,i)) $ i=1..nops(b))
             else _write(a,b)
             end_if;
             break;
          end_case;
     end_if;
end_proc:
<<<>>>
evalassign_1 := proc(left, right, depth)
                    local EVAL_STMT, stmt, s1, s2, newdepth;
                    option hold;                             #a#
                  begin
                    if  args(0)<>3 then
                      error("needs three arguments")
                    end_if;
                    newdepth:=level(depth);                  #b#
                    EVAL_STMT:=FALSE;                        #c#
                    stmt:=(s1:=s2);
                    if domtype(args(2)) = DOM_NIL then
                      stmt:=(subsop(stmt,
                      1=level(left, newdepth+1), 2=NIL))     #d#
                    else
                      stmt:=(subsop(stmt,
                       1=level(left, newdepth+1),
                       2=level(right)))                      #e#
                    end_if;
                    eval(%);
                  end_proc:
<<<>>>
f := NIL: evalassign_1(op(f(x), 0), 15, 1): f;
<<<>>>
evalassign_1(f, NIL, 0): f;
<<<>>>
evalassign := proc(left, right, depth)
                   option hold;
                   local dummy;
                 begin
                 depth:= context(depth);
                 if depth = 0
                    then
                    context(subsop(hold(_assign(dummy, dummy)),
                        1=left, 2=right))
                 else
                    context(subsop(hold(_assign(dummy, dummy)),
                    1=context(subsop(hold(level(dummy, dummy)),
                    1=left, 2=depth)), 2=right))
                 end_if;
              end_proc:
<<<>>>
FUNC := proc(argu)
             local newargu, fct, dummy1, dummy2;
           option hold;
           begin
             if type(args(1)) = "_equal" then                  #a#
                _exprseq(op(args(1)));
                newargu:=(op(args(1)), NIL, args(i)$i=2..args(0))
             else
                newargu:=args()                                #b#
             end_if;

             fct:=proc(dummy1)                                 #c#
             begin
                dummy2;
             end_proc;

             fct:=subsop(fct, 1=op(op(newargu, 1)),
                       4=op(newargu, 2));
             fct:=level(fct);
             domtype(op(newargu, 1));
             if % = DOM_EXPR or % = DOM_ARRAY then             #d#
                op(newargu, [1, 0]);
                if domtype(level(last(1))) = DOM_FUNC then     #e#
                   return("Please, do not redefine
                      functional environments");
                else
                   fct := subsop(fct, 6=op(newargu, [1,0]));
                   evalassign(op(newargu, [1,0]), fct, 1);     #f#
                end_if;
             else
                fct;
             end_if;
           end_proc:
<<<>>>
FUNC(f(x)=x^7): f;
<<<>>>
FUNC(g(x), x^9): g;
<<<>>>
FUNC(x, x^9);
<<<>>>
get_ufunc := proc() local i, ufunc;
                begin
                  ufunc := [];
                  for i in anames(0) do
                     if strmatch("".i, "_\*") then
                       ufunc := append(ufunc, i)
                     end_if
                  end_for:
                  ufunc;
                end_proc:
<<<>>>
der := proc()
           local d, n;
         begin
           d:=type(args(1));
           case d
               of DOM_INT do
               of DOM_RAT do
               of DOM_FLOAT do
               of DOM_COMPLEX do
               of DOM_IDENT do
                 if args(1)=args(2) then 1 else 0 end_if;
                 break
               of "_mult" do
                 _plus(der(op(args(1), n), args(2))*
                   subsop(args(1), n=1) $ n=1..nops(args(1)));
                 break
               of "_plus" do
                 _plus(der(op(args(1), n),
                    args(2)) $ n=1..nops(args(1)));
                   break
               of "_power" do op(args(1), 1);
                 op(args(1), 2);
                 args(1)*ln(last(2))*der(last(1),
                     args(2))+last(1)*der(last(2),
                     args(2))*last(2)^(last(1)-1);
                 break
               otherwise
                 _par(text2expr(d))(op(args(1)))*
                             der(op(args(1), 1), args(2))
           end_case;
           eval(last(1));
         end_proc:
<<<>>>
der(x^5, x);
<<<>>>
der(x+x*64, x);
<<<>>>
der(sin(x), x);
<<<>>>
_par(sin) := cos:
<<<>>>
der(sin(x)*sin(x^(1/2)), x);
<<<>>>
_par(sinh):=cosh:
<<<>>>
_par(cos):=FUNC([x], -sin(x)):
<<<>>>
_par(cosh):=sinh:
<<<>>>
_par(tan):=FUNC([x], cos(x)^(-2) ):
<<<>>>
_par(tanh):=FUNC([x], cosh(x)^(-2)):
<<<>>>
_par(asin):=FUNC([x], (1-x^2)^(-1/2)):
<<<>>>
_par(asinh):=FUNC([x], (1+x^2)^(-1/2)):
<<<>>>
_par(acos):=FUNC([x], -(1-x^2)^(-1/2)):
<<<>>>
_par(acosh):=FUNC([x], (x^2-1)^(-1/2)):
<<<>>>
_par(atan):=FUNC([x], (1+x^2)^(-1)):
<<<>>>
_par(atanh):=FUNC([x], (1-x^2)^(-1)):
<<<>>>
_par(exp):=exp:
<<<>>>
_par(sqrt):=FUNC([x], (2*(x))^(-1/2)):
<<<>>>
_par(ln):=FUNC([x], (x)^(-1)):
<<<>>>
der(x*sin(atanh(x+x^5))+x^2, x);
<<<>>>
der(%, x);
<<<>>>
heu_gcd:= proc(a, b)
local x, xv, g, tries, bound;
begin
   x:= op(a,[2,1]);
   bound := max(degree(a,x), degree(b,x));
   xv := 2*min(norm(a), norm(b)) + 2;

   for tries from 1 to 6 do
      if strlen("".xv) * bound > 5000 then return(FALSE) end_if;
      if nops(op(a,2)) = 1 then
            g := igcd(evalp(a,x=xv), evalp(b,x=xv))
      else
            g := heu_gcd(evalp(a,x=xv), evalp(b,x=xv));
            if g = FALSE then return(FALSE) end_if
      end_if;
      if g <> FAIL then
            g := genpoly(g, xv, x);
            if divide(a, g, hold(Exact)) <> FAIL then
               if divide(b, g, hold(Exact)) <> FAIL then
                  return(g)
               end_if
            end_if
      end_if;
      xv := trunc(xv * 73794 / 27011);
   end_for;
   FAIL;
end_proc:
<<<>>>
p1 := poly(x^3 - 6*x^2 + 11*x - 6, [x]):
p2 := poly(x^3 - 11*x^2 + 38*x - 40, [x]):
<<<>>>
heu_gcd(p1, p2);
<<<>>>
p1 := poly(x^2*y*z*6 + x*y^2*z^2*3 + x*6 + y*z*3, [x, y, z]):
p2 := poly(x*y^2*z^2*3 + x*y^2*z*3 + y*z*3 + y*3, [x, y, z]):
<<<>>>
heu_gcd(p1, p2);
<<<>>>
Chebyshev := proc(n,x)
local T;
begin
   case n
     of 0 do
        T := poly(1,[x]);
        break;
     of 1 do
        T := poly(x,[x]);
        break;
     otherwise
        T := poly(2 * x,[x]) * Chebyshev(n-1,x) - Chebyshev(n-2,x);
   end_case;
   T;
end_proc:
<<<>>>
Chebyshev(4,x);
<<<>>>
Chebyshev(8,x);
<<<>>>
Cheby_iter := proc(n, x)
        local i;
        begin
          poly(1,[x]); poly( x, [x]);
          for i from 1 to n-1 do
            poly(2*x, [x]) * eval(%1) - eval(%2)
          end_for;
        end_proc:
<<<>>>
time(Chebyshev(8,x)); time(Cheby_iter(8,x));
<<<>>>
permute:= proc(list)
local perm;
begin
   perm := proc(l)
   local i, elem, result, res, rl, lcopy;
   begin
      if nops(l) = 2
         then return([[op(l,1), op(l,2)], [op(l,2), op(l,1)]])
      end_if;
      result := []; lcopy := l;
      for i from 1 to nops(l) do
         elem := l[i]; l[i] := NIL;
         res := perm(l);
         for rl in res do
            result := append(result, [elem].rl)
         end_for;
         l := lcopy
      end_for;
      result;
   end_proc;

   perm(list);
end_proc:
<<<>>>
permute([1,2,3,4]);
<<<>>>
permute([Apple, "Peach", Pear]);
<<<>>>
bininsert := proc(list)
local i, j, l, r, m, x;
begin
   for i from 2 to nops(list) do
      x := list[i]; l := 1; r := i -1;
      while l <= r do
         m := (l + r) div 2;
         if x < list[m]
            then r := m-1
            else l := m + 1
         end_if;
      end_while;
      for j from i-1 downto l do
         list[j+1] := list[j]
      end_for;
      list[l] := x;
   end_for;
   list;
end_proc:
<<<>>>
bininsert([10,8,9,6,7,4,5,2,3,1]);
<<<>>>
short_path := proc(V, c)
local i, j, k, d;
begin
   for i in V do
      for j in V do
         if i <> j
            then d[i,j] := c[i,j]
            else d[i,j] := 0
         end_if;
      end_for;
   end_for;
   for k in V do
      for i in V do
         for j in V do
            d[i,j] := min(d[i,j], d[i,k] + d[k,j])
         end_for;
      end_for;
   end_for;
   d;
end_proc:
<<<>>>
V := {1, 2, 3}:
c[1,1] := 0: c[1,2] :=  4: c[1,3] := 11:
c[2,1] := 6: c[2,2] :=  0: c[2,3] :=  2:
c[3,1] := 3: c[3,2] := 25: c[3,3] :=  0:
<<<>>>
short_path(V,c);
<<<>>>
V := {1, 2, 3, 4, 5}:
c := table(
   (1,1) =  0, (1,2) =  2, (1,3) =  4, (1,4) = 25, (1,5) = 3,
   (2,1) =  2, (2,2) =  0, (2,3) =  8, (2,4) = 25, (2,5) = 1,
   (3,1) =  6, (3,2) =  2, (3,3) =  0, (3,4) =  4, (3,5) = 3,
   (4,1) =  1, (4,2) = 25, (4,3) = 25, (4,4) =  0, (4,5) = 5,
   (5,1) = 25, (5,2) = 25, (5,3) = 25, (5,4) =  1, (5,5) = 0
):
<<<>>>
short_path(V,c);
<<<>>>
bipartite_matching:=proc(V,U,EDGE)
local v, erg, A, Q, mate, exposed, label, init,
      build_Q, build_A, augment, loop;
begin

   init := proc(V, U, EDGE)
   local v;
   begin
      for v in V do exposed[v] := 0; end_for;
      A := {}; build_A(V,U,EDGE); build_Q(V,U,EDGE);
      loop(V,U,EDGE);
   end_proc:

   build_A := proc(V,U,EDGE)
   local v, u, edge;
   begin
      for edge in EDGE do
         v := op(edge,1); u := op(edge,2);
         if mate[u] = 0 then exposed[v] := u
            elif mate[u] <> v then A := A union {[v,mate[u]]}
         end_if;
      end_for;
   end_proc:

   build_Q := proc(V,U,EDGE)
   local v;
   begin
      Q := {};
      for v in V do
         label[v] := 0;
         if mate[v] = 0 then Q := Q union {v} end_if;
      end_for;
   end_proc;

   augment := proc(v)
   begin
      if label[v] = 0
         then mate[v] := exposed[v]; mate[exposed[v]] := v;
         else exposed[label[v]] := mate[v]; mate[v] := exposed[v];
            mate[exposed[v]] := v; augment(label[v]);
      end_if;
   end_proc;

   loop := proc(V,U,EDGE)
   local v;
   begin
      while Q <> {} do
         v := op(Q,1); Q := Q minus {v};
         if exposed[v] <> 0  then augment(v); init(V,U,EDGE);
            else for vs in V do
               if label[vs] = 0
                  then for edge in A do
                     if edge=[v,vs]
                        then label[vs] := v; Q := Q union {vs}
                     end_if;
                     end_for;
               end_if;
               end_for;
         end_if;
      end_while;
   end_proc;

# begin main program #

   for v in (V union U) do mate[v]:= 0; end_for;
   init(V, U, EDGE); erg := {};
   for v in V do
      if mate[v] <> 0 then erg := erg union {[v,mate[v]]} end_if;
   end_for;
   erg;
end_proc:
<<<>>>
V:={v1,v2,v3,v4,v5,v6}: U:={u1,u2,u3,u4,u5,u6}:
EDGE:={[v1,u1], [v1,u2], [v1,u4], [v2,u2], [v2,u6], [v3,u2],
       [v3,u3], [v4,u3], [v4,u5], [v4,u6], [v5,u3],
       [v5,u4], [v5,u5], [v5,u6], [v6,u2], [v6,u5]}:
<<<>>>
bipartite_matching(V,U,EDGE);
<<<>>>
moduloring := proc(n)
begin
   if args(0) <> 1 then
      error("Wrong number of arguments");
   end_if;
   if domtype(n) <> DOM_INT then
      error("Wrong type of argument");
   end_if;
   if n <= 0 then
      error("Wrong argument");
   end_if;

   mdom := domain():

   #  addition  #
   mdom::_plus :=
      proc(x)
      local i;
      begin
         x := extop(x, 1);
         for i from 2 to args(0) do
            x := (x + extop(args(i), 1)) mod n;
         end_for;
         new (mdom, x);
      end_proc;

   #  negation  #
   mdom::negate :=
      proc(x)
      begin
         new (mdom, -extop(x, 1) mod n);
      end_proc;

   #  subtraction  #
   mdom::substract :=
      proc(x,y)
      begin
         new (mdom, (extop(x, 1)-extop(y, 1)) mod n);
      end_proc;

   #  multiplication  #
   mdom::_mult :=
      proc(x)
         local i;
      begin
         x := extop(x, 1);
         for i from 2 to args(0) do
            x := (x * extop(args(i), 1)) mod n;
         end_for;
         new (mdom, x);
      end_proc;

   #  inverse wrt. multiplication  #
   mdom::invert :=
      proc(x)
         local a;
      begin
         a := 1/extop(x, 1);
         new (mdom, a mod n);
      end_proc;

   #  binary division  #
   mdom::divide :=
      proc(x, y)
      begin
         new (mdom, extop(x, 1)/extop(y, 1) mod n);
      end_proc;

   #  exponentiation  #
   mdom::_power :=
      proc(x,y)
         local h, list;
      begin
         if domtype(y) <> DOM_INT then
            error("Wrong exponent");
         end_if;

         if y=0 then
            return (one);
         end_if;
         if y<0 then
            x := inverse(x);
            y := -y;
         end_if;

         list := [];
         while y<>1 do
            list := append(list, y mod 2);
            y := y div 2;
         end_while;
         y := nops(list);
         h := x;
         while y<>0 do
            h := __mult(h, h);
            if list[y]=1 then
               h := __mult(x, h);
            end_if;
            y := y-1;
         end_while;
         h;
      end_proc;

   #  definition of a new domain element  #
   mdom::new :=
      proc(x)
      begin
         if args(0) <> 1 then
            error("Wrong number of arguments");
         end_if;
         if domtype(x) <> DOM_INT then
            error("Wrong type of argument");
         end_if;
         new (mdom, x mod n);
      end_proc;

   #  output of a domain element  #
   mdom::print :=
      proc(x)
      begin
         extop(x, 1);
      end_proc;

   #  converting functions  #
   mdom::convert :=
      proc(x)
      begin
         if domtype(x) = DOM_INT then
            mdom::new(x);
          else
            FAIL
         end_if;
      end_proc :

   mdom::expr :=
      proc(x)
      begin
         extop(x,1);
      end_proc :

   #  neutral elements  #
   mdom::zero := new(mdom, 0);
   mdom::one := new(mdom, 1);

   #  domain name  #
   mdom::name := "Z".n;

   subs(mdom, hold(mdom) = mdom);
   subs(mdom, hold(inverse) = mdom::invert);
   subs(mdom, hold(n) = n);
   subs(mdom, hold(__mult) = mdom::_mult);
   subs(mdom, hold(one) = mdom::one);

   mdom;
end_proc:
<<<>>>
Z7 := moduloring(7);
<<<>>>
a := Z7::new(5); b := Z7::new(11);
<<<>>>
a + b; a * b; a - b; a / b;
<<<>>>
a ^ 6;  b ^ 4;
<<<>>>
Rinf := domain():
Rinf::name := "Rinf":

Rinf::new := proc(x)
begin
   new(Rinf,x);
end_proc:

Rinf::type := proc(x)
begin
   Rinf;
end_proc:

Rinf::domtype := proc(x)
begin
   Rinf;
end_proc:

Rinf::print := proc(x)
local expr, infinity;
begin
   if x = Rinf::infinity then
      expr := hold(infinity);
   elif x = Rinf::minfinity then
      expr := hold(-infinity);
   else
      expr := subs(hold(Rinf(q)), hold(q)=extop(x, 1));
   end_if;
   expr;
end_proc:

Rinf::zero := Rinf::new(0):
Rinf::one := Rinf::new(1):
Rinf::minfinity := Rinf::new(hold(MInfinity)):
Rinf::infinity := Rinf::new(hold(Infinity)):
<<<>>>
Rinf::_plus := proc()
local i, L, c1, c2;
begin
   L := [args()]; c1:= 0; c2 := 0;
   while (i := contains(L, Rinf::minfinity)) <> 0 do
      L[i] := NIL; c1 := c1 + 1;
   end_while;
   while (i := contains(L, Rinf::infinity)) <> 0 do
      L[i] := NIL; c2 := c2 + 1;
   end_while;

   if c1 > c2 then return(Rinf::minfinity)
   elif c2 > c1 then return(Rinf::infinity)
   elif c1 = c2 and c1 > 0 then return(Rinf::minfinity)
   else
      i := NIL;
      extop(args(i), 1) $ i = 1..args(0);
      Rinf::new(_plus(%));
   end_if;
end_proc:

Rinf::_mult := proc()
local i, L, sign, c1, c2;
begin
   if contains([args()], Rinf::zero) <> 0
      then return (Rinf::zero)
   end_if;
   L := [args()]; sign := 1; c1:= 0;
   while (i := contains(L, Rinf::minfinity)) <> 0 do
      L[i] := NIL; sign := sign * (-1); c1 := c1 + 1;
   end_while;
   c2 := 0;
   while (i := contains(L, Rinf::infinity)) <> 0 do
      L[i] := NIL; c2 := c2 + 1;
   end_while;
   if c1 > 0 or c2 > 0 then
      if sign = -1
         then return(Rinf::minfinity)
         else return(Rinf::infinity)
      end_if;
   end_if;
   i := NIL;
   extop(args(i), 1) $ i = 1..args(0);
   Rinf::new(_mult(%));
end_proc:

Rinf::_power := proc(x,y)
begin
   if x < Rinf::zero
      then return(FAIL)
   elif x = Rinf::infinity or y = Rinf::infinity
      then return (Rinf::infinity)
   elif y = Rinf::minfinity
      then return(Rinf::one)
   else
      return (Rinf::new(_power(extop(x,1), extop(y,1))));
   end_if;
end_proc:
<<<>>>
Rinf::negate := proc(x)
begin
   case x
      of Rinf::infinity do
         return (Rinf::minfinity);
         break;
      of Rinf::minfinity do
         return (Rinf::infinity);
         break;
      otherwise
         return (Rinf::new(-extop(x,1)));
   end_case;
end_proc:

Rinf::invert := proc(x)
begin
   case x
      of Rinf::infinity do
         return (Rinf::zero);
         break;
      of Rinf::minfinity do
         return (Rinf::zero);
         break;
      otherwise
         return (Rinf::new(1/extop(x,1)));
   end_case;
end_proc:
<<<>>>
Rinf::_less := proc(x,y)
begin
   if x = Rinf::minfinity and y = Rinf::minfinity
      then return (FALSE)
   elif x = Rinf::minfinity
      then return (TRUE)
   elif y = Rinf::minfinity
      then return (FALSE)
   elif x = Rinf::infinity
      then return(FALSE)
   elif y = Rinf::infinity
      then return (TRUE)
   else return (bool(_less(extop(x,1), extop(y,1))));
   end_if;
end_proc:

Rinf::_leequal := proc(x,y)
begin
   if x = Rinf::minfinity
      then return (TRUE);
   elif x = Rinf::infinity and y = Rinf::infinity
      then return (TRUE);
   elif x = Rinf::infinity
      then return (FALSE);
   elif y = Rinf::minfinity
      then return(FALSE)
   else return (bool(_leequal(extop(x,1), extop(y,1))));
   end_if;
end_proc:
<<<>>>
Rinf::min := proc()
local i, L;
begin
   if contains([args()], Rinf::minfinity) <> 0
      then return (Rinf::minfinity)
      else
         L := [args()];
         while (i := contains(L, Rinf::infinity)) <> 0 do
            L[i] := NIL;
         end_while;
         i := NIL;
         L := op(L[i], 1) $ i = 1..nops(L);
         Rinf::new(min(L));
   end_if;
end_proc:

Rinf::max := proc()
local i, L;
begin
   if contains([args()], Rinf::infinity) <> 0
      then return (Rinf::infinity)
      else
         L := [args()];
         while (i := contains(L, Rinf::minfinity)) <> 0 do
            L[i] := NIL;
         end_while;
         i := NIL;
         L := op(L[i], 1) $ i = 1..nops(L);
         Rinf::new(max(L));
   end_if;
end_proc:
<<<>>>
r1 := Rinf::new(2); r2 := Rinf::new(4);
infinity := Rinf::infinity;
<<<>>>
type(r1); domtype(-infinity);
<<<>>>
r1 * infinity; min(infinity, r1, r2);
max(infinity, r1, -infinity, r2);
<<<>>>
bool(-infinity < r2);  bool(infinity < r1);
<<<>>>
Rinf::func_call := proc()
begin
     args(1);
end_proc:
<<<>>>
r1(x,y,z); infinity(2);
<<<>>>
subs(Rinf, hold(Rinf) = Rinf):
<<<>>>
reset():
<<<>>>
flatten := proc(e,f)
local do_flatten, rm_op;
begin
   # rm_op(x,f) removes the operator f in x=f(...) #
   rm_op := proc(x,f)
   begin
      if domtype(x) = DOM_EXPR then
         if op(x,0) = f then
            return(op(x))
         end_if
      end_if;
      x;
   end_proc;

   # do_flatten(e,f) -- flatten without parameter check #
   do_flatten := proc(e,f)
   local i, res;
   begin
      if domtype(e) <> DOM_EXPR then
         return(e);
      end_if;
      # flattening of operands  #
      res:= subsop(e, (i=do_flatten(op(e,i), f)) $ i=1..nops(e));
      # remove operator in the operands #
      if domtype(res) = DOM_EXPR then
         res:= subsop(%1, (i=rm_op(op(%1,i), f)) $ i=1..nops(%1))
      end_if;
      res;
   end_proc;

   # main program #
   if args(0) <> 2 then
      error("wrong no of args")
   end_if;
   if domtype(e) <> DOM_EXPR then
      return(e);
   end_if;
   do_flatten(e,f);
end_proc:
<<<>>>
flatten(f(a,f(b)), f);
<<<>>>
flatten(f(a,f(a),f(b,f(b))),f);
<<<>>>
flatten2 := proc(e,f)
local T;
begin
   if args(0) <> 2 then
      error("wrong no of args")
   end_if;
   if domtype(e) <> DOM_EXPR then
      return(e);
   end_if;
   f(eval(subs(op(e), f = _exprseq)));
end_proc:
<<<>>>
T := f(a),f(b),f(c):
TT := (f(T) $ 100):
<<<>>>
time(flatten(f(TT),f)); time(flatten2(f(TT),f));
<<<>>>
fft := proc(A, m)
local i, j, k, l, n, nd2, p2, p2m, ind, r, s, t;
begin
   n := 2 ^ m; nd2 := n div 2; j := 1;
   for i from 1 to n-1 do
      if i < j
         then t := A[j]; A[j] := A[i]; A[i] := t;
      end_if;
      k := nd2;
      while k < j do
         j := j - k; k := k div 2;
      end_while;
      j := j + k;
   end_for;
   for l from 1 to m do
      p2 := 2 ^ l; p2m := p2 div 2;
      r := 1.0; s := float(cos(PI/p2m) + I*sin(PI/p2m));
      for j from 1 to p2m do
         for i from j to n step p2 do
            ind := i + p2m; t := A[ind] * r;
            A[ind] := A[i] - t; A[i] := A[i] + t;
         end_for;
         r := r * s;
      end_for;
   end_for;
   A;
end_proc:
<<<>>>
A := [2.0, 4.0, 1.0, 5.0]:
<<<>>>
fft(A, 2);
<<<>>>
A := [ 7.0, 5.0, 3.0, 6.0, 4.0, 2.0, 1.0, 8.0]:
<<<>>>
fft(A, 3);
