``````Unit Graph;  { see test program at the end of this unit !! }

(***************************************************************************)
(*   Name: Graph                                                           *)
(*   Written by: William Hobday                                            *)
(*   Last Modified: September 6, 1991                                      *)
(*                                                                         *)
(*   Description:   This unit is an multilist implementation of a digraph. *)
(*   Each header node contains two lists: one conatining the arcs          *)
(*   emanating from the vertex, and the other terminating at that vertex.  *)
(*   The unit consists of the following documented procedures and          *)
(*   functions:                                                            *)
(*                        NewGraph : Graph                                 *)
(*                        NewVrtx( graph,name ) : vrtx                     *)
(*                        FirstSuccessor( name ) : name                    *)
(*                        NextSuccessor( name,name ) : name                *)
(*                        Adjacent( vrtx,vrtx ) : boolean                  *)
(*                        ArcWeight( vrtx,vrtx ) : weight                  *)
(*                        WtdJoin( vrtx,vrtx,weight )                      *)
(*                        RemoveArc( vrtx,vrtx )                           *)
(*                        PrintGraph( graph )                              *)
(*                        PrintArc( vrtx,vrtx )                            *)
(*                                                                         *)
(***************************************************************************)

Interface

type  Vertex = ^Vertexpointer;
Arc = ^Arcpointer;

Arcpointer = record
Weight: integer;
Vertex1,
Vertex2: char;
Emanate,
Terminate: Arc
end;

Vertexpointer = record
Name: char;
Emanate,
Terminate: Arc;
Next: Vertex;
Visited : boolean
end;

Function NewGraph : Vertex;
Function NewVrtx( var G : Vertex; Name: Char ): Vertex;
Function FirstSuccessor( G : Vertex; Name : char ) : char;
Function NextSuccessor( G : Vertex; Name : char; Successor : char ) : char;
Function GetVertex ( G : Vertex; Name : char ) : Vertex;
Function Adjacent( V1,V2 : Vertex ): boolean;
Function ArcWeight( V1,V2 : Vertex ): integer;
Procedure WtdJoin( V1,V2 : Vertex; Weight : integer );
Procedure RemoveArc( var V1,V2 : Vertex );
Procedure PrintGraph( G : Vertex );
Procedure PrintArc( V1,V2 : Vertex );

Implementation

(***************************************************************************)
(*   Name: NewGraph                                                        *)
(*                                                                         *)
(*   Purposse: This Function returns a pointer to a new empty graph        *)
(*   Input: None                                                           *)
(*   Ouput: A pointer to a new graph                                       *)
(***************************************************************************)

Function NewGraph : Vertex;

begin
NewGraph := nil
end;

(***************************************************************************)
(*   Name: NewVertex                                                       *)
(*                                                                         *)
(*   Purpose: Adds a new unconnected vertex to the graph                   *)
(*   Uses: NewV - New vertex to be created                                 *)
(*         Temp - Used to search for end of list                           *)
(*   Input: G - Pointer to Graph                                           *)
(*          Name - Name of new vertex                                      *)
(*   Output: Pointer to newly created vertex                               *)
(***************************************************************************)

Function NewVrtx( var G : Vertex; Name : char ) : Vertex;

var NewV,Temp: Vertex;

begin
new( NewV );
NewV^.Name := Name;
NewV^.Emanate := nil;
NewV^.Terminate := nil;
NewV^.Next := nil;
NewV^.Visited := false;
if G = nil
then G := NewV
else begin
Temp := G;
while Temp^.Next <> nil do
Temp := Temp^.Next;
Temp^.Next := NewV
end;
NewVrtx := NewV
end;

