Re: Topological Sort Help

ok there is a lot of code here because i am using generic packages
from an ADA book that i purchased so here goes.

the first program is the digraph .adb that contains functions to show
properties of a graph


PACKAGE BODY Digraphs IS
-- non-exported helper routines
FUNCTION Buildmatrix (
Size : Natural)
RETURN Digraph IS
G : Digraph (Vertices'First .. Vertices'Val (Vertices'Pos
(Vertices'First) + Size - 1), Vertices'First .. Vertices'Val
(Vertices'Pos (Vertices'First) + Size - 1)) := (OTHERS => (OTHERS =>
False));
BEGIN
RETURN G;
END Buildmatrix;

-- constructor
FUNCTION Creategraph (
Inputfile : String)
RETURN Digraphpointer IS
Input : File_Type;
Numvertices : Natural;
G : Digraphpointer;
A,
B : Vertices;
Ac,
Bc : Character;
BEGIN
Open(Input,In_File,Inputfile);
Get(Input,Numvertices);
G := NEW Digraph'(Buildmatrix(Numvertices));

WHILE NOT End_Of_File(Input) LOOP
Get(Input,Ac); -- read source node
Get(Input,Bc); -- read in space
Get(Input,Bc); -- now read destination node
A := Vertices(Ac);
B := Vertices(Bc);
G.All(A,B) := True;
END LOOP;

Close(Input);
RETURN G;
END Creategraph;

-----------------------------helper functions

FUNCTION IsAdjacent (
G : Digraph;
A,
B : Vertices)
RETURN Boolean IS
BEGIN
RETURN G(A,B);
END IsAdjacent;






PROCEDURE Cycle (
G : IN Digraph;
E : IN OUT Digraph;
Visited : IN OUT Set;
Row : IN OUT Vertices;
Value : OUT Boolean) IS
BEGIN
IF IsIn (Visited,Row) THEN
Value := True;
END IF;

FOR Col IN G'RANGE LOOP
IF IsAdjacent(G,Row,Col) THEN
IF IsIn(Visited, Row) = False THEN
Visited := Visited + Row;
END IF;
DeleteEdge(E,Row,Col);
Row := Col;
Cycle(G,E,Visited,Row,Value);
END IF;
END LOOP;

FOR I IN Row..G'Last LOOP
FOR Col IN G'RANGE LOOP
IF IsAdjacent(G,Row,Col) THEN
IF IsIn(Visited, Row) = False THEN
Visited := Visited + Row;
END IF;
DeleteEdge(E,Row,Col);
Row := Col;
Cycle(G,E,Visited,Row,Value);
END IF;
END LOOP;
END LOOP;
END Cycle;





FUNCTION IsEmpty (
G : Digraph)
RETURN Boolean IS
BEGIN
FOR I IN G'RANGE LOOP
FOR J IN G'RANGE LOOP
IF G(I,J) = True THEN
RETURN False;
END IF;
END LOOP;
END LOOP;
RETURN True;
END IsEmpty;


----------------------------------





-- modifiers



PROCEDURE AddEdge (
G : IN OUT Digraph;
Source,
Destination : IN Vertices) IS
BEGIN
G(Source, Destination) := True;
END AddEdge;


PROCEDURE DeleteEdge (
G : IN OUT Digraph;
Source,
Destination : IN Vertices) IS
BEGIN
G(Source, Destination) := False;
END DeleteEdge;

-- accessors

FUNCTION IsReflexive (
G : Digraph)
RETURN Boolean IS
BEGIN
FOR I IN G'RANGE LOOP
IF G(I,I)= False THEN
RETURN False;
END IF;
END LOOP;
RETURN True;
END IsReflexive;


FUNCTION IsIrreflexive (
G : Digraph)
RETURN Boolean IS
BEGIN -- stub
FOR I IN G'RANGE LOOP
IF G(I,I) = True THEN
RETURN False;
END IF;
END LOOP;
RETURN True;
END IsIrreflexive;

FUNCTION IsSymmetric (
G : Digraph)
RETURN Boolean IS
BEGIN
FOR I IN G'RANGE LOOP
FOR J IN G'RANGE LOOP
IF G(I,J) = True THEN
IF G(J,I) /= True THEN
RETURN False;
END IF;
END IF;
END LOOP;
END LOOP;
RETURN True;
END IsSymmetric;

FUNCTION IsAntisymmetric (
G : Digraph)
RETURN Boolean IS
BEGIN
FOR I IN G'RANGE LOOP
FOR J IN G'RANGE LOOP
IF G(I,J) = True THEN
IF G(J,I) = True AND I /= J THEN
RETURN False;
END IF;
END IF;
END LOOP;
END LOOP;
RETURN True;
END IsAntisymmetric;



FUNCTION Istransitive (
G : Digraph)
RETURN Boolean IS
BEGIN -- stub
FOR I IN G'RANGE LOOP
FOR J IN G'RANGE LOOP
FOR K IN G'RANGE LOOP
IF G(K,J) /= (G(K,J) AND (G(K,I) AND G(I,J))) THEN
RETURN False;
END IF;
END LOOP;
END LOOP;
END LOOP;
RETURN True;
END Istransitive;




FUNCTION Isconnected (
G : IN Digraph)
RETURN Boolean IS

EdgeSet : Set;
VertexSet : Set;
BEGIN

FOR I IN G'RANGE LOOP
VertexSet := VertexSet + Character(I);
FOR J IN G'RANGE LOOP
IF G(I,J) = True AND I /= J THEN
EdgeSet := EdgeSet + Character(J);
END IF;
END LOOP;
END LOOP;
IF VertexSet = EdgeSet THEN
RETURN True;
ELSE
RETURN False;
END IF;
END Isconnected;







FUNCTION IsStronglyConnected (
G : Digraph)
RETURN Boolean IS
EdgeSet : Set;
VertexSet : Set;
BEGIN
FOR I IN G'RANGE LOOP
VertexSet := VertexSet + Character(I);
FOR J IN G'RANGE LOOP
IF G(I,J) = True AND I /= J THEN
EdgeSet := EdgeSet + Character(J);
END IF;
END LOOP;
END LOOP;
IF VertexSet <= EdgeSet THEN
RETURN True;
ELSE
RETURN False;
END IF;
END IsStronglyConnected;


FUNCTION HasCycle (
G : Digraph)
RETURN Boolean IS
Value : Boolean := False;
E : Digraph := G;
Visited : Set;
Row : Character := 'A';
BEGIN
FOR I IN G'RANGE LOOP
FOR J IN G'RANGE LOOP
IF I = J AND IsAdjacent(G,I,J) THEN
RETURN True;
END IF;
END LOOP;
END LOOP;

Cycle(G,E,Visited,Row,Value);

IF Value = True THEN
RETURN True;
ELSE
RETURN False;
END IF;

END Hascycle;

PROCEDURE Dfs_Spanningtree (
G : IN Digraph;
Startnode : IN Vertices;
D : OUT Digraphpointer;
Visited : OUT Set) IS

-- V1
Source : Vertices;
-- Q : Vertex_Queue.Queue

BEGIN -- stub

D:= NEW Digraph'(Buildmatrix(G'Length));
Source := Startnode;
Visited := Visited + Source;
FOR Dest IN G'RANGE LOOP
IF Isadjacent (G, Source, Dest) AND NOT Isin(Visited, Dest)
THEN
Visited := Visited + Dest;
Addedge(D.All, Source, Dest);
Dfs_Spanningtree(G,Dest,D,Visited);

END IF;
end loop;
END Dfs_Spanningtree;






PROCEDURE Bfs_Spanningtree (
G : IN Digraph;
Startnode : IN Vertices;
B : OUT Digraphpointer;
Visited : OUT Set) IS

V1, S : Vertices;
Q : Vertex_Queue.Queue(Capacity =>
Vertices'Pos(Vertices'Last) - Vertices'Pos(Vertices'First) + 1);

BEGIN -- stub
B := NEW Digraph'(Buildmatrix(G'Length));
Makeempty(Q);
V1 := Startnode;
Visited := Visited + V1;
Enqueue(Q, V1);
WHILE NOT Isempty (Q) loop
S:= First(Q);
Dequeue(Q);
FOR I IN G'Range LOOP
IF Isadjacent (G, S, I) AND NOT IsIN (Visited, I)
THEN
Addedge(B.All, S, I);
Visited := Visited + I;
enqueue(Q, I);
END IF;
END LOOP;
END LOOP;
-- NULL;
END Bfs_Spanningtree;

--PROCEDURE AddToEnd (
-- L : IN OUT List;
-- Word : IN WordType ) IS
-- Temp : List;
-- BEGIN
-- Temp := NEW ListNode;
-- Temp.Word := Word;
-- Temp.Next := L;
-- Temp.Prev := L.Prev;
-- Temp.Next.Prev := Temp;
-- Temp.Prev.Next := Temp;

-- END AddToEnd;
--





PROCEDURE Topological_Sort (
G : IN Digraph;
Result : OUT Stackpointer;
Hascycle : OUT Boolean) IS

S : Set;
BEGIN

-- WHILE IsEmpty(G) /= False DO
-- S := set of all vertices in V who
have no sucessors
-- if S is empty
-- hascycle := true;
-- return hascycle
-- end if
-- take the greatest element e in S
-- push e onto a stack
-- remove all edge in E that have e as a
destination
-- remove e from v
-- end loop



NULL;
END Topological_Sort;







-- actions

PROCEDURE Displaygraph (
G : Digraph;
Present : Set := - Phi) IS
BEGIN
Put(" ");
FOR J IN G'RANGE(2) LOOP
Put(Character(J));
END LOOP;
New_Line;
FOR I IN G'RANGE(1) LOOP
Put(Character(I));
Put(" ");
FOR J IN G'RANGE(2) LOOP
IF Isin(Present,I) AND Isin(Present,J) THEN
IF G(I,J) = True THEN
Put("T");
ELSE
Put("F");
END IF;
ELSE
Put(" ");
END IF;
END LOOP;
New_Line;
END LOOP;
END Displaygraph;

END Digraphs;


there is a sets generic package that i implement
PACKAGE BODY Sets_Generic IS
FUNCTION "+" (S : Set; E: Universe) RETURN Set IS

Result : Set := S;

BEGIN

Result.Store(E) := True;

RETURN Result;

END "+";


FUNCTION "-" (S : Set; E: Universe) RETURN Set IS

Result : Set := S;

BEGIN

Result.Store(E) := False;

RETURN Result;
END "-";


FUNCTION Single
ton (E: Universe) RETURN Set IS

BEGIN
RETURN Phi + E;

END Singleton;


FUNCTION "+" (E1, E2: Universe) RETURN Set IS

BEGIN

RETURN Phi + E1 + E2;

END "+";


FUNCTION "+" (S, T : Set) RETURN Set IS

Result : Set;

BEGIN



FOR E IN Universe LOOP

Result.Store(E) := S.Store(E) OR T.Store(E);

END LOOP;

RETURN Result;

END "+";


FUNCTION "*" (S, T : Set) RETURN Set IS

Result : Set;

BEGIN

FOR E IN Universe LOOP

Result.Store(E) := S.Store(E) AND T.Store(E);

END LOOP;

RETURN Result;


END "*";



FUNCTION "-" (S, T : Set) RETURN Set IS

Result : Set;

BEGIN

FOR E IN Universe LOOP

Result.Store(E) := S.Store(E) AND NOT T.Store(E);

END LOOP;

RETURN Result;

END "-";



FUNCTION "-" (S : Set) RETURN Set IS

Result : Set;

BEGIN

FOR E IN Universe LOOP

Result.Store(E) := NOT S.Store(E);

END LOOP;

RETURN Result;

END "-";

-- selectors


FUNCTION IsIn (S: Set; E: Universe) RETURN Boolean IS

BEGIN

RETURN S.Store(E);

END IsIn;


FUNCTION IsEmpty (S: Set) RETURN Boolean IS

BEGIN

RETURN S = Phi;

END IsEmpty;


FUNCTION SizeOf (S: Set) RETURN Natural IS

Result : Natural := 0;

BEGIN

FOR E IN Universe LOOP


IF S.Store(E) THEN

Result := Result + 1;

END IF;

END LOOP;

RETURN Result;

END SizeOf;



FUNCTION "<=" (S, T : Set) RETURN Boolean IS

BEGIN

FOR E IN Universe LOOP

IF S.Store(E) AND NOT T.Store(E) THEN

RETURN False;

END IF;

END LOOP;

RETURN True;

END "<=";


FUNCTION "<" (S, T : Set) RETURN Boolean IS

BEGIN

RETURN S /= T AND THEN S <= T;

END "<";


END Sets_Generic;

also there is a stacks generic package that is used

PACKAGE BODY Stacks_Generic IS

PROCEDURE MakeEmpty (S : IN OUT Stack) IS
BEGIN
S.latest := 0;
END MakeEmpty;

FUNCTION IsEmpty (S : IN Stack) RETURN Boolean IS
BEGIN
RETURN S.Latest = 0;
END IsEmpty;

FUNCTION IsFull (S : IN Stack) RETURN Boolean IS
BEGIN
RETURN S.Latest = S.Capacity;
END IsFull;

PROCEDURE Push (S : IN OUT Stack;
E : IN Element) IS
BEGIN
IF IsFull (S) THEN
RAISE StackFull;
ELSE
S.Latest := S.Latest + 1;
S.Store (S.Latest) := E;
END IF;
END Push;

PROCEDURE Pop (S : IN OUT Stack) IS
BEGIN
IF IsEmpty (S) THEN
RAISE StackEmpty;
ELSE
S.Latest := S.Latest - 1;
END IF;
END Pop;

FUNCTION Top (S : IN Stack) RETURN Element IS
BEGIN
IF IsEmpty (S) THEN
RAISE StackEmpty;
ELSE
RETURN S.Store (S.Latest);
END IF;
END Top;

END Stacks_Generic;

and that are all the packages that need to be used for the top sort
function

the algorithm in the function body is a psuedo code algorithm because
i am unfamiliar how to implement it in ada. thanks for all the help


.

Relevant Pages

  • Re: Dynamic cycle Detection
    ... After each addition I need to check if the addition made the digraph ... If every node has a list of its ancestors, ... it doesn't create a loop. ... If this informality upsets you, ...
    (comp.theory)
  • Re: Topological Sort Help
    ... PACKAGE Vertex_Stack IS NEW Stacks_Generic; ... TYPE DigraphPointer IS ACCESS Digraph; ... FUNCTION IsIrreflexive RETURN Boolean; ... TYPE Stack IS LIMITED PRIVATE; ...
    (comp.lang.ada)
  • Re: Mixed Simulation of Design (VHDL and Verilog)
    ... Dependency exists between package a and package BODY b ... SUBTYPE c_range IS natural RANGE a'RANGE; ... c_loop: ... Segmentation violation if a subtype is used as an index ...
    (comp.lang.vhdl)
  • Re: MKDir not working
    ... Public Sub MkDirs ... first argument of the Split function in the active loop statement; ... track and return a Boolean status from the function. ... MkDirs = MkDirs + Err.Number ...
    (microsoft.public.vb.general.discussion)
  • Fun with Tasking
    ... Below is sample code I made representing something I wanted to do with ... this, as I mentioned, "exec" is representative of a family of several ... package Convert is new System.Address_To_Access_Conversions ... end loop; ...
    (comp.lang.ada)