-- ======================================================================-- Package: Adjacency_List_Pack.ada -- by: George North -- Fall 1994
-- Problem: Provide a generic adjacency list file structrue representing -- (directed) graphs ... this package supports bredth-first -- search (BFS).
-- ======================================================================
generic type Element_Type is private; type Key_Type is private; with function Key_of ( E : Element_Type ) return Key_Type; with procedure Put_Element( E : in Element_Type );
Max_Size : Natural;
package Adjacency_List is
type Graph_Type is private; subtype V_Index_Range is natural range 1 .. Max_Size; type Vertex_Arr_Type is array ( V_Index_Range range <> ) of Element_Type; type Edge_Arr_Type is array ( 1..3 * Max_Size, 1..2 ) of Key_Type; type Index_Set is array ( V_Index_Range ) of V_Index_Range;
-- ======================================================================
Graph_Empty : exception; Graph_Full : exception; Duplicate_Node : exception; Duplicate_Edge : exception; Missing_Vertex : exception; Missing_Element : exception; Missing_Edge : exception; Item_Not_Found : exception;
-- ======================================================================
-- Procedure : Build_Graph, make empty graph, fill with supplied -- vertex(s) and Edge(s) input arrays. -- Precondition: exists array of vertex(s) and of Edge(s) -- Postcondition: valid adjacency list graph
procedure Build_Graph( V_List : in Vertex_Arr_Type; E_List : in Edge_Arr_Type; N_of_Edges : in Natural; Graph : in out Graph_Type ); -- ======================================================================
-- Function : V_Index, find vertex of an element -- Precondition: valid element -- Postcondition: return the index of a vertex for the element E. -- Missing_Element is raised if no vertex holds -- the same Key.
function V_Index( Key : Key_Type; Graph : Graph_Type ) return V_Index_Range;
-- ======================================================================
-- Function : V_Content, find an element for given vertex -- Precondition: valid Index -- Postcondition: return the element E for given vertex (Index). -- Missing_Vertex is raised if no vertex holds Key.
function V_Content( Index : V_Index_Range; Graph : Graph_Type ) return Element_Type;
-- ======================================================================
-- Procedure : Insert_Vertex, insert new node into Graph -- Precondition: valid Graph, valid Element to insert -- Postcondition: new element added to Graph, or -- Duplicate_Node is raised if E is duplicate key
procedure Insert_Vertex(Graph : in out Graph_Type; Element : in Element_Type );
-- ======================================================================
-- Procedure : Insert_Edge, add new edge to Graph -- Precondition: valid Graph, two valid Keys -- Postcondition: new edge that contains the key values given -- Missing_Vertex is raised if either Key1 or Key2 is -- not in an existing vertex. -- Duplicate_Edge is raised if there is an edge -- connecting two vertices that hold Key1 and Key2 -- respectively.
procedure Insert_Edge( Graph : in out Graph_Type; Key1 : in Key_Type; Key2 : in Key_Type );
-- ======================================================================
-- Procedure : Delete_Vertex, delete node from Graph -- Precondition: valid Graph, valid Key to delete -- Postcondition: delete node with Key value -- Missing_Vertex is raised if no vertex holds Key
procedure Delete_Vertex( Graph : in out Graph_Type; Key : in Key_Type );
-- ======================================================================
-- Procedure : Delete_Edge, delete edge from Graph -- Precondition: valid Graph, two valid Keys -- Postcondition: edge that contains the key values given is deleted -- Missing_Edge is raised if there is no edge that -- connects the nodes with key values given.
procedure Delete_Edge( Graph : in out Graph_Type; Key1 : in Key_Type; Key2 : in Key_Type );
-- ======================================================================
-- Function : Find_Node, find node for given key value -- Precondition: valid Graph, valid Key -- Postcondition: TRUE if node exists, otherwise FALSE
function Find_Node( Graph : Graph_Type; Target_Key : Key_Type) return boolean;
-- ======================================================================
-- Function : Find_Edge, find edge for given key values -- Precondition: valid Graph, valid Key -- Postcondition: TRUE if edge exists, otherwise FALSE
function Find_Edge( Graph : Graph_Type; Key1 : Key_Type; Key2 : Key_Type ) return boolean; -- ======================================================================
-- Function : Number_of_Nodes, calculate number of nodes -- Precondition: valid Graph -- Postcondition: number of nodes in a graph
function Number_of_Nodes( Graph : Graph_Type ) return natural; -- ======================================================================
-- Function : Number_of_Edges, calculate number of edges -- Precondition: valid Graph -- Postcondition: number of edges in a graph
function Number_of_Edges( Graph : Graph_Type) return natural;
-- ======================================================================
-- Procedure : Print_All, print report showing contents of -- Adjacency list ... -- Precondition: valid Graph -- Postcondition: none procedure Print_All( Graph : in Graph_Type );
-- ======================================================================
-- Procedure : BFS_Search, preform a breath first search on -- Adjacency list ... -- Precondition: valid Graph -- Postcondition: array of indexes ...
procedure BFS_Search( Start_V : in V_Index_Range; Graph : in Graph_Type; N_of_Visits : out Natural; Visited_V : out Index_Set );
-- ======================================================================
private -- subtype Index_Type is Integer range 1 .. Max_Size;
-- Singly Linked List type Neighbor_Node; type Next_Neighbor is access Neighbor_Node; type Neighbor_Node is record Index : V_Index_Range; Next : Next_Neighbor; end record;
-- Record defination for Graph.List, -- Contents is of private type -- Deleted is used for lasy delete -- Visited is used to mark records during BFS processing -- Neighbors is pointer to linked list of Edges type Vertex_Type is record Contents : Element_Type; Deleted : boolean := false; Visited : boolean := false; Neighbors : Next_Neighbor; end record;
-- Record defination for Graph (as an unconstraned array) -- Size is the number of Vertex(s) members of Graph -- List is a record defined above type Vertex_List_Type is array (Positive range <>) of Vertex_Type; type Graph_Type is record Size : natural := 0; List : Vertex_List_Type(V_Index_Range); end record;
end Adjacency_List;
-- ====================================================================== -- ======================================================================
-- ====================================================================== -- ======================================================================
with Queue; with Stack_List; with Text_IO; use Text_IO; with My_Int_IO; use My_Int_IO; with Unchecked_Deallocation;
-- ======================================================================
-- Package Body: Adjacency_List_Pack ...
package body Adjacency_List is
procedure Dispose is new Unchecked_Deallocation( Neighbor_Node, Next_Neighbor );
-- ====================================================================== -- ======================================================================
-- the following procedures are to support linked list ...
-- ======================================================================
function Find_Previous(X: V_Index_Range; H: Next_Neighbor) return Next_Neighbor is
P: Next_Neighbor := H;
begin while P.Next.Index /=X loop -- Inveriant: loop terminates when 1) Index X is located or -- 2) advanced past end of list, exception is raised P := P.Next; end loop; -- Asseration: pointer to X is returned or exception raised return P; exception when Constraint_Error => raise Item_Not_Found; end Find_Previous;
-- ======================================================================
function In_List(X : V_Index_Range; H : Next_Neighbor) return boolean is
P: Next_Neighbor := H;
begin while P /= null and then P.Index /= X loop -- Inveriant: P is pointer to node in list, loop terminated when -- P equals null (last node in list), or when X equals P.Index P := P.Next; end loop; -- Asseration: TRUE if X exists in list, or False is not found return P /= null; end In_List;
-- ======================================================================
procedure Delete( X : in V_Index_Range; H : in out Next_Neighbor ) is
Prev_Cell : Next_Neighbor; Del_Cell : Next_Neighbor;
begin if H.Index = X then Del_Cell := H; H := H.Next; else Prev_Cell := Find_Previous( X, H ); Del_Cell := Prev_Cell.Next; Prev_Cell.Next := Del_Cell.Next; end if; Dispose( Del_Cell ); end Delete;
-- ======================================================================
procedure Insert( X : in V_Index_Range; H: in out Next_Neighbor ) is
begin H := new Neighbor_Node'( X, H ); end Insert;
-- ======================================================================
-- end of Linked List procedures
-- ====================================================================== -- ======================================================================
-- ====================================================================== -- ======================================================================
-- begin procedures for Adjacency List Package
-- ======================================================================
-- Procedure : Build_Graph, make empty graph, fill with supplied -- vertex(s) and Edge(s) input arrays. -- Precondition: exists array of vertex(s) and of Edge(s) -- Postcondition: valid adjacency list graph
procedure Build_Graph( V_List : in Vertex_Arr_Type; E_List : in Edge_Arr_Type; N_of_Edges : in Natural; Graph : in out Graph_Type ) is begin -- Build_Graph -- make an empty graph Graph.Size := 0; -- insert vertex(s) for I in V_List'First .. V_List'Last loop Insert_Vertex( Graph, V_List( I ) ); end loop; -- insert edge(s) for I in 1 .. N_of_Edges loop Insert_Edge( Graph, E_List( I, 1 ), E_List( I, 2 ) ); end loop; end Build_Graph; -- ======================================================================
-- Function : V_Index, find vertex of an element -- Precondition: valid element -- Postcondition: return the index of a vertex for the element E. -- Missing_Element is raised if no vertex holds -- the same Key.
function V_Index( Key : Key_Type; Graph : Graph_Type ) return V_Index_Range is begin -- V_Index -- look thruogh all the Vertex(s) for I in 1 .. Graph.Size loop -- return the index for matching Key, else raise exception if not Graph.List( I ).Deleted and Key_of( Graph.List( I ).Contents ) = Key then return V_Index_Range( I ); end if; end loop; raise Missing_Element; end V_Index;
-- ======================================================================
-- Function : V_Content, find an element for given vertex -- Precondition: valid Index -- Postcondition: return the element E for given vertex (Index). -- Missing_Vertex is raised if no vertex holds Key.
function V_Content( Index : V_Index_Range; Graph : Graph_Type ) return Element_Type is Elm : Element_Type; begin -- V_Content if Index > Graph.Size then raise Missing_Vertex; end if; return Graph.List( Index ).Contents; end V_Content;
-- ======================================================================
-- Procedure : Insert_Vertex, insert new node into Graph -- Precondition: valid Graph, valid Element to insert -- Postcondition: new element added to Graph, or -- Duplicate_Node is raised if E is duplicate key
procedure Insert_Vertex(Graph : in out Graph_Type; Element : in Element_Type ) is begin -- Insert_Vertex -- look through all the Vertex(s), raise exception if existed for I in 1 .. Graph.Size loop if not Graph.List( I ).Deleted and Key_of( Graph.List( I ).Contents ) = Key_of( Element ) then raise Duplicate_Node; end if; end loop; -- add a new Vertex, raise exception if graph is already full if Graph.Size < Max_Size then Graph.Size := Graph.Size + 1; Graph.List( Graph.Size ) := ( Element, false, false, null ); else raise Graph_Full; end if; end Insert_Vertex;
-- ======================================================================
-- Procedure : Insert_Edge, add new edge to Graph -- Precondition: valid Graph, two valid Keys -- Postcondition: new edge that contains the key values given -- Missing_Vertex is raised if either Key1 or Key2 is -- not in an existing vertex. -- Duplicate_Edge is raised if there is an edge -- connecting two vertices that hold Key1 and Key2 -- respectively.
procedure Insert_Edge( Graph : in out Graph_Type; Key1 : in Key_Type; Key2 : in Key_Type ) is
I_Key1 : V_Index_Range; I_Key2 : V_Index_Range; P : Next_Neighbor; begin -- Insert_Edge -- if both Vertex(s) exist, insert a new edge I_Key1 := V_Index( Key1, Graph ); I_Key2 := V_Index( Key2, Graph ); if In_List( I_Key2 , Graph.List( I_Key1 ).Neighbors ) then raise Duplicate_Edge; else Insert( I_Key2 , Graph.List( I_Key1 ).Neighbors ); end if; exception when Missing_Element => raise Missing_Vertex; end Insert_Edge;
-- ======================================================================
-- Procedure : Delete_Vertex, lazy delete node from Graph -- Precondition: valid Graph, valid Key to delete -- Postcondition: delete node with Key value -- Missing_Vertex is raised if no vertex holds Key
procedure Delete_Vertex( Graph : in out Graph_Type; Key : in Key_Type ) is
I_Key : V_Index_Range; toDelete : Next_Neighbor; P : Next_Neighbor; N_of_V : natural :=0; Visited : Index_Set; Key1 : Key_Type; begin -- Delete_Vertex -- remove all the edge(s) from List, mark vertex deleted I_Key := V_Index( Key, Graph ); P := Graph.List( I_Key ).Neighbors; Graph.List( I_Key ).Neighbors := null; while P /= null loop -- Inveriant: Each loop itteration removes head of list. -- Loop terminates when head of list is null toDelete := P; P := toDelete.Next; Dispose( toDelete ); end loop; -- Asseration: all nodes of list are deleted -- look through vertex(s), delete matched edges for I in 1 .. Graph.Size loop Key1 := Key_of( Graph.List( I ).Contents ); if In_List( I_Key, Graph.List( I ).Neighbors ) then Delete_Edge( Graph, Key1, Key ); end if; end loop; -- mark this vertex deleted ... lasy delete Graph.List( I_Key ).Deleted := true; exception when Missing_Element => raise Missing_Vertex; end Delete_Vertex;
-- ======================================================================
-- Procedure : Delete_Edge, delete edge from Graph -- Precondition: valid Graph, two valid Keys -- Postcondition: edge that contains the key values given is deleted -- Missing_Edge is raised if there is no edge that -- connects the nodes with key values given.
procedure Delete_Edge( Graph : in out Graph_Type; Key1 : in Key_Type; Key2 : in Key_Type )is I_Key1 : V_Index_Range; I_Key2 : V_Index_Range;
begin -- Delete_Edge -- if this edge exists, then delete it, else raise exception I_Key1 := V_Index( Key1, Graph ); I_Key2 := V_Index( Key2, Graph ); if In_List( I_Key2 , Graph.List( I_Key1 ).Neighbors ) then Delete( I_Key2 , Graph.List( I_Key1 ).Neighbors ); else raise Missing_Edge; end if; exception when Missing_Element => raise Missing_Edge; end Delete_Edge;
-- ======================================================================
-- Function : Find_Node, find node for given key value -- Precondition: valid Graph, valid Key -- Postcondition: TRUE if node exists, otherwise FALSE
function Find_Node( Graph : Graph_Type; Target_Key : Key_Type) return boolean is begin -- Find_Node -- look through all the Vertex(s), return true if Key exists for I in 1 .. Graph.Size loop if not Graph.List( I ).Deleted and Key_of( Graph.List( I ).Contents ) = Target_Key then return true ; end if; end loop; return false; end Find_Node;
-- ======================================================================
-- Function : Find_Edge, find edge for given key values -- Precondition: valid Graph, valid Key -- Postcondition: TRUE if edge exists, otherwise FALSE
function Find_Edge( Graph : Graph_Type; Key1 : Key_Type; Key2 : Key_Type ) return boolean is I_Key1 : V_Index_Range; I_Key2 : V_Index_Range; begin -- Find_Edge -- return true if this Vertex (Key1) has an existing edge (Key2) I_Key1 := V_Index( Key1, Graph ); I_Key2 := V_Index( Key2, Graph ); if Find_Node( Graph, Key1 ) and In_List( I_Key2 , Graph.List( I_Key2 ).Neighbors ) then return true; else return false; end if; exception when Missing_Element => return false; end Find_Edge; -- ======================================================================
-- Function : Number_of_Nodes, calculate number of nodes -- Precondition: valid Graph -- Postcondition: number of nodes in a graph
function Number_of_Nodes( Graph : Graph_Type ) return natural is
Count : natural := 0; begin -- Number_of_Nodes for I in 1 .. Graph.Size loop if not Graph.List( I ).Deleted then Count := Count + 1; end if; end loop; return Count; end Number_of_Nodes; -- ======================================================================
-- Function : Number_of_Edges, calculate number of edges -- Precondition: valid Graph -- Postcondition: number of edges in a graph
function Number_of_Edges( Graph : Graph_Type) return natural is
Count : natural := 0; P : Next_Neighbor; begin -- Number_of_Edges -- look through all the Vertex(s), count the edges for I in 1 .. Graph.Size loop if not Graph.List( I ).Deleted then P := Graph.List ( I ).Neighbors; while P /= null loop -- Inveriant: loop terminates when last node is reached P := P.Next; Count := Count + 1; end loop; -- Asseration: all members of list are eximaned end if; end loop; return Count; end Number_of_Edges;
-- ======================================================================
-- Procedure : Print_All, print report showing contents of -- Adjacency list ... -- Precondition: valid Graph -- Postcondition: none
procedure Print_All( Graph : in Graph_Type ) is P : Next_Neighbor; begin -- Print_All New_Line; put ("Print Graph ... "); New_Line ( 2 ); for I in 1 .. Graph.Size loop if not Graph.List ( I ).Deleted then P := Graph.List ( I ).Neighbors; Put_Element( Graph.List ( I ).Contents ); while P /= null loop -- Inveriant: loop terminates when last node is reached put( " ==> " ); Put_Element( Graph.List( P.Index ).Contents ); P := P.Next; end loop; -- Asseration: all members of list are printed New_Line; end if; end loop; end Print_All;
-- ======================================================================
-- Procedure : BFS_Search, preform a breath first search on -- Adjacency list ... -- Precondition: valid Graph -- Postcondition: array of indexes ...
procedure BFS_Search( Start_V : in V_Index_Range; Graph : in Graph_Type; N_of_Visits : out Natural; Visited_V : out Index_Set ) is
-- instantiate a queue package Queue_Pack is new Queue( Element_Type => V_Index_Range ); -- instanticate a stack package Stack_Pack is new Stack_List( Element_Type => V_Index_Range ); -- make one queue Queue : Queue_Pack.Queue( Max_Size ); -- make one stack Stack : Stack_Pack.Stack;
-- needed variables aGraph : Graph_Type := Graph; Index : V_Index_Range; Count : Natural := 0; P : Next_Neighbor; begin -- BFS_Search -- make empty Stack and Queue Queue_Pack.Make_Null( Queue ); Stack_Pack.Make_Null( Stack ); -- check if element is deleted if aGraph.List( Start_V ).Deleted then raise Missing_Vertex; end if; -- mark starting element visited, queue starting element index aGraph.List( Start_V ).Visited := true; Queue_Pack.Enqueue( Start_V, Queue ); while not Queue_Pack.Is_Empty( Queue ) loop -- Inveriant: Queue contains elements from Adjacency List. Each -- loop itteration marks an element as visited. No -- element will be visited more than once. Unvisited -- elements are queued for processing. Loop terminates -- when Queue is empty. -- get first element in queue Queue_Pack.Dequeue( Index, Queue ); -- process all vertexes for this Element P := aGraph.List( Index ).Neighbors; while P /= null loop -- Inveriant: loop terminates when last node is reached Index := P.Index; if not aGraph.List( Index ).Visited then -- mark element visited, queue element, pust into stack aGraph.List( Index ).Visited := true; Queue_Pack.Enqueue( Index, Queue ); Stack_Pack.Push( Index, Stack ); Count := Count + 1; end if; P := P.Next; end loop; -- Asseration: all members of list are queue'd end loop; -- Asseration: stack contains all elements related to start element N_of_Visits:= Count; while not Stack_Pack.Is_Empty( Stack ) loop -- Inveriant: each loop itteration pops top of Stack. Loop -- terminates when Stack is empty. Index := Stack_Pack.Top( Stack ); Stack_Pack.Pop( Stack ); Visited_V( Count ) := Index; Count := Count - 1; end loop; -- Asseration: Array Visited_V contains list of edges for -- start element. end BFS_Search;
-- ====================================================================== -- ======================================================================
end Adjacency_List;
-- Package: Stack_List
-- Problem: Provide a generic Stack ADT.
generic
type Element_Type is private;
package Stack_List is
type Stack is limited private;
-- ======================================================================
-- Procedure: Make_Null -- Precondition: none -- Postcondition: empty Stack
procedure Make_Null( S : in out Stack );
-- ======================================================================
-- Procedure: Push -- Precondition: valid Stack, valid element to add -- Postcondition: one new member on top of stack
procedure Push( X : in Element_Type; S : in out Stack );
-- ======================================================================
-- Procedure: Pop -- Precondition: valid Stack -- Postcondition: stack with top element removed
procedure Pop( S : in out Stack );
-- ======================================================================
-- Function: Top -- Precondition: valid Stack -- Postcondition: Element on top of Stack, or exception
function Top( S : Stack ) return Element_Type;
-- ======================================================================
-- Function: Is_Empty -- Precondition: valid Stack -- Postcondition: TRUE if empty, otherwise FALSE
function Is_Empty( S : Stack ) return Boolean;
-- ======================================================================
Overflow : exception; Underflow : exception;
-- ====================================================================== -- ======================================================================
-- Stack implementation is a linked list with no header
private type Node; type Stack is access Node; subtype Node_Ptr is Stack;
type Node is record Element : Element_Type; Next : Node_Ptr; end record;
end Stack_List;
-- ====================================================================== -- ======================================================================
with Unchecked_Deallocation;
package body Stack_List is
procedure Dispose is new Unchecked_Deallocation( Object => Node, Name => Stack );
-- ======================================================================
-- Procedure: Make_Null -- Precondition: none -- Postcondition: empty Stack
procedure Make_Null( S : in out Stack ) is begin -- Make_Null S := null; end Make_Null;
-- ======================================================================
-- Procedure: Push -- Precondition: valid Stack, valid element to add -- Postcondition: one new member on top of stack
procedure Push( X : in Element_Type; S : in out Stack ) is begin -- Push S := new Node'( X, S ); exception when Storage_Error => raise Overflow; end Push;
-- ======================================================================
-- Procedure: Pop -- Precondition: valid Stack -- Postcondition: stack with top element removed
procedure Pop( S : in out Stack ) is First_Cell : Node_Ptr; begin -- Pop if Is_Empty( S ) then raise Underflow; end if; First_Cell := S; S := S.Next; Dispose( First_Cell ); end Pop;
-- ======================================================================
-- Function: Top -- Precondition: valid Stack -- Postcondition: Element on top of Stack, or exception
function Top( S : Stack ) return Element_Type is begin -- Top if Is_Empty( S ) then raise Underflow; end if; return S.Element; end Top;
-- ======================================================================
-- Function: Is_Empty -- Precondition: valid Stack -- Postcondition: TRUE if empty, otherwise FALSE
function Is_Empty( S : Stack ) return Boolean is begin -- Is_Empty return S = null; end Is_Empty;
-- ======================================================================
end Stack_List;
-- Package: FIFO_Queue.ada -- by: George North -- Fall 1994
-- Problem: Provide a generic FIFO Queue.
generic
type Element_Type is private;
package Queue is
type Queue( Max_Elements : Positive ) is limited private;
-- ======================================================================
-- Procedure: Make_Null -- Precondition: none -- Postcondition: empty Queue procedure Make_Null( Q : out Queue );
-- ======================================================================
-- Procedure: Enqueue -- Precondition: valid Queue, valid element to add -- Postcondition: one new member on end of Queue procedure Enqueue( X : in Element_Type; Q : in out Queue );
-- ======================================================================
-- Procedure: Dequeue -- Precondition: valid Queue -- Postcondition: Queue with top element removed procedure Dequeue( X : out Element_Type; Q : in out Queue );
-- ======================================================================
-- Function: Is_Empty -- Precondition: valid Queue -- Postcondition: TRUE if empty, otherwise FALSE
function Is_Empty( Q : Queue ) return Boolean;
-- ======================================================================
-- Function: Is_Full -- Precondition: valid Queue -- Postcondition: TRUE if full, otherwise FALSE
function Is_Full( Q : Queue ) return Boolean;
-- ======================================================================
Overflow : exception; Underflow : exception;
-- ====================================================================== -- ======================================================================
-- Arrar implementation is a FIFO Queue with element range 1 to n
private type Array_of_Element_Type is array( Positive range <> ) of Element_Type; type Queue( Max_Elements : Positive ) is record Q_Front : natural := 1; Q_Rear : natural := 0; Q_Size : natural := 0; Q_Array : Array_of_Element_Type( 1 .. Max_Elements ); end record;
end Queue;
-- ====================================================================== -- ======================================================================
package body Queue is
-- ======================================================================
-- Procedure: Increment, move array pointer to next element -- Precondition: exists valid Queue -- Postcondition: index (I) points to next array element
procedure Increment( I : in out Integer; Q : in Queue) is begin -- Increment if I = Q.Q_Array'Last then I := Q.Q_Array'First; else I := I + 1; end if; end Increment; -- ======================================================================
procedure Make_Null( Q : out Queue ) is begin -- Make_Null Q.Q_Front := Q.Q_Array'First; Q.Q_Rear := Q.Q_Array'First - 1; Q.Q_Size := 0; end Make_Null;
-- ======================================================================
procedure Enqueue( X : in Element_Type; Q : in out Queue ) is begin -- Enqueue if Is_Full( Q ) then raise Overflow; end if;
Q.Q_Size := Q.Q_Size + 1; Increment( Q.Q_Rear, Q ); Q.Q_Array( Q.Q_Rear ) := X; end Enqueue;
-- ======================================================================
procedure Dequeue( X : out Element_Type; Q : in out Queue ) is begin -- Dequeue if Is_Empty( Q ) then raise Underflow; end if;
X := Q.Q_Array( Q.Q_Front ); Q.Q_Size := Q.Q_Size - 1; Increment( Q.Q_Front, Q ); end Dequeue;
-- ======================================================================
function Is_Full( Q : Queue ) return Boolean is begin -- Is_Full return Q.Q_Size = Q.Q_Array'Last; end Is_Full;
-- ======================================================================
function Is_Empty( Q : Queue ) return Boolean is begin -- Is_Empty return Q.Q_Size = 0; end Is_Empty;
-- ======================================================================
end Queue;
-- ======================================================================
-- Program: pre_Courses -- by George North -- Fall 1994
-- Problem: Provide help to students to find preCourses for given Course.
-- ======================================================================
procedure pre_Courses is
-- variable used to redirect console input (FOR TESTING ONLY) sampleData : Text_IO.File_Type;
-- ======================================================================
-- define a record for Course information
subtype Hours_Type is natural range 0 .. 32; Name_Type_Max : constant integer := 8; Empty_Name : constant string(1 .. 8) := " "; subtype Course_Name_Type is string( 1 .. Name_Type_Max ); type Course_Record is record Name : Course_Name_Type; Hours : Hours_Type; end record; -- ====================================================================== -- instantiate an Adjacency List ADT from generic
Max_Courses : constant natural := 100; Course_Hours : Hours_Type; function Course_Key( aCourse : Course_Record) return Course_Name_Type; procedure Put_aCourse( aCourse : in Course_Record ); package Course_Adjacency_List_ADT is new Adjacency_List( Element_Type => Course_Record, Key_Type => Course_Name_Type, Key_of => Course_Key, Put_Element => Put_aCourse, Max_Size => Max_Courses );
use Course_Adjacency_List_ADT; -- ======================================================================
-- variables and constants
myCourse_List : Graph_Type; Beginning_of_Graph_Mark : constant character := '['; End_of_Graph_Mark : constant character := ']'; Beginning_of_Pair_Mark : constant character := '('; End_of_Pair_Mark : constant character := ')'; -- ======================================================================
-- make a needed array type
subtype Course_Array_Range is natural range 1.. Max_Courses;
-- ======================================================================
-- needed exceptions No_Valid_Input : exception; Not_a_Course_Name : exception; Invalid_Input_File : exception; End_of_Graph_Input : exception;
-- ====================================================================== -- ======================================================================
-- Procedure: Put_aCourse -- Precondition: a valid Course record -- Postcondition: none procedure Put_aCourse( aCourse : in Course_Record ) is begin -- Put_aCourse put( aCourse.Name ); -- put( "-(" ); -- put( aCourse.Hours,1 ); -- put( " hrs.)" ); end Put_aCourse; -- ======================================================================
-- Function : Course_Key -- Precondition : valid CPU_Job Records -- Postcondition : boolean, true if greater than
function Course_Key( aCourse : Course_Record ) return Course_Name_Type is begin -- Course_Key return aCourse.Name; end Course_Key;
-- ======================================================================
-- Procedure : Get_Next_Valid_Chr -- Precondition : none -- Postcondition : one Valid character
procedure Get_Next_Valid_Chr( aChr : out character ) is Chr : character := '*'; begin -- Get_Next_Valid_Chr loop -- Inveriant: Each loop iteration gets one (1) character, loop -- terminates when that character is letter or number if ( Chr >= 'a' and Chr <= 'z' ) or ( Chr >= 'A' and Chr <= 'Z' ) or ( Chr >= '0' and Chr <= '9' ) then exit; end if; get( Chr ); put( Chr ); if Chr = End_of_Graph_Mark then raise End_of_Graph_Input; end if; if End_of_Line then Skip_Line; New_Line; end if; end loop; -- Asseration: Input file is positioned at the first character of -- the next (posible) valid input string. aChr := Chr; end Get_Next_Valid_Chr; -- ======================================================================
-- Procedure : Get_a_Course, input a Course Name -- Precondition : none -- Postcondition : one Valid Course Name or an exception raised
procedure Get_a_Course( aCourse_Name : out Course_Name_Type; Close : out boolean; EoL : out boolean ) is Course_Name : string(1 .. 8) := " "; aChr : character; I : natural :=1; begin -- Get_a_Course -- read past any leading blanks Get_Next_Valid_Chr( aChr ); Course_Name( I ) := aChr; while not End_of_Line loop -- Invariant : Loop terminates at input file end of line or when -- a input character is space or sentinal. get( aChr ); put( aChr ); if aChr = ' ' or aChr = Beginning_of_Graph_Mark or aChr = End_of_Graph_Mark or aChr = Beginning_of_Pair_Mark or aChr = End_of_Pair_Mark then exit; end if; I := I + 1; if I <= Name_Type_Max then Course_Name( I ) := aChr; end if; end loop; -- Asseration: Corse_Name contails 1 valid input string not more -- than Name_Type_Max in length. if End_of_Line then Skip_Line; New_Line; EoL := true; else EoL := false; end if; if aChr = End_of_Graph_Mark then raise End_of_Graph_Input; end if; if I > Name_Type_Max then raise Not_a_Course_Name; end if; if aChr = End_of_Pair_Mark then Close := True; else Close := False; end if; aCourse_Name := Course_Name_Type( Course_Name ); end Get_a_Course;
-- ======================================================================
-- Procedure : Build_a_List, process Course input, build arrays -- Precondition : valid courses and course pairs -- Postcondition : valid Course adjacnecy list
procedure Build_a_List( C_L : out Graph_Type ) is Course_Array : Vertex_Arr_Type( Course_Array_Range ); aChr : character; N_of_Courses : natural; N_of_Pairs : natural; Prerequisite_Array : Edge_Arr_Type; Course_List : Graph_Type;
procedure Get_Courses( C_A : out Vertex_Arr_Type; N_of_C : out natural ) is Course_Hours : Hours_Type; Course_Name : Course_Name_Type; aCourse : Course_Record; aCourse_Array : Vertex_Arr_Type( Course_Array_Range ); I : natural := 0; Close : boolean; EoL : boolean; begin -- Get_Courses loop -- Invariant: input data file is read until End_of_Graph_Input -- character (']') is reached, at which time loop -- terminates. Loop will also terminate on reaching -- End_of_File. begin Get_a_Course( Course_Name, Close, EoL ); get( Course_Hours); put( Course_Hours,1 ); I := I + 1; aCourse.Name := Course_Name; aCourse.Hours := Course_Hours; aCourse_Array( I ) := aCourse; if End_of_Line then -- Skip_Line; New_Line; end if; exception when Data_Error => put( "Not a valid integer, input skiped" ); when Not_a_Course_Name => put( "Not a valid Course name, input skiped." ); when End_Error => null; when End_of_Graph_Input => exit; end; end loop; -- asseration: input file is processed until end of graph mark -- is sensed. An array of Course elements is -- returned to calling procedure. Skip_Line; New_Line; C_A := aCourse_Array; N_of_C := I; end Get_Courses; procedure Get_Prerequisits( P_A : out Edge_Arr_Type; N_of_P : out natural ) is Course_Name1 : Course_Name_Type; Course_Name2 : Course_Name_Type; I : natural := 0; PreCourses_Array : Edge_Arr_Type; Close : boolean; EoL : boolean; procedure Get_a_Pair_Mark( aPair_Mark : in character ) is begin -- Get_a_Pair_Mark loop -- Inveriant: process input file. Terminate loop when a -- pair mark { '(' or ')' } is read. Loop -- also terminates if end of file is reached. -- Loop also terminates if not blank -- characters are read when looking for end of -- pair mark. get( aChr ); put( aChr ); if aChr = End_of_Graph_Mark then raise End_of_Graph_Input; end if; if aChr = aPair_Mark then exit; end if; if aPair_Mark = End_of_Pair_Mark and aChr /= ' ' then raise Not_a_Course_Name; end if; if End_of_Line then Skip_Line; New_Line; end if; end loop; -- Asseration: Input file is positioned to character after -- a pair mark { '(' or ')' }. end Get_a_Pair_Mark; begin -- Get_Prerequisits loop -- Invariant: input data file is read until -- End_of_Graph_Input character (']') is reached, -- at which time loop terminates. Loop will also -- terminate on reaching End_of_File. begin Get_a_Pair_Mark( Beginning_of_Pair_Mark ); Get_a_Course( Course_Name1, Close, EoL ); Get_a_Course( Course_Name2, Close, EoL ); if not Close then Get_a_Pair_Mark( End_of_Pair_Mark ); end if; I := I + 1; PreCourses_Array( I, 1 ) := Course_Name1; PreCourses_Array( I, 2 ) := Course_Name2; if End_of_Line then -- Skip_Line; New_Line; end if; exception when Not_a_Course_Name => put( "Not a valid Course name, input skiped." ); when End_Error => null; when End_of_Graph_Input => exit; end; end loop; -- asseration: input file is processed until end of graph -- mark is sensed. An array of Course elements -- is returned to calling procedure. Skip_Line; New_Line; P_A := PreCourses_Array; N_of_P := I; end Get_Prerequisits; procedure Get_Beginning_of_Graph_Mark is begin -- Get_Beginning_of_Graph_Mark loop -- Inveriant: Loop terminated when sentenal is read get( aChr ); put( aChr ); if aChr = Beginning_of_Graph_Mark then exit; end if; end loop; -- Asseration: Input file is positoned on sentenal Skip_Line; New_Line; end Get_Beginning_of_Graph_Mark; begin -- Build_a_List Get_Beginning_of_Graph_Mark; Get_Courses( Course_Array, N_of_Courses ); Get_Beginning_of_Graph_Mark; Get_Prerequisits( Prerequisite_Array, N_of_Pairs ); Build_Graph( V_List => Course_Array( 1 .. N_of_Courses ), E_List => Prerequisite_Array, N_of_Edges => N_of_Pairs, Graph => Course_List ); C_L := Course_List; exception when End_Error => put ( "Unable to locate valid input to build Course List" ); New_Line; raise Invalid_Input_File; when others => put ("Unabe to build graph, duplicate edge or vertex problem."); New_Line; put ( "Course Array ... " ); New_Line; for I in 1 .. N_of_Courses loop put ( Course_Array( I ).Name ); New_Line; end loop; New_Line; put ( "Prerequisit Array ..." ); New_Line; for I in 1 .. N_of_Pairs loop put ( Prerequisite_Array( I, 1) ); put ( "-" ); put ( Prerequisite_Array( I, 2) ); New_Line; end loop; New_Line; end Build_a_List; -- ======================================================================
-- Procedure : Process_the_Queries -- Precondition : valid course list -- Postcondition : none
procedure Process_the_Queries( C_L : in out Graph_Type ) is Index_Array : V_Index_Range; aCourse : Course_Record; theEvent : Character; Course_Name1 : Course_Name_Type; Course_Name2 : Course_Name_Type; aString : String( 1 .. 1 ); Course_Hours : Natural; Key : V_Index_Range; N_in_Set : natural; Set_of : Index_Set; isIn_Set : boolean := false; procedure Get_a_Querie( anEvent : out character; aName1 : out Course_Name_Type; aName2 : out Course_Name_Type ) is Event : character := ' '; Chr : character := ' '; Name1 : Course_Name_Type := Empty_Name; Name2 : Course_Name_Type := Empty_Name; Close : boolean; EoL : boolean; begin -- Get_a_Querie Get_Next_Valid_Chr( Event ); if Event = 'L' then null; elsif Event = 'Q' or Event = 'D' then Get_a_Course( Name1, Close, EoL ); elsif Event = 'A' or Event = 'P' or Event = 'R' or Event = 'C' then Get_a_Course( Name1, Close, EoL ); Get_a_Course( Name2, Close, EoL ); end if; anEvent := Event; aName1 := Name1; aName2 := Name2; exception when End_Error => raise End_Error; when Others => raise Invalid_Input_File; end Get_a_Querie; begin -- Process_the_Queries loop -- Inveriant: Each loop iteration attenpts to read on valid set of -- input data. Loop terminates upon successful attempt. -- Oterwise another attenpt is made. Loop also -- terminates if end of file is reached. begin -- Get_a_Querie( theEvent, Course_Name1, Course_Name2 ); put( " " ); case theEvent is when 'A' => -- Add a course (without mentioning its prerequisite aString( 1 ) := Course_Name2( 1 ); Course_Hours := Natural( Integer'Value( aString )); aCourse.Name := Course_Name1; aCourse.Hours := Course_Hours; Insert_Vertex( C_L, aCourse ); put( " - Course added." ); when 'C' => -- Cancel prerequisite relation between courses Delete_Edge( C_L, Course_Name1, Course_Name2 ); put( " - Prerequisite relation CANCELed." ); when 'D' => -- Delete a Course and all its relationships Delete_Vertex( C_L, Course_Name1 ); put( " - Course and relationships DELETEd." ); when 'L' => -- List all Courses and their prerequisite relations New_Line; Print_All( myCourse_List ); when 'P' => -- add a prerequisite relation between existing Courses Insert_Edge( C_L, Course_Name1, Course_Name2 ); put( " - Prerequisite relation ADDed." ); when 'R' => -- ask if course 1 requires course 2 Key := V_Index( Course_Name1, C_L ); BFS_Search( Key, C_L, N_in_Set, Set_of ); for I in 1 .. N_in_Set loop if Course_Key( V_Content( Set_of( I ), C_L ) ) = Course_Name2 then isIn_Set := true; exit; end if; end loop; if isIn_Set then put ( " - Prerequisite relation EXISTs." ); else put ( " - NO prerequisite relation exists." ); end if; when 'Q' => -- ask for the required courses for a course Key := V_Index( Course_Name1, C_L ); BFS_Search( Key, C_L, N_in_Set, Set_of ); if N_in_Set > 0 then put ( " - Prerequisite(s) are: " ); for I in 1 .. N_in_Set - 1 loop Put_aCourse( V_Content( Set_of( I ), C_L ) ); put( " & " ); end loop; Put_aCourse( V_Content( Set_of( N_in_Set ), C_L ) ); put( '.' ); else put( " - No prerequisites REQUIREd." ); end if; when others => put( " - Unrecognized Command, SKIPed." ); end case; exception when End_Error => New_Line; put ( "Querie input complete, End of Job." ); exit; when Not_a_Course_Name => put ( " - Missing or Invalid Course Name(s), SKIPed." ); when Duplicate_Node => put ( " - Add FAILed, duplicate Course Name." ); when Missing_Edge => put ( " - Cancel FAILed, relationship non-existant." ); when Missing_Vertex => put ( " - Add FAILed, missing Course Name(s)." ); when Duplicate_Edge => put ( " - Add FAILed, duplicate relationship." ); when Invalid_Input_File => put ( " - Unrecognizable input, SKIPed." ); when Missing_Element => put ( " - Requested Course NOT FOUND." ); when others => put ( " - Unknown problem happened."); end; New_Line( 2 ); end loop; -- Asseration: One valid set of input data is returned to calling -- sub-program. end Process_the_Queries;
-- ====================================================================== -- ====================================================================== begin -- pre_Courses -- Open sample data file, for testing ONLY Text_IO.Open( File => sampleData, Mode => Text_IO.In_File, Name => "Prog10_Sample.dat" ); Text_IO.Set_Input( File => sampleData ); Build_a_List( myCourse_List ); Process_the_Queries( myCourse_List ); end pre_Courses;