(***************************************************************************)
(*   Name: GetVertex                                                       *)
(*                                                                         *)
(*   Purpose: Given a graph and a vertex name it returns a pointer to the  *)
(*            vertex. Returns nil if vvertex doesn't exist.                *)
(*   Input: G - the graph                                                  *)
(*          Name - Name of vertex to find                                  *)
(*   Output: pointer to vertex found                                       *)
(***************************************************************************)

Function GetVertex( G : Vertex; Name : char) : Vertex;

begin
while ( G <> nil ) and ( G^.Name <> Name ) do
G := G^.Next;
GetVertex := G
end;

(***************************************************************************)
(*   Name: First Successor                                                 *)
(*                                                                         *)
(*   Purpose: Returns the first successor of the given vertex if it exists *)
(*   otherwise it returns a nul(ASCII 0).                                  *)
(*   Input: Name - Name of vertex from which the 1st successor is taken    *)
(*   Output: FirstSuccessor - name to the 1st successor of vertex          *)
(***************************************************************************)

Function FirstSuccessor ( G : Vertex; Name : char ) : char;

var V : Vertex;

begin
V := GetVertex( G,Name );
if V = nil
then FirstSuccessor := #0
else if V^.Emanate = nil
then FirstSuccessor := #0
else FirstSuccessor := V^.Emanate^.Vertex2
end;

(***************************************************************************)
(*   Name: NextSuccessor                                                   *)
(*                                                                         *)
(*   Purpose: Given a vertex and a successor, this returns the next        *)
(*            successor.  Returns the first successor if input parameters  *)
(*            are identical.  Returns nul if does not exist.               *)
(*   Input: G - pointer to list of vertices                                *)
(*          V - Name of vertex from which to find next successor           *)
(*          Name - Name of vertex next successor is to follow              *)
(*   Output: NextSuccessor - Name of the next successor                    *)
(***************************************************************************)

Function NextSuccessor( G : Vertex; Name : char; Successor : char ) : char;

var TempArc : Arc;
V : Vertex;

begin
V := GetVertex( G,Name );
if v <> nil
then if V^.Name = Successor
then NextSuccessor := FirstSuccessor( G,Successor )
else begin
TempArc := V^.Emanate;
while ( TempArc^.Vertex2 <> Successor ) and ( TempArc <> nil ) do
TempArc :=  TempArc^.Emanate;
if TempArc = nil
then NextSuccessor := #0
else if TempArc^.Emanate <> nil
then NextSuccessor := TempArc^.Emanate^.Vertex2
else NextSuccessor := #0
end
else NextSuccessor := #0
end;

(***************************************************************************)
(*   Name: Adjacent                                                        *)
(*                                                                         *)
(*   Purpose: Boolean function which returns true if given vertices are    *)
(*   Input: V1,V2 - Vertices to check for arc                              *)
(*   Output: Adjacent - Result of function                                 *)
(***************************************************************************)

Function Adjacent( V1,V2 : Vertex ) : boolean;

var TempArc : Arc;

begin
if ( V1^.Emanate = nil )  or ( V2^.Emanate = nil ) or ( V1 = nil ) or ( v2 =nil)
then Adjacent := false
else begin
TempArc := V1^.Emanate;
while (TempArc <> nil) and (V2^.Name <> TempArc^.Vertex2) do
TempArc := TempArc^.Emanate;
if TempArc^.Vertex2 = V2^.Name
then Adjacent := true
else Adjacent := false
end;
end;

(***************************************************************************)
(*   Name: ArcWeight                                                       *)
(*                                                                         *)
(*   Purpose: Returns the weight of the arc between V1 and V2 providing    *)
(*            that it exists.  Returns a Zero otherwise.                   *)
(*   Input: V1,V2 - vertices to check for arc                              *)
(*   Output: ArcWeight - the weight of the arc if it exists                *)
(***************************************************************************)

Function ArcWeight( V1,V2 : Vertex ) : integer;

var TempV : Arc;

begin
if ( V1^.Emanate = nil ) or ( V2^.Terminate = nil ) or ( not Adjacent( V1,V2 ) )
then ArcWeight := 0
else begin
TempV := V1^.Emanate;
while (V2^.Name <> TempV^.Vertex2) do
TempV := TempV^.Emanate;
ArcWeight := TempV^.Weight
end;
end;

(***************************************************************************)
(*   Name: WtdJoin                                                         *)
(*                                                                         *)
(*   Purpose: Creates a weighted arc between V1 and V2 of weight Weight    *)
(*   Input: V1,V2 - Vertices to connect                                    *)
(*          Weight - the weight of the new arc                             *)
(*   Output: None                                                          *)
(***************************************************************************)

Procedure WtdJoin( V1,V2 : Vertex; Weight : Integer );

var NewArc, Temp : Arc;

begin
if not Adjacent( V1,V2 )
then begin
New( NewArc );
NewArc^.Weight := Weight;
NewArc^.Vertex1 := V1^.Name;
NewArc^.Vertex2 := V2^.Name;
NewArc^.Emanate := nil;
NewArc^.Terminate := nil;
Temp := V1^.Emanate;
if Temp = nil
then V1^.Emanate := NewArc
else begin
while Temp^.Emanate <> nil do
Temp := Temp^.Emanate;
Temp^.Emanate := NewArc;
end;
Temp := V2^.Terminate;
if Temp = nil
then V2^.Terminate := NewArc
else begin
while Temp^.Terminate <> nil do
Temp := Temp^.Terminate;
Temp^.Terminate := NewArc;
end
end
end;

(***************************************************************************)
(*   Name: RemoveArc                                                       *)
(*                                                                         *)
(*   Purpose: Removes the Arc from V1 to V2 if it exists                   *)
(*   Input: V1,V2 - Vertices of arc to be removed                          *)
(*   Output: None                                                          *)
(***************************************************************************)

Procedure RemoveArc( var V1,V2 : Vertex );

var Temp,Temp2 : Arc;

begin
if Adjacent( V1,V2 )
then begin
Temp := V1^.Emanate;
if Temp^.Vertex2 = V2^.Name
then V1^.Emanate := Temp^.Emanate
else begin
while Temp^.Emanate^.Vertex2 <> V2^.Name do
Temp := Temp^.Emanate;
Temp2 := Temp^.Emanate;
Temp^.Emanate := Temp2^.Emanate
end;
Temp := V2^.Terminate;
if Temp^.Vertex1 = V1^.Name
then V2^.Terminate := Temp^.Terminate
else begin
while Temp^.Terminate^.Vertex1 <> V1^.Name do
Temp := Temp^.Terminate;
Temp2 := Temp^.Terminate;
Temp^.Terminate := Temp2^.Terminate
end
end
end;

(***************************************************************************)
(*   Name: PrintGraph                                                      *)
(*                                                                         *)
(*   Purpose: Prints an adjacency matrix for the graph                     *)
(*   Input: G - First Vertex in linked vertex list of graph                *)
(*   Output: Copy of the adjacency matrix for the graph                    *)
(***************************************************************************)

Procedure PrintGraph( G: Vertex );

var Temp,Temp2 : Vertex;
Count,Loop : integer;

begin
if G = nil
then writeln('The Graph does not exist!')
else begin
Count := 0;
Temp := G;
write('    ');
while Temp <> nil do
begin
write(Temp^.Name,' ');
Temp := Temp^.Next;
inc(Count)
end;
writeln;
write('  ÚÄ');
for Loop := 1 to Count do
write('ÄÄ');
writeln;
Temp := G;
while Temp <> nil do
begin
Temp2 := G;
write(Temp^.Name,' ³');
while Temp2 <> nil do
begin
if adjacent( Temp,Temp2 )
then write(' 1')
else write(' 0');
Temp2 := Temp2^.Next;
end;
Temp := Temp^.Next;
writeln
end
end
end;

(***************************************************************************)
(*   Name: PrintArc                                                        *)
(*                                                                         *)
(*   Purpose: Prints the name and weight of the arc between V1 and V2      *)
(*   Input: V1,V2 - Vertices of the arc to be printed                      *)
(*   Output: Name and weight of the arc                                    *)
(***************************************************************************)

Procedure PrintArc( V1,V2 : Vertex );

begin
if Adjacent( V1,V2 )
then writeln( V1^.Name,' ',V2^.Name,' ',ArcWeight( V1,V2 ))
else writeln('PrintArc Error --- Arc ',V1^.Name,',',V2^.Name,' does not exist ---');
end;

end.

{ ----------------  DEMO  -----------  CUT HERE --------- }

Program Testgraph;

uses graph,crt;

var A,B,C,D,E,F,Ga,H,I,J,temp : Vertex;
sh : arc;
ch : char;
x: integer;
G: Vertex;

begin
clrscr;
G := NewGraph;
ch := 'A';
A := NewVrtx(G,CH);
ch := 'B';
B := NewVrtx(G,CH);
ch := 'C';
C := NewVrtx(g,ch);
ch := 'D';
D := NewVrtx(g,ch);
ch := 'E';
E := NewVrtx(G,CH);
ch := 'F';
F := NewVrtx(G,CH);
ch := 'G';
Ga := NewVrtx(g,ch);
ch := 'H';
H := NewVrtx(g,ch);
ch := 'I';
I := NewVrtx(g,ch);
ch := 'J';
J := NewVrtx(g,ch);
WtdJoin(A,B,1);
wtdjoin(B,A,1);
wtdjoin(B,C,2);
wtdjoin(C,B,2);
WtdJoin(C,D,3);
wtdjoin(D,C,3);
wtdjoin(E,F,2);
wtdjoin(F,E,2);
WtdJoin(F,Ga,3);
wtdjoin(Ga,F,3);
wtdjoin(H,I,5);
wtdjoin(I,H,5);
WtdJoin(A,E,4);
wtdjoin(E,A,4);
wtdjoin(E,H,3);
wtdjoin(H,E,3);
WtdJoin(H,J,2);
wtdjoin(J,H,2);
wtdjoin(B,F,4);
wtdjoin(F,B,4);
WtdJoin(F,I,1);
wtdjoin(I,F,1);
wtdjoin(C,Ga,5);
wtdjoin(Ga,C,5);
WtdJoin(D,Ga,4);
wtdjoin(Ga,D,4);
wtdjoin(Ga,I,5);
wtdjoin(I,Ga,5);
WtdJoin(I,J,6);
wtdjoin(J,I,6);
wtdjoin(C,F,1);
wtdjoin(F,C,1);
wtdjoin(H,F,3);
wtdjoin(F,H,3);
wtdjoin(B,E,7);
WtdJoin(e,B,7) ;
writeln(FirstSuccessor(G,'F')^.name);
writeln(NextSuccessor(G,f,'C')^.name);
PrintGraph(G);
{   while G <> nil do
begin
writeln('Vertix ',G^.Name);
sh:=g^.emanate;
while sh<>nil do
begin
write(sh^.vertex1,',',sh^.vertex2,' ',sh^.weight,'   ');
sh := sh^.emanate;
end;
Writeln;
G := G^.Next
end}
end.

``````