Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/PASCALA.ZIP/ASSIGN8.PAS

Pascal/Delphi Source File | 1991-05-06 | 6.1 KB | 209 lines

(******************************************************)
(* Alejo Alamillo          COSC 055                   *)
(* SPRING 1991            04/27/91              *)
(*     ASSIGNMENT # 8                                *)
(******************************************************)


(*************************************************************)
(*  Several procedures for binary tree processing are        *)
(*  contained in the module below.                           *)
(*  This is NOT a complete module ready to link up with a    *)
(*  driver program.        PRB 10/90                         *)
(*************************************************************)

PROGRAM TreeMod(Input,Output);

  TYPE  DataType = Integer;
        NodePointer = ^NodeRec;
        NodeRec= RECORD
                   Data: DataType;
                   Level: 0..Maxint;
                   Back,
                   LeftLink,
                   RightLink: NodePointer;
                 END;

  VAR   Root,Current: NodePointer;
        Seed: Integer;
        DataIn,Val: DataType;

(***************************************************)
(*  Generates a random number ( 0 <= R < 1 )       *)
(*  Seed must be initialized ONCE before using     *)
(***************************************************)

FUNCTION Random(VAR Seed: Integer): Real;
  CONST Modulus = 65536;
        Multiplier = 25173;
        Increment = 13849;

  BEGIN
  Seed:=((Multiplier*Seed) + Increment) MOD Modulus;
  Random:= Seed/Modulus;
  END;
(***************************************************)
(* Disposes of the nodes of an existing, unneeded  *)
(* Tree.  Recursively called in postorder.        *)
(***************************************************)

PROCEDURE DisposeTree(VAR CurrentNode:NodePointer);

BEGIN
WITH CurrentNode^ DO
  BEGIN
  IF LeftLink<> nil THEN
    DisposeTree(LeftLink);
  IF RightLInk<> nil THEN
    DisposeTree(RightLink);
{  Dispose(CurrentNode);}
  END;
END;
(***************************************************)
(*  Recursively searches for node to insert DataIn *)
(*  Inserts data DataIn into a tree in order       *)
(***************************************************)
PROCEDURE AddaNode(VAR Current: NodePointer;
                           DataIn: DataType;
                             CurrentLevel: Integer);
BEGIN
IF Current = nil THEN     (* Place is found *)
  BEGIN
  New(Current);
  Current^.Data:= DataIn;
  Current^.Level:= CurrentLevel;
  Current^.LeftLink:= nil;
  Current^.RightLink:= nil;
  END
ELSE                    (* Search farther *)
  IF (DataIn < Current^.Data) THEN
    AddaNode(Current^.LeftLink, DataIn, CurrentLevel+1)
  ELSE
    AddaNode(Current^.RightLink, DataIn,CurrentLevel+1); (* Duplicate keys   *)
END;                                                     (* are inserted in  *)
                                                         (* original order   *)
Procedure Changelevel(var Current:nodepointer);

 var left,right : nodepointer;

 Begin
  IF current^.leftlink <> Nil then
   Left := current^.leftlink;
   Left^.level := current^.level + 1;
   changelevel(left);
  IF current^.rightlink <> Nil then
    Right := Current^.rightlink;
    right^.level := current^.level + 1;
    changelevel(right);
  End;


(*********************************************************)
(* Deletes an entered node from the tree and reconnects  *)
(* the other nodes if the number is not on the tree      *)
(* error is printed. The new or old tree is then shown   *)
(*********************************************************)

PROCEDURE DisposeNode(VAR Current: NodePointer;
                      Val    : DataType);
VAR
  Back,Temp:NodePointer;
  Found    :Boolean;
BEGIN
Current := Root;
Found := False;
WHILE (Current <> NIL) AND NOT(Found) Do
  IF Current^.Data = Val THEN
    Found := True
  ELSE
    IF Current^.Data > Val THEN
      Current := Current^.LeftLink
    ELSE
      Current := Current^.RightLink;
IF Found THEN
  BEGIN
  Temp := Current;
  IF Current^.RightLink = NIL THEN
    Current := Current^.LeftLink
  ELSE
    IF Current^.LeftLink = NIL THEN
      Current := Current^.RightLink
    ELSE
      BEGIN
      Temp := Current^.LeftLink;
      Back := Current;
      WHILE Temp^.RightLink <> NIL DO
        BEGIN
        Back := Temp;
        Temp := Temp^.RightLink;
        END;
      Current^.Data := Temp^.Data;
      IF Back = Current THEN
        Back^.LeftLink := Temp^.LeftLink
      ELSE
        Back^.RightLink := Temp^.LeftLink
    END;
    Dispose(Temp);
  END
ELSE
  Writeln('The value was not found.');

END;

 (**************************************)
 (* Sets up tree                       *)
 (**************************************)
  PROCEDURE FormTree(VAR Root:NodePointer);
    CONST NumberofNodes = 25;
    VAR I: Integer;
        DataIn: DataType;
  (*************************************)
  (*  Currently randomly generated     *)
  (*************************************)
  PROCEDURE GetData(VAR DataIn: DataType);
    BEGIN
    DataIn:=Trunc(100*Random(Seed)+1);
    Write(dataIn:3);
    END;

BEGIN (* FormTree *)
Root:= nil;
FOR I:= 1 TO NumberofNodes DO
  BEGIN
  GetData(DataIn);
  AddaNode(Root, DataIn, 0);
  END;
END;
(**********************************************)
(*  ShowTree   Recursively displays a tree    *)
(*             in L-R order.                  *)
(**********************************************)
PROCEDURE ShowTree(CurrentNode: NodePointer);

BEGIN
WITH CurrentNode^ DO
  BEGIN                     (* Reversed for rotated display *)
  IF RightLink<> nil THEN
    ShowTree(RightLink);
  Writeln('   ',Data:3*(1+Level));
  IF LeftLink<>nil THEN
    ShowTree(LeftLink);
  END;
END;

BEGIN   (*************  MAIN *************)
  (* Initialize *)
  (* Describe *)
  Write('Enter seed for the Random function: ');
  Readln(Seed);  Writeln;

  FormTree(Root);
  Writeln;  Writeln;  Writeln;
  ShowTree(Root);
  Write('Enter a number you wish to delete: ');
  readln(Val);
  DisposeNode(Current,Val);
  showtree(root);
  DisposeTree(Root);
END.