Return to Mr Belvedere's Programming Nook
2-3 Tree
© 1996 by Bobby Griggs.
(**************************************************************************)
(* Robert C. Griggs, Jr. *)
(* *)
(* 2-3 Tree *)
(**************************************************************************)
{ This program was written as a requirement for CSC 831 at Eastern
Kentucky University. The assignment was as follows:
Write a Pascal program that creates a 2-3 tree using the keys given
below, traverses the tree in level order, and sorts the keys applying
the extended inorder traversal algorithm on the 2-3 tree. }
(**************************************************************************)
program Tree_2_3 (input,output);
const
FILENAME = 'tree23.txt';
ASIZE = 80;
type
link = ^node23;
node23 = record
key1,
key2:char;
child1,
child2,
child3:link;
end;
queuearray = array[1..6,0..ASIZE] of char;
var
chartree,
addchar:link;
level,
character:integer;
letter:char;
charlevels:queuearray;
(**************************************************************************)
procedure Makenode (var ctree:link;letter:char); forward;
procedure Insert_Char (var ctree:link;letter:char;var addchar:link);
forward;
procedure First_Case (var ctree,atree:link); forward;
procedure Second_Case (var ctree,atree:link); forward;
procedure Third_Case (var ctree,atree:link); forward;
procedure Fourth_Case (var ctree,atree:link); forward;
procedure Fifth_Case (var ctree,atree:link); forward;
(**************************************************************************)
(* Procedure to initialize array for tracking levels. *)
procedure Init_Array (var charlevels:queuearray);
begin {procedure Init_Array}
for level:=1 to 6 do
for character:=1 to ASIZE do
charlevels[level,character]:=' ';
level:=0;
character:=0;
end; {procedure Init_Array}
(**************************************************************************)
(* Procedure to perform in order traversal. *)
procedure In_Order (chartree:link);
begin {procedure In_Order}
if chartree <> nil then
begin {if statement}
Inc (level);
if chartree^.key2 = '+' then
begin {if statement}
In_Order (chartree^.child1);
write (chartree^.key1);
Inc (character);
charlevels[level,character]:=chartree^.key1;
In_Order (chartree^.child2);
Dec (level);
end {if statement}
else
begin {else statement}
In_Order (chartree^.child1);
write (chartree^.key1);
Inc (character);
charlevels[level,character]:=chartree^.key1;
In_Order (chartree^.child2);
write (chartree^.key2);
Inc (character);
charlevels[level,character]:=chartree^.key2;
In_Order (chartree^.child3);
Dec (level);
end; {else statement}
end; {if statement}
end; {procedure In_Order}
(**************************************************************************)
(* Procedure to perform level order traversal. *)
procedure Level_Order (chartree:link;charlevels:queuearray);
begin {procedure Level_Order}
writeln ('Level Order Traversal ... ');
writeln;
for level:=1 to 6 do
begin {for loop}
for character:=1 to ASIZE do
write (charlevels[level,character]);
writeln;
end; {for loop}
end; {procedure Level_Order}
(**************************************************************************)
(* Procedure to initialize 2-3 tree. *)
procedure Init (var ctree:link);
begin {procedure Init}
New (ctree);
ctree^.key1:='+';
ctree^.key2:='+';
ctree^.child1:=nil;
ctree^.child2:=nil;
ctree^.child3:=nil;
end; {procedure Init}
(**************************************************************************)
(* Procedure to implement one case of 2-3 tree. *)
procedure First_Case (var ctree,atree:link);
var
temp:link;
begin {procedure First_Case}
ctree^.key2:=ctree^.key1;
ctree^.key1:=atree^.key1;
ctree^.child3:=ctree^.child2;
ctree^.child1:=atree^.child1;
ctree^.child2:=atree^.child2;
temp:=atree;
Dispose (temp);
atree:=nil;
end; {procedure First_Case}
(**************************************************************************)
(* Procedure to implement one case of 2-3 tree. *)
procedure Second_Case (var ctree,atree:link);
var
temp:link;
begin {procedure Second_Case}
ctree^.child2:=atree^.child1;
ctree^.key2:=atree^.key1;
ctree^.child3:=atree^.child2;
temp:=atree;
Dispose (temp);
atree:=nil;
end; {procedure Second_Case}
(**************************************************************************)
(* Procedure to implement one case of 2-3 tree. *)
procedure Third_Case (var ctree,atree:link);
var
temp:link;
begin {procedure Third_Case}
Makenode (temp,ctree^.key2);
temp^.child1:=ctree^.child2;
temp^.child2:=ctree^.child3;
ctree^.child2:=temp;
ctree^.key2:='+';
ctree^.child3:=nil;
atree:=ctree;
end; {procedure Third_Case}
(**************************************************************************)
(* Procedure to implement one case of 2-3 tree. *)
procedure Fourth_Case (var ctree,atree:link);
var
temp,
temp1:link;
begin {procedure Fourth_Case}
Makenode (temp,ctree^.key2);
temp^.child1:=atree^.child2;
temp^.child2:=ctree^.child3;
atree^.child2:=temp;
ctree^.child2:=atree^.child1;
atree^.child1:=ctree;
ctree^.key2:='+';
ctree^.child3:=nil;
temp1:=ctree;
ctree:=atree;
atree:=temp1;
end; {procedure Fourth_Case}
(**************************************************************************)
(* Procedure to implement one case of 2-3 tree. *)
procedure Fifth_Case (var ctree,atree:link);
var
temp:link;
begin {procedure Fifth_Case}
Makenode (temp,ctree^.key1);
temp^.child1:=ctree^.child1;
temp^.child2:=ctree^.child2;
ctree^.child1:=temp;
ctree^.key1:=ctree^.key2;
ctree^.key2:='+';
ctree^.child2:=ctree^.child3;
ctree^.child3:=nil;
atree:=ctree;
end; {procedure Fifth_Case}
(**************************************************************************)
(* Procedure to make root of 2-3 tree. *)
procedure Makenode (var ctree:link;letter:char);
begin {procedure Makeroot}
Init (ctree);
ctree^.key1:=letter;
end;
(**************************************************************************)
(* Procedure to insert items into the 2-3 tree. *)
procedure Insert_Char (var ctree:link;letter:char;var addchar:link);
begin {procedure Insert_Char}
addchar:=nil;
if ctree = nil then
Makenode (ctree,letter)
else
begin {else statement}
if (ctree^.key2 <> '+') and (ctree^.child1 = nil) then
begin {if statement}
if letter < ctree^.key1 then
begin {if statement}
makenode (ctree^.child1,letter);
makenode (ctree^.child2,ctree^.key2);
ctree^.key2:='+';
end {if statement}
else
begin {else statement}
makenode (ctree^.child1,ctree^.key1);
if letter < ctree^.key2 then
begin {if statement}
makenode (ctree^.child2,ctree^.key2);
ctree^.key1:=letter;
end {if statement}
else
begin {else statement}
makenode (ctree^.child2,letter);
ctree^.key1:=ctree^.key2;
end; {else statement}
ctree^.key2:='+';
end; {else statement}
addchar:=ctree;
end {if statement}
else
begin {else statement}
if letter < ctree^.key1 then
begin {if statement}
if ctree^.key2 = '+' then
begin {if statement}
if ctree^.child1 = nil then
begin {if statement}
ctree^.key2:=ctree^.key1;
ctree^.key1:=letter;
end {if statement}
else
begin {else statement}
insert_char (ctree^.child1,letter,addchar);
if addchar <> nil then
First_Case (ctree,addchar);
end; {else statement}
end {if statement}
else
begin {else statement}
Insert_Char (ctree^.child1,letter,addchar);
if addchar <> nil then
Third_Case (ctree,addchar);
end; {else statement}
end {if statement}
else
begin {else statement}
if ctree^.key2 <> '+' then
begin {if statement}
if letter < ctree^.key2 then
begin {if statement}
insert_char (ctree^.child2,letter,addchar);
if addchar <> nil then
Fourth_Case (ctree,addchar);
end; {if statement}
if (letter = ctree^.key2) or
(letter > ctree^.key2) then
begin {if statement}
Insert_Char (ctree^.child3,letter,addchar);
if addchar <> nil then
Fifth_Case (ctree,addchar);
end; {if statement}
end {if statement}
else
begin {else statement}
if ctree^.child1 = nil then
ctree^.key2:=letter
else
begin {else statement}
Insert_Char (ctree^.child2,letter,addchar);
if addchar <> nil then
Second_Case (ctree,addchar);
end; {else statement}
end; {else statement}
end; {else statement}
end; {else statement}
end; {else statement}
end; {procedure Insert_Char}
(**************************************************************************)
(* Procedure to read data from file and call insert procedure. *)
procedure Read_File (var chartree,addchar:link);
var
charfile:text;
continue,
letter:char;
root,
done:boolean;
begin {procedure Read_File}
assign (charfile,FILENAME);
reset (charfile);
writeln ('Characters as read in from file ... ');
writeln;
root:=true;
while not(eof(charfile)) do
begin {while loop}
read (charfile,letter);
write (letter);
if root then
begin {if statement}
Makenode (chartree,letter);
root:=false;
end {if statement}
else
Insert_Char (chartree,letter,addchar);
end; {while loop}
end; {procedure Read_File}
(**************************************************************************)
(* Main program *)
begin {main program}
New (chartree);
chartree:=nil;
Read_File (chartree,addchar);
writeln;writeln;writeln;
writeln ('Inorder Traversal ... ');
writeln;
Init_Array (charlevels);
In_Order (chartree);
writeln;writeln;writeln;
Level_Order (chartree,charlevels);
end. {main program}