From: "isaac2004" <isaac_2004@yahoo.com>
Subject: Re: Topological Sort Help
Date: 8 Feb 2007 10:14:38 -0800
Date: 2007-02-08T10:14:38-08:00 [thread overview]
Message-ID: <1170958478.093428.155250@j27g2000cwj.googlegroups.com> (raw)
In-Reply-To: <87ps8ldmrw.fsf@ludovic-brenta.org>
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
next prev parent reply other threads:[~2007-02-08 18:14 UTC|newest]
Thread overview: 20+ messages / expand[flat|nested] mbox.gz Atom feed top
2007-02-04 19:54 Topological Sort Help isaac2004
2007-02-04 21:45 ` Ludovic Brenta
2007-02-05 20:30 ` isaac2004
2007-02-05 20:39 ` Ludovic Brenta
2007-02-06 2:18 ` isaac2004
2007-02-06 9:06 ` Ludovic Brenta
2007-02-08 1:19 ` isaac2004
2007-02-08 9:25 ` Ludovic Brenta
2007-02-08 18:14 ` isaac2004 [this message]
2007-02-08 18:24 ` Ludovic Brenta
2007-02-08 18:29 ` isaac2004
2007-02-08 18:54 ` Ludovic Brenta
2007-02-08 19:14 ` isaac2004
2007-02-08 19:27 ` Ludovic Brenta
2007-02-08 20:22 ` isaac2004
2007-02-09 2:04 ` isaac2004
2007-02-08 18:38 ` Jeffrey R. Carter
2007-02-08 18:53 ` isaac2004
2007-02-09 4:57 ` Jeffrey R. Carter
2007-02-10 8:37 ` s053914
replies disabled
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox