Solved

Binary search tree using Pascal

Posted on 2007-07-25
6,350 Views
Could anybody change the following BST code so that the input could be read from a text file and the searched data could be output to the screen.
===================================================================================
Program Bsearch(input,output);
Uses wincrt;
Const exitpro = -1;
Type
Element = Word;

Ptr = ^Nodetype;

Nodetype = Record
Key:Element;
Left,Right:Ptr;
End;

Treeptrtype = Ptr;

Var Select:Integer;
Rootptr:Treeptrtype;
Targettype:Element;
Positionptr:Ptr;
Depthtype:Word;
Newnodeptr:Treeptrtype;
Nextnode:Element;

Procedure InitTree(Var Root:TreePtrType);
Begin
Root := nil;
Writeln('The tree has been initialised.');
Delay(1000);
End;

Function TreeEmpty(Root:TreePtrType):boolean;
Begin
TreeEmpty := (root = nil)
End;

Procedure SearchTree(Root:TreePtrType; Target:word;
Var Position:Ptr; Var Depth:word);
Begin
If root = nil then
Position := nil
Else
Begin
If root^.key = target then
Begin
Position := root;
Depth := 1;
End
Else if target < root^.key then
Begin
Depth := depth+1;
SearchTree(root^.left,target,position,depth);
End
Else Begin
Depth := depth+1;
SearchTree(root^.right,target,position,depth);
End;
End;
End;

Begin
If root = nil then
Begin
Root := newnode;
Root^.left := nil;
Root^.right := nil;
End
Else if newnode^.key < root^.key then
Else
End;

Procedure PreOrder(Root:TreePtrType);
Begin
If root <> nil then
Begin
Writeln(Root^.key);
PreOrder(Root^.left);
PreOrder(Root^.right);
End;
End;

Procedure PostOrder(Root:TreePtrType);
Begin
If root <> nil then
Begin
PostOrder(Root^.left);
PostOrder(Root^.right);
Writeln(Root^.key);
End;
End;

Procedure InOrder(Root:TreePtrType);
Begin
If root <> nil then
Begin
InOrder(Root^.left);
Writeln(Root^.key);
InOrder(Root^.right);
End;
End;

Procedure Screen(Var Choice:integer);
Begin
Clrscr;
Writeln;
Writeln('1.     Initialise a tree');
Writeln('2.     Add an item to a tree <a positive integer>');
Writeln('3.     Search for an item in the tree');
Writeln('4.     Preorder printout of tree');
Writeln('5.     Postorder printout of tree');
Writeln('6.     Inorder printout of tree');
Writeln('7.     Quit');
Writeln;
Writeln;
If (Choice < 1) or (Choice > 7) then
Begin
Writeln('Only options 1 to 7 are available.');
Delay(1000);
End;
End;

Begin {Main}
Repeat
Screen(select);
Case select of
1 : InitTree(rootptr);
2 : Begin
Writeln('Enter ',exitpro:1,' to stop.');
Write('Enter next data value or ',exitpro:1,' to stop.');
While nextnode <> exitpro do

End;
3 : SearchTree(rootptr,targettype,positionptr,depthtype);
4 : Preorder(rootptr);
5 : Postorder(rootptr);
6 : Inorder(rootptr);
End;
Until select = 7;
End.
==================================================================================
thanks
0
Question by:cipher007

LVL 10

Expert Comment

0

LVL 84

Expert Comment

reset(input,'text.file ');
0

LVL 9

Expert Comment

Borland Pascal???

If so, your code would not work like that... you never assign memory to any pointer...

http://www.experts-exchange.com/Programming/Languages/Pascal/Q_20092424.html

the way to ADD items to a link is... This code only add items, it does not sort'em...

Type
PointerToList = ^List;
List = Record
Value: Integer;
PrevItem: PointerToList;
NextItem: PointerToList;
End;

{ Procedure to add items into the list }
Begin
{Check If this is the first time the structure is going to be created}
If Current = NIL Then
Begin
New(Current); {Get memory for the data}
With Current^ do  {Fill in the data}
Begin
Value:=NewValue;
NextItem:=NIL; {Since there are any more Up this points NIL}
PrevItem:=NIL  {Since there are any more Down this points NIL}
End;
Start:=Current;
Finish:=Current
End
Else  {Now this is not the first time}
Begin
New(Finish);
Finish^.PrevItem:=Current; {Current <- Finish}
Finish^.NextItem:=NIL;     {Finish -> Nil}
Current^.NextItem:=Finish; {Current -> Finish}
Current:=Finish;       {Current:=Finish}
With Current^ do  {Fill in the data}
Begin
Value:=NewValue;
End
End
End;

This code sort'em up... using the bubble method, not the binary...

{ Procedure to sort the list using the bubble sort method }
Procedure Sort_List;
Var
Index1,Index2: Integer;
MaxNum: Integer;

Procedure ChangePlaces(Var Prev,Curr: PointerToList);
Var
Temp: Integer;
Begin
Temp:=Prev^.Value;
Prev^.Value:=Curr^.Value;
Curr^.Value:=Temp;
End;

Begin
MaxNum:=Count_Items;
Previous:=Start;
Current:=Finish;
For Index1:=1 To MaxNum-1 Do
Begin
For Index2:=MaxNum DownTo Index1+1 Do
Begin
If Previous^.Value > Current^.Value Then
ChangePlaces(Previous,Current);
Current:=Current^.PrevItem;
End;
Previous:=Previous^.NextItem;
Current:=Finish;
End
End;

The way to read/write from File... is...

http://www.experts-exchange.com/Programming/Languages/Pascal/Q_20465314.html
0

LVL 3

Author Comment

Forget about the code I have posted as it doesn't work, I thought it would give you some idea.

Ok, let me be more specific.
I am using TPW 1.5
Here's what I want the code to do.
The code should use binary search tree data structure
It should read from a text file (eg. the file would contain 1,2,3,4,5,6.... single number on a line would be fine)
The user should be able to add, delete and search numbers from the file.
The file contents should be listed (displayed on screen as a tree format...  e.g like the tree below)

4
/        \
2             6
/     \         /     \
1         3    5       7
So, basically its a binary search tree and the user should be able to add, delete, search and display the contents of the tree.

PS: I would add a bonus of 500 points to for the complete solution.

Thanks
0

LVL 10

Expert Comment

Shall i try in delphi. i don't know Turbo Pascal
0

LVL 10

Expert Comment

What is the Text file format?

Each line contain each number?
0

LVL 3

Author Comment

Program should be in pascal, please :-)
Windows text file.
Each line contain each number? yeah that would be fine.

Thanks for trying
0

LVL 10

Expert Comment

program BSearch;

uses wincrt;

Const exitpro = -1;
Type
Element = Word;

Ptr = ^Nodetype;

Nodetype = Record
Key:Element;
Left,Right:Ptr;
End;

Treeptrtype = Ptr;

Var Select:Integer;
Rootptr:Treeptrtype;
Targettype:Element;
Positionptr:Ptr;
Depthtype:Word;
Newnodeptr:Treeptrtype;
Nextnode:Treeptrtype;
NewElement:Integer;
S:string[11];

procedure DisplayTree(Distance,depth:Byte;Node:Treeptrtype);
var s:string;
begin
if Node<>nil then
begin
str(Node^.key,s);
gotoxy(Distance,depth);
writeln(s);
gotoxy(Distance-2,depth+1);
if Node^.left<>nil then  writeln('/');
gotoxy(Distance+2,depth+1);
if Node^.right<>nil then  writeln('\');
DisplayTree(Distance-4,depth+2,Node^.left);
DisplayTree(Distance+4,depth+3,Node^.right);
end;
end;

procedure FreeTree(var Root:TreePtrType);
begin
if Root<>nil then
begin
FreeTree(Root^.Left);
FreeTree(Root^.right);
Dispose(Root);
end;
end;

Procedure InitTree(Var Root:TreePtrType);
Begin
FreeTree(Root);
Root := nil;
Writeln('The tree has been initialised.');
End;

Function TreeEmpty(Root:TreePtrType):boolean;
Begin
TreeEmpty := (root = nil)
End;

var BackRoot:TreePtrType;
Begin

If root = nil then
Begin
Root := newnode;
Root^.left := nil;
Root^.right := nil;

End
Else if newnode^.key < root^.key then
End;}

var BackRoot:TreePtrType;
Begin

If root = nil then
Begin
Root := newnode;
Root^.left := nil;
Root^.right := nil;
End
Else
begin
if newnode^.key < root^.key then
begin
if (root^.left<>nil) and (root^.Right=nil) then
begin
BackRoot:=root;
Root:=root^.left;
BackRoot^.left:=nil;
Root^.right:=BackRoot;
end;
end
Else
begin
if (root^.Right<>nil) and (root^.left=nil) then
begin
BackRoot:=root;
Root:=root^.right;
BackRoot^.Right:=nil;
Root^.Left:=BackRoot;
end;
end;
end;
End;

Procedure SearchTree(Root:TreePtrType; Target:word;
Var Position:Ptr; Var Depth:word);
Begin
If root = nil then
Position := nil
Else
Begin
Depth := Depth+1;
If root^.key = target then Position := root
Else if target < root^.key then SearchTree(root^.left,target,position,depth)
Else SearchTree(root^.right,target,position,depth);
End;
End;

Procedure DeleteTree(var Root:TreePtrType; Target:word);
var DelRoot:TreePtrType;
Begin
if (root <> nil) then
begin
If root^.key = target then
begin
DelRoot:=root;
Root:=root^.left;
Dispose(DelRoot);
end
Else if target < root^.key then DeleteTree(root^.left,target)
Else DeleteTree(root^.right,target);
End;
End;

Procedure PreOrder(Root:TreePtrType);
Begin
If root <> nil then
Begin
Writeln(Root^.key);
PreOrder(Root^.left);
PreOrder(Root^.right);
End;
End;

Procedure PostOrder(Root:TreePtrType);
Begin
If root <> nil then
Begin
PostOrder(Root^.left);
PostOrder(Root^.right);
Writeln(Root^.key);
End;
End;

Procedure InOrder(Root:TreePtrType);
Begin
If root <> nil then
Begin
InOrder(Root^.left);
Writeln(Root^.key);
InOrder(Root^.right);
End;
End;

Procedure Screen(Var Choice:integer);
Begin
clrscr;
Writeln(' ');
Writeln('1.     Initialise a tree');
Writeln('2.     Add an item to a tree <a positive integer>');
Writeln('3.     Search for an item in the tree');
Writeln('4.     Preorder printout of tree');
Writeln('5.     Postorder printout of tree');
Writeln('6.     Inorder printout of tree');
Writeln('7.     Display Tree');
Writeln('8.     Delete Tree');
Writeln('9.     Quit');
Writeln;
Writeln;
If (Choice < 1) or (Choice > 9) then
Begin
Writeln('Only options 1 to 9 are available.');
End;
End;

procedure OPenFile(FileName:String);
var
f: file of char;
Ch:Char;
S:string;
key,Code:word;
begin
InitTree(rootptr);
Assign(f,FileName );
Reset(f);
while not Eof(F) do
begin
if ch in['0'..'9','.'] then S:=s+ch
else
begin
if S<>'' then
begin
val(s,Key,Code);
if Code=0 then
begin
New(nextnode);
nextnode^.Key:=key;
end;
S:='';
end;
end
end;
Close(f);
end;

begin

if ParamCount >0 then OPenFile(ParamStr(1));
Repeat
Screen(select);
Case select of
1 : InitTree(rootptr);
2 : Begin
Writeln('Enter ',exitpro:1,' to stop.');
Write('Enter next data value or ',exitpro:1,' to stop.');
While NewElement <> exitpro do
begin
New(nextnode);
nextnode^.Key:=NewElement;
Write('Enter next data value or ',exitpro:1,' to stop.');
end;
End;
3 :begin
Write('Enter the number to be search:  ');
SearchTree(rootptr,targettype,positionptr,depthtype);

str(targettype,S);

if positionptr<>nil then
Write('Find the number ('+S+') ')
else Write('Can''t Find the number ('+S+') ');
end;
4 : Preorder(rootptr);
5 : Postorder(rootptr);
6 : Inorder(rootptr);
7 :begin
clrscr;
displaytree(40,1,rootptr);
end;
8 :begin

Write('Enter the data to be delete.');
DeleteTree(rootptr, NewElement);
Write('Data deleted.');
end;
End;
Until select = 9;
end.
0

LVL 3

Author Comment

The tree works fine with some bugs. Thanks
Bugs:* When a number is searched it cannot find some numbers. Hope you can resolve this.
*Also when the tree is displayed the two main branches of the tree gets entangled at level 3.
I know that as you go down the tree it will be harder to display the branches.... But atleast if you
can display upto level three without that issue I will be a happy man. :-)
I was wondering when a particular number is searched whether you could also show/display the searched path also. Fo instance lets say we search for 5 from the following tree.
4
/        \
2             6
/     \         /     \
1         3    5       7
The result should be
4
\
6
/
5
or may be in this format 4-->6--->5 or any other easier way for you. But this is how the program should search for number 5 from the tree. right?
The point here is to show how the requested data was retrieved from the tree.

Thank you for taking your time to help.

0

LVL 10

Accepted Solution

program BSearch1;

uses wincrt;

Const exitpro = -1;
Type
Element = Word;

Ptr = ^Nodetype;

Nodetype = Record
Key:Element;
Left,Right:Ptr;
End;

Treeptrtype = Ptr;

Var Select:Integer;
Rootptr:Treeptrtype;
Targettype:Element;
Positionptr:Ptr;
Depthtype:Word;
Newnodeptr:Treeptrtype;
Nextnode:Treeptrtype;
NewElement:Integer;
S:string[11];
result:string;

procedure DisplayTree(Distance,depth:Byte;Node:Treeptrtype;CurLvelDiff:integer);
var s:string;

begin
if Node<>nil then
begin
str(Node^.key,s);
gotoxy(Distance,depth);
writeln(s);
gotoxy(Distance-CurLvelDiff,depth+1);
if Node^.left<>nil then  writeln('/');
gotoxy(Distance+CurLvelDiff,depth+1);
if Node^.right<>nil then  writeln('\');
DisplayTree(Distance-(2*CurLvelDiff+2) ,depth+2,Node^.left,CurLvelDiff-1);
DisplayTree(Distance+(2*CurLvelDiff+2),depth+2,Node^.right,CurLvelDiff-1);
end;
end;

procedure FreeTree(var Root:TreePtrType);
begin
if Root<>nil then
begin
FreeTree(Root^.Left);
FreeTree(Root^.right);
Dispose(Root);
end;
end;

Procedure InitTree(Var Root:TreePtrType);
Begin
FreeTree(Root);
Root := nil;
Writeln('The tree has been initialised.');
End;

Function TreeEmpty(Root:TreePtrType):boolean;
Begin
TreeEmpty := (root = nil)
End;

var BackRoot:TreePtrType;
Begin

If root = nil then
Begin
Root := newnode;
Root^.left := nil;
Root^.right := nil;

End
Else if newnode^.key < root^.key then
End;}

var BackRoot:TreePtrType;
Begin

If root = nil then
Begin
Root := newnode;
Root^.left := nil;
Root^.right := nil;
End
Else
begin
if newnode^.key < root^.key then
begin
if (root^.left<>nil) and (root^.Right=nil) then
begin
BackRoot:=root;
Root:=root^.left;
BackRoot^.left:=nil;
Root^.right:=BackRoot;
end;
end
Else
begin
if (root^.Right<>nil) and (root^.left=nil) then
begin
BackRoot:=root;
Root:=root^.right;
BackRoot^.Right:=nil;
Root^.Left:=BackRoot;
end;
end;
end;
End;

Procedure SearchTree(Root:TreePtrType; Target:word;
Var Position:Ptr; Var Depth:word; Var Result:string);
var s:string;
Begin
If root = nil then
Position := nil
Else
Begin
str(root^.key,s);
Depth := Depth+1;
If root^.key = target then
begin
Result:=Result+ s;
Position := root
end
Else if target < root^.key then
begin
Result:=Result+ s+' <- ';
SearchTree(root^.left,target,position,depth,Result);
end
Else
begin
Result:=Result+ s+' -> ';
SearchTree(root^.right,target,position,depth,Result);
end;
End;
End;

Procedure DeleteTree(var Root:TreePtrType; Target:word);
var DelRoot:TreePtrType;
Begin
if (root <> nil) then
begin
If root^.key = target then
begin
DelRoot:=root;
Root:=root^.left;
Dispose(DelRoot);
end
Else if target < root^.key then DeleteTree(root^.left,target)
Else DeleteTree(root^.right,target);
End;
End;

Procedure PreOrder(Root:TreePtrType);
Begin
If root <> nil then
Begin
Writeln(Root^.key);
PreOrder(Root^.left);
PreOrder(Root^.right);
End;
End;

Procedure PostOrder(Root:TreePtrType);
Begin
If root <> nil then
Begin
PostOrder(Root^.left);
PostOrder(Root^.right);
Writeln(Root^.key);
End;
End;

Procedure InOrder(Root:TreePtrType);
Begin
If root <> nil then
Begin
InOrder(Root^.left);
Writeln(Root^.key);
InOrder(Root^.right);
End;
End;

Procedure Screen(Var Choice:integer);
Begin
clrscr;
Writeln(' ');
Writeln('1.     Initialise a tree');
Writeln('2.     Add an item to a tree <a positive integer>');
Writeln('3.     Search for an item in the tree');
Writeln('4.     Preorder printout of tree');
Writeln('5.     Postorder printout of tree');
Writeln('6.     Inorder printout of tree');
Writeln('7.     Display Tree');
Writeln('8.     Delete Tree');
Writeln('9.     Quit');
Writeln;
Writeln;
If (Choice < 1) or (Choice > 9) then
Begin
Writeln('Only options 1 to 9 are available.');
End;
End;

procedure OPenFile(FileName:String);
var
f: file of char;
Ch:Char;
S:string;
key,Code:word;
begin
InitTree(rootptr);
Assign(f,FileName );
Reset(f);
while not Eof(F) do
begin
if ch in['0'..'9','.'] then S:=s+ch
else
begin
if S<>'' then
begin
val(s,Key,Code);
if Code=0 then
begin
New(nextnode);
nextnode^.Key:=key;
end;
S:='';
end;
end
end;
Close(f);
end;

begin

{if ParamCount >0 then }OPenFile('C:\X.txt');
Repeat
Screen(select);
Case select of
1 : InitTree(rootptr);
2 : Begin
Writeln('Enter ',exitpro:1,' to stop.');
Write('Enter next data value or ',exitpro:1,' to stop.');
While NewElement <> exitpro do
begin
New(nextnode);
nextnode^.Key:=NewElement;
Write('Enter next data value or ',exitpro:1,' to stop.');
end;
End;
3 :begin
Write('Enter the number to be search:  ');
result:='';
positionptr:=nil;
SearchTree(rootptr,targettype,positionptr,depthtype,result);

str(targettype,S);

if positionptr<>nil then
begin
Writeln('Find the number ('+S+') ');
Writeln('Path = '+Result);
end
else Write('Can''t Find the number ('+S+') ');
end;
4 : Preorder(rootptr);
5 : Postorder(rootptr);
6 : Inorder(rootptr);
7 :begin
clrscr;
displaytree(40,1,rootptr,2);
end;
8 :begin

Write('Enter the data to be delete.');
DeleteTree(rootptr, NewElement);
Write('Data deleted.');
end;
End;
Until select = 9;
end.
0

LVL 3

Author Comment

Thanks dinilud,

One question, though.
0

LVL 10

Expert Comment

No problem.
this points is enough for me
0

Featured Post

Suggested Solutions

Pascal code for reading registry 1 344
Delphi 2007 printer setup problem 8 740
Delphi 2010 auto upgrade has "lost" a file 7 1,029
This is an issue that we can get adding / removing permissions in the vCSA 6.0. We can also have issues searching for users / groups in the AD (using your identify sources). This is how one of the ways to handle this issues and fix it.
Basic understanding on "OO- Object Orientation" is needed for designing a logical solution to solve a problem. Basic OOAD is a prerequisite for a coder to ensure that they follow the basic design of OO. This would help developers to understand the b…
It is a freely distributed piece of software for such tasks as photo retouching, image composition and image authoring. It works on many operating systems, in many languages.
This video discusses moving either the default database or any database to a new volume.