Unit Wiskunde;
{
This software has been designed and is CopyLefted
by Han de Bruijn:
(===)
@-O^O-@
#/_\#
### }
{
Stern-Brocot Tree
=================
}
INTERFACE
type
breuk = record { fraction }
t,n : integer;
end;
var
boom : array of breuk;
diep : array of integer;
function twee(n : integer) : integer;
procedure bomen(n : integer);
procedure bijvoorbeeld(n : integer);
IMPLEMENTATION
function twee(n : integer) : integer;
{
2^n
}
var
k,r : integer;
begin
r := 1;
for k := 1 to n do
r := r*2;
twee := r;
end;
function let(a,b : integer) : breuk;
{
a/b
}
var
c : breuk;
begin
c.t := a; c.n := b;
let := c;
end;
function plus(a,b : breuk) : breuk;
{
Mediant (a,b)
}
var
c : breuk;
begin
c.t := a.t + b.t;
c.n := a.n + b.n;
plus := c;
end;
procedure bomen(n : integer);
{
Tree
}
var
nn,k,ii,i,p,q,r,d : integer;
begin
{ Initialization }
nn := twee(n);
SetLength(boom,nn+1); SetLength(diep,nn+1);
boom[0] := let(0,1); boom[nn] := let(1,1);
diep[0] := 0; diep[nn] := 0;
{ In depth }
for k := 0 to n-1 do
begin
d := twee(n-k); ii := twee(k);
for i := 0 to ii-1 do
begin
p := i*d; q := (i+1)*d;
r := (p + q) div 2;
boom[r] := plus(boom[p],boom[q]);
diep[r] := k+1;
end;
end;
end;
procedure afdruk(n : integer);
{
Print
}
var
k,kk,i,L : integer;
begin
kk := Length(boom);
for k := 0 to kk-1 do
begin
for i := 0 to diep[k]-1 do
Write('------');
L := kk-k-1;
Write(boom[L].t,'/',boom[L].n);
for i := 0 to n-diep[k] do
Write('------');
Writeln;
end;
end;
procedure bijvoorbeeld(n : integer);
{
For example
}
begin
bomen(n); afdruk(n);
end;
END.