[Back to MATH SWAG index] [Back to Main SWAG index] [Original]

    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    *)
    (*            adjacent.                                                    *)
    (*   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.

[Back to MATH SWAG index] [Back to Main SWAG index] [Original]