Forums before death by AOL, social media and spammers... "We can't have nice things"
| comp.lang.pascal.borland | Borland Pascal was actually pretty neat | 2,978 messages |
[ << oldest | < older | list | newer > | newest >> ]
| Message 2,271 of 2,978 |
| Heinrich Wolf to All |
| Re: binary tree |
| 14 Sep 06 08:14:22 |
From: invalid@invalid.invalid
Here you are
program TreeSort(Input, Output);
type pTree = ^tTree;
tTree = Record
Left,
Right : pTree;
Value : String;
end;
Bits = Word;
var Open : Boolean;
Data : Text;
Tree : pTree;
s : String;
function MemOv : Integer;
begin
writeln('Memory overflow');
MemOv := 0;
end;
function InsertTree(var Tree : pTree; Value : String) : Integer;
begin
if Tree <> Nil then
if Value >= Tree^.Value then
InsertTree := InsertTree(Tree^.Right, Value)
else
InsertTree := InsertTree(Tree^.Left, Value)
else
begin
new(Tree);
if Tree = Nil then
InsertTree := MemOv
else
begin
Tree^.Value := Value;
Tree^.Left := Nil;
Tree^.Right := Nil;
InsertTree := 1;
end
end
end;
procedure Print(Tree : pTree;
Branch,
LeftBranches,
RightBranches : Bits);
var Bit,
NewBranch,
DeleteBranch : Bits;
begin
if Tree <> Nil then
begin
NewBranch := Branch shl 1;
if NewBranch = 0 then
begin
{ Maximum depth of tree's image
+-*
+-*
+-*
-+
|
}
NewBranch := Branch;
DeleteBranch := 0;
DeleteBranch := not DeleteBranch;
end
else
DeleteBranch := not (Branch shr 1);
Print(Tree^.Right,
NewBranch,
(LeftBranches and DeleteBranch) or Branch,
RightBranches);
{
.delete
.
. |create
. |
+-+
| |
-+ |
|
}
Bit := 1;
while Bit < Branch shr 1 do
begin
if ((LeftBranches or RightBranches) and Bit) <> 0 then
write(' |')
{ Branch above current depth }
else
write(' ');
{ Gap above current depth }
Bit := Bit shl 1;
end;
if Branch = 1 then
write('*+')
{ root
|
*+
|
}
else
write(' +-*');
{ node
|
-+
| |
+-*
|
}
Bit := Branch;
while Bit <> 0 do
begin
write(' ');
Bit := Bit shl 1;
end;
writeln(Tree^.Value);
Print(Tree^.Left,
NewBranch,
LeftBranches,
(RightBranches and DeleteBranch) or Branch);
{
|
-* |
| |
+-*
. |
. |create
.
.delete
}
dispose(Tree);
end;
end;
begin
Tree := Nil;
Open := False;
if ParamCount = 1 then
begin
Assign(Data, ParamStr(1));
{$i-}
Reset(Data);
{$i+}
Open := ioresult = 0;
end;
if Open then
while not eof(Data) do
begin
readln(Data, s);
InsertTree(Tree, s);
end
else
while not eof do
begin
readln(s);
InsertTree(Tree, s);
end;
Print(Tree, 1, 0, 0);
if Open then
close(Data);
end.
Regards
Heiner
--- SoupGate-Win32 v1.05
* Origin: you cannot sedate... all the things you hate (1:229/2)
|
(c) 1994, bbs@darkrealms.ca