Kody źródłowe/Binarne drzewo poszukiwań

Pascal

Przykładowy program w języku Pascal. Buduje drzewo BST i przekształca je w drzewo wyważone.

program BST;

uses crt;

type
	wsk	=	^wezel;
	wezel	=	record
	      			d : integer;
	      			l : wsk;
				r : wsk;
			end;
			
var
	n,i,x	: integer;
	p	: wsk;

procedure Wstaw(var p : wsk; x : integer);
begin
	if p = nil then
	begin
		new(p);
		p^.d := x;
		p^.l := nil;
		p^.r := nil;
	end
	else if x<p^.d then
		Wstaw(p^.l,x)
	else
		Wstaw(p^.r,x);
end;

function Licz(p : wsk) : integer;
begin
	if p <> nil then
		Licz := 1 + Licz(p^.l) + Licz(p^.r)
	else Licz := 0;
end;

procedure Pokaz(p : wsk; w : integer);
var i : integer;
begin
	if p <> nil then begin
		Pokaz(p^.l, w+1);
		for i := 1 to w do write('  ');
		writeln(p^.d);
		Pokaz(p^.r, w+1);
	end
end;

procedure Wywaz(var p : wsk; b : integer);
var a : integer; q, w : wsk;
begin
	b := b-1;
	a := Licz(p^.l);
	b := b-a;
	while abs(a-b) > 1 do begin
		if a > b then begin
			if p^.l^.r <> nil then begin
				q := p^.l;
				repeat
					w := q;
					q := q^.r;
				until q^.r = nil;
				q^.r := p;
				q^.l := p^.l;
				w^.r := nil;
				p^.l := nil;
				p := q;
			end
		 	else begin
				p^.l^.r := p;
				q := p^.l;
				p^.l := nil;
				p := q;
			end;
			a := a-1;
			b := b+1;
		end
		else begin
			if p^.r^.l <> nil then begin
				q := p^.r;
				repeat
					w := q;
					q := q^.l;
				until q^.l=nil;
				q^.l := p;
				q^.r := p^.r;
				w^.l := nil;
				p^.r := nil;
				p := q;
			end
			else begin
				p^.r^.l := p;
				q := p^.r;
				p^.r := nil;
				p := q;
			end;
			a := a+1;
			b := b-1;
		end;
	end;
	if p^.l <> nil then Wywaz(p^.l,a);
	if p^.r <> nil then Wywaz(p^.r,b);
end;

begin
	p := nil;
	clrscr;
	writeln;
	write('Ile elementow? ');
	readln(n);
	for i := 1 to n do begin
		write('Element numer ',i,': ');
		readln(x);
		Wstaw(p,x);
	end;
	writeln;
	writeln('Nie wywazone:');
	Pokaz(p,0);
	n := Licz(p);
	writeln('Elementow jest ',n);
	Wywaz(p,n);
	writeln;
	writeln('Wywazone:');
	Pokaz(p,0);
	readln;
end.