• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 6860
  • Last Modified:

Binary search tree using Pascal

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;


Procedure AddToTree(Var Root:TreePtrType; NewNode:TreePtrType);
Begin
     If root = nil then
     Begin
          Root := newnode;
          Root^.left := nil;
          Root^.right := nil;
     End
     Else if newnode^.key < root^.key then
             AddToTree(root^.left,newnode)
          Else
              AddToTree(root^.right,newnode);
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;
     Write('Please enter your choice: ');
     Readln(choice);
     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.');
                    Readln(newnodeptr.key);
                    While nextnode <> exitpro do
                    AddToTree(rootptr,nextnode);


                    End;
                3 : SearchTree(rootptr,targettype,positionptr,depthtype);
                4 : Preorder(rootptr);
                5 : Postorder(rootptr);
                6 : Inorder(rootptr);
           End;
     Until select = 7;
End.
==================================================================================
thanks
0
cipher007
Asked:
cipher007
1 Solution
 
diniludCommented:
is your code is working?
0
 
ozoCommented:
reset(input,'text.file ');
0
 
My name is MudCommented:
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 }
Procedure AddItem (Newvalue: Integer);
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
New feature and membership benefit!

New feature! Upgrade and increase expert visibility of your issues with Priority Questions.

 
cipher007Author Commented:
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
 
diniludCommented:
Shall i try in delphi. i don't know Turbo Pascal
0
 
diniludCommented:
What is the Text file format?

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

Thanks for trying
0
 
diniludCommented:
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;

{Procedure AddToTree(Var Root:TreePtrType; NewNode:TreePtrType);
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
             AddToTree(root^.left,newnode)
        Else AddToTree(root^.right,newnode);
End;}

Procedure AddToTree(Var Root:TreePtrType; NewNode:TreePtrType);
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;
          AddToTree(root^.left,newnode);
        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;
          AddToTree(root^.right,newnode);
        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;
             if DelRoot^.Right<>nil then AddToTree(Root,DelRoot^.Right);
             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;
     Write('Please enter your choice: ');
     Readln(choice);
     Writeln;
     If (Choice < 1) or (Choice > 9) then
     Begin
        Writeln('Only options 1 to 9 are available.');
        ReadLn(S);
     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
     Read(F, ch);
     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;
           AddToTree(rootptr,nextnode);
         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.');
                      Readln(NewElement);
                      While NewElement <> exitpro do
                      begin
                        New(nextnode);
                        nextnode^.Key:=NewElement;
                        AddToTree(rootptr,nextnode);
                        Write('Enter next data value or ',exitpro:1,' to stop.');
                        Readln(NewElement);
                      end;
                    End;
                3 :begin
                    Write('Enter the number to be search:  ');
                    Readln(targettype);
                     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);
                     readln
                   end;
                8 :begin
                       
                        Write('Enter the data to be delete.');
                        Readln(NewElement);
                        DeleteTree(rootptr, NewElement);
                        Write('Data deleted.');
                        readln
                   end;
           End;
     Until select = 9;
end.
0
 
cipher007Author Commented:
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
 
diniludCommented:
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;

{Procedure AddToTree(Var Root:TreePtrType; NewNode:TreePtrType);
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
             AddToTree(root^.left,newnode)
        Else AddToTree(root^.right,newnode);
End;}

Procedure AddToTree(Var Root:TreePtrType; NewNode:TreePtrType);
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;
          AddToTree(root^.left,newnode);
        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;
          AddToTree(root^.right,newnode);
        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;
             if DelRoot^.Right<>nil then AddToTree(Root,DelRoot^.Right);
             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;
     Write('Please enter your choice: ');
     Readln(choice);
     Writeln;
     If (Choice < 1) or (Choice > 9) then
     Begin
        Writeln('Only options 1 to 9 are available.');
        ReadLn(S);
     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
     Read(F, ch);
     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;
           AddToTree(rootptr,nextnode);
         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.');
                      Readln(NewElement);
                      While NewElement <> exitpro do
                      begin
                        New(nextnode);
                        nextnode^.Key:=NewElement;
                        AddToTree(rootptr,nextnode);
                        Write('Enter next data value or ',exitpro:1,' to stop.');
                        Readln(NewElement);
                      end;
                    End;
                3 :begin
                    Write('Enter the number to be search:  ');
                    Readln(targettype);
                     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+') ');
                     readln;
                   end;
                4 : Preorder(rootptr);
                5 : Postorder(rootptr);
                6 : Inorder(rootptr);
                7 :begin
                     clrscr;
                     displaytree(40,1,rootptr,2);
                     readln
                   end;
                8 :begin
                       
                        Write('Enter the data to be delete.');
                        Readln(NewElement);
                        DeleteTree(rootptr, NewElement);
                        Write('Data deleted.');
                        readln
                   end;
           End;
     Until select = 9;
end.
0
 
cipher007Author Commented:
Thanks dinilud,

One question, though.
When accepting the answer how do I give you additional points.
0
 
diniludCommented:
No problem.
this points is enough for me
0

Featured Post

Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now