Directed graphs

Vertices and arcs

A directed graph is a mathematical structure that consists of a set of values (which are called the vertices of the directed graph) and a set of arcs connecting certain vertices. Each arc is oriented so that it leaves one vertex and enters another another (or possibly the same one).

It may be helpful to think of arcs as forming an abstract data type in which each value comprises a ``from'' vertex and a ``to'' vertex, with the following operations:

create
Inputs: from-vertex and to-vertex, both vertices.
Output: result, an arc.
Preconditions: none.
Postcondition: result is directed from from-vertex to to-vertex.

source
Input: operand, an arc.
Output: result, a vertex.
Preconditions: none.
Postcondition: operand is directed from result to some vertex.

target
Input: operand, an arc.
Output: result, a vertex.
Preconditions: none.
Postcondition: operand is directed from some vertex to result.

Vertices and Arcs modules in HP Pascal

The vertices of a directed graph can in principle be of any type, but because the implementation of sets that we'll be using presupposes that the members of a set can be compared both for equality and for precedence, we shall require that the operations EqualVertex and PrecedesVertex are defined in and exported from the Vertices module.

In addition, since the vertices may be of an opaque type accessed through a pointer, we shall also require an operation that assigns a value of the Vertex type to a variable of that type by copying the entire structure, and an operation that deallocates any dynamically allocated storage associated with such a value. The implementation of these operations is trivial if the Vertex type does not involve pointers. Here's how the module looks when the vertices are simply integer values: 

{ This module defines a Vertex data type so that other modules related to
  graphs can import it.

  Programmer: John Stone, Grinnell College.
  Original version: December 3, 1996.
}

module Vertices;

export

  type
    Vertex = Integer;

  function EqualVertex (LeftOperand, RightOperand: Vertex): Boolean;

  function PrecedesVertex (LeftOperand, RightOperand: Vertex): Boolean;

  procedure AssignVertex (var Target: Vertex; Source: Vertex);

  procedure DeallocateVertex (var Operand: Vertex);

implement

  function EqualVertex (LeftOperand, RightOperand: Vertex): Boolean;
  begin
    EqualVertex := LeftOperand = RightOperand
  end;

  function PrecedesVertex (LeftOperand, RightOperand: Vertex): Boolean;
  begin
    PrecedesVertex := LeftOperand < RightOperand
  end;

  procedure AssignVertex (var Target: Vertex; Source: Vertex);
  begin
    Target := Source
  end;

  procedure DeallocateVertex (var Operand: Vertex);
  begin
  end;

end.
Since arcs too are going to be members of sets within a directed graph, the same kinds of complications must be added to the elegant simplicity of the abstract data type defined above. But there are no real surprises in the coding of the Arcs module, either; an arc is basically an immutable record with two fields, both of type Vertex:

{ This module defines an Arc data type, so that other modules related to
  graphs can import it.

  Programmer: John Stone, Grinnell College.
  Original version: December 3, 1996.
}

$heap_dispose on$

module Arcs;

$search 'vertices.o'$
import
  Vertices;

export

  type
    Arc = ^ArcRecord;

  function CreateArc (FromVertex, ToVertex: Vertex): Arc;

  function SourceOfArc (Operand: Arc): Vertex;

  function TargetOfArc (Operand: Arc): Vertex;

  function EqualArc (LeftOperand, RightOperand: Arc): Boolean;

  function PrecedesArc (LeftOperand, RightOperand: Arc): Boolean;

  procedure AssignArc (var Target: Arc; Source: Arc);

  procedure DeallocateArc (var Operand: Arc);

implement

  import
    StdErr;

  const
    FirstExceptionCode = 1;

    UndefinedArcException = 1;
    ExceptionException = 2;

    LastExceptionCode = 11;

  type
    ArcRecord = record
                  From: Vertex;
                  Into: Vertex
                end;

  procedure ArcExceptionHandler (ExceptionCode: Integer);
  begin
    if (ExceptionCode < FirstExceptionCode) or
                        (LastExceptionCode < ExceptionCode) then
      ExceptionCode := ExceptionException;
    WriteLn (StdErr, 'Exception #', ExceptionCode : 1, ' in module Arcs:');
    case ExceptionCode of
    UndefinedArcException:
      WriteLn (StdErr, 'An uninitialized or undefined Arc value was ',
               'passed to a procedure or function.');
    ExceptionException:
      WriteLn (StdErr, 'The ArcExceptionHandler procedure received ',
               'an unknown exception code.')
    end
  end;

  function CreateArc (FromVertex, ToVertex: Vertex): Arc;
  var
    Result: Arc;
  begin
    New (Result);
    AssignVertex (Result^.From, FromVertex);
    AssignVertex (Result^.Into, ToVertex);
    CreateArc := Result
  end;

  function SourceOfArc (Operand: Arc): Vertex;
  var
    Result: Vertex;
  begin
    Assert (Operand <> nil, UndefinedArcException, ArcExceptionHandler);
    AssignVertex (Result, Operand^.From);
    SourceOfArc := Result
  end;

  function TargetOfArc (Operand: Arc): Vertex;
  var
    Result: Vertex;
  begin
    Assert (Operand <> nil, UndefinedArcException, ArcExceptionHandler);
    AssignVertex (Result, Operand^.Into);
    TargetOfArc := Result
  end;

  function EqualArc (LeftOperand, RightOperand: Arc): Boolean;
  begin
    Assert ((LeftOperand <> nil) and (RightOperand <> nil),
            UndefinedArcException, ArcExceptionHandler);
    EqualArc := EqualVertex (LeftOperand^.From, RightOperand^.From) and
                EqualVertex (LeftOperand^.Into, RightOperand^.Into)
  end;

  function PrecedesArc (LeftOperand, RightOperand: Arc): Boolean;
  begin
    Assert ((LeftOperand <> nil) and (RightOperand <> nil),
            UndefinedArcException, ArcExceptionHandler);
    if PrecedesVertex (LeftOperand^.From, RightOperand^.From) then
      PrecedesArc := True
    else if PrecedesVertex (RightOperand^.From, LeftOperand^.From) then
      PrecedesArc := False
    else
      PrecedesArc := PrecedesVertex (LeftOperand^.Into, RightOperand^.Into)
  end;

  procedure AssignArc (var Target: Arc; Source: Arc);
  begin
    Assert (Source <> nil, UndefinedArcException, ArcExceptionHandler);
    New (Target);
    Target^ := Source^
  end;

  procedure DeallocateArc (var Operand: Arc);
  begin
    Assert (Operand <> nil, UndefinedArcException, ArcExceptionHandler);
    DeallocateVertex (Operand^.From);
    DeallocateVertex (Operand^.Into);
    Dispose (Operand);
    Operand := nil
  end;

end.

Directed graphs

A directed graph, as defined in the first paragraph of the handout, is now an extremely abstract data type. There are only three essential operations -- the constructor and the two accessor functions:

create
Inputs: vertices, a set of vertices, and arcs, a set of arcs.
Output: result, a directed graph.
Preconditions: Both of the endpoints of every arc in arcs are members of vertices.
Postconditions: vertices is the vertex set of result and arcs the arc set of result.

vertices
Input: operand, a directed graph.
Output: result, a set of vertices.
Preconditions: none.
Postcondition: operand is the vertex set of result.

arcs
Input: operand, a directed graph.
Output: result, a set of arcs.
Preconditions: none.
Postcondition: operand is the arc set of result.

The textbook defines or hints at a number of operations on directed graphs, but it turns out that the most natural implementation of each one involves performing set operations on the constituent vertex and arc sets.

The implementation in HP Pascal requires the importation of two nearly-identical set modules, one for sets of vertices and the other for sets of arcs. Each is derived by minor editing from the module presented in the handout on sets; the major changes are (1) that the type, procedure, and function names have been changed in obvious ways to prevent name collisions when both modules are imported; (2) that set members are now explicitly deallocated during the set-deallocation procedure; and (3) that assignments to variables of the element types are now performed by invoking the appropriate Assign procedure, rather than by the := operation.

Note that the CreateDirectedGraphs procedure begins with an assertion that checks the correctness of the precondition. Here's the DirectedGraphs module:

{ This module defines the interface for a DirectedGraph data type and
  implements it for HP 9000 Series 700 workstations under HP-UX 9.x, using
  HP Pascal.  

  Programmer: John Stone, Grinnell College.
  Original version: November 26, 1996.
  Last revised: December 3, 1996.
}

$heap_dispose on$

module DirectedGraphs;

$search 'arc-sets.o, vertex-sets.o, arcs.o, vertices.o'$
import
  ArcSets, VertexSets;

export

  type
    DirectedGraph = ^DirectedGraphRecord;

  function CreateDirectedGraph (Vertices: VertexSet; Arcs: ArcSet):
    DirectedGraph; 

  function VerticesOfDirectedGraph (Operand: DirectedGraph): VertexSet;

  function ArcsOfDirectedGraph (Operand: DirectedGraph): ArcSet;

  procedure AssignDirectedGraph (var Target: DirectedGraph;
    Source: DirectedGraph);

  procedure DeallocateDirectedGraph (var Operand: DirectedGraph);

implement

  import
    Arcs, Vertices, StdErr;

  const
    FirstExceptionCode = 1;

    CreateDirectedGraphException = 1;
    UndefinedDirectedGraphException = 2;
    ExceptionException = 3;

    LastExceptionCode = 3;

  type
    DirectedGraphRecord = record
                            V: VertexSet;
                            E: ArcSet
                          end;

  procedure DirectedGraphExceptionHandler (ExceptionCode: Integer);
  begin
    if (ExceptionCode < FirstExceptionCode) or
                        (LastExceptionCode < ExceptionCode) then
      ExceptionCode := ExceptionException;
    WriteLn (StdErr, 'Exception #', ExceptionCode : 1,
             ' in module DirectedGraphs:');
    case ExceptionCode of
    CreateDirectedGraphException:
      WriteLn (StdErr, 'The CreateDirectedGraph function received an ',
               'arc set relating vertices not in the proposed vertex set.');
    UndefinedDirectedGraphException:
      WriteLn (StdErr, 'An uninitialized or undefined DirectedGraph ',
               'value was passed to a procedure or function.');
    ExceptionException:
      WriteLn (StdErr, 'The DirectedGraphExceptionHandler procedure ',
               'received an unknown exception code.')
    end
  end;

  function ArcsRelateVertices (Vertices: VertexSet; Arcs: ArcSet): Boolean;

    function BothEndsInVertices (A: Arc): Boolean;
    var
      Start, Finish: Vertex;
    begin
      Start := SourceOfArc (A);
      if MemberOfVertexSet (Start, Vertices) then begin
        Finish := TargetOfArc (A);
        BothEndsInVertices := MemberOfVertexSet (Finish, Vertices);
        DeallocateVertex (Finish)
      end
      else
        BothEndsInVertices := False;
      DeallocateVertex (Start)
    end;

  begin { function ArcsRelateVertices }
    ArcsRelateVertices := EveryMemberOfArcSet (Arcs, BothEndsInVertices)
  end;

  function CreateDirectedGraph (Vertices: VertexSet; Arcs: ArcSet):
    DirectedGraph;
  var
    Result: DirectedGraph;
  begin
    Assert (ArcsRelateVertices (Vertices, Arcs),
            CreateDirectedGraphException, DirectedGraphExceptionHandler);
    New (Result);
    AssignVertexSet (Result^.V, Vertices);
    AssignArcSet (Result^.E, Arcs);
    CreateDirectedGraph := Result
  end;

  function VerticesOfDirectedGraph (Operand: DirectedGraph): VertexSet;
  var
    Result: VertexSet;
  begin
    Assert (Operand <> nil, UndefinedDirectedGraphException,
            DirectedGraphExceptionHandler);
    AssignVertexSet (Result, Operand^.V);
    VerticesOfDirectedGraph := Result
  end;

  function ArcsOfDirectedGraph (Operand: DirectedGraph): ArcSet;
  var
    Result: ArcSet;
  begin
    Assert (Operand <> nil, UndefinedDirectedGraphException,
            DirectedGraphExceptionHandler);
    AssignArcSet (Result, Operand^.E);
    ArcsOfDirectedGraph := Result
  end;

  procedure AssignDirectedGraph (var Target: DirectedGraph;
    Source: DirectedGraph);
  begin
    Assert (Source <> nil, UndefinedDirectedGraphException,
            DirectedGraphExceptionHandler);
    New (Target);
    AssignVertexSet (Target^.V, Source^.V);
    AssignArcSet (Target^.E, Source^.E)
  end;

  procedure DeallocateDirectedGraph (var Operand: DirectedGraph);
  begin
    Assert (Operand <> nil, UndefinedDirectedGraphException,
            DirectedGraphExceptionHandler);
    DeallocateVertexSet (Operand^.V);
    DeallocateArcSet (Operand^.E);
    Dispose (Operand);
    Operand := nil
  end;   

end.
It is straightforward to give algorithmic equivalents of many of the abstract notions defined in chapter 9 of Walker's textbook, as well as many others. Let's start by defining a function that finds the successors of a given vertex in a directed graph -- the vertices entered by arcs that leave the given vertex: 
function Successors (G: DirectedGraph; Start: Vertex): VertexSet;
var
  V: VertexSet;
  E: ArcSet;
    { the components of G }
  Result: VertexSet;
    { the set of successors of Start, as it is constructed }

  procedure AddFinishOppositeStartToResult (A: Arc);
  var
    AStart, AFinish: Vertex;
      { the end points of arc A }
  begin
    AStart := SourceOfArc (A);
    if EqualVertex (Astart, Start) then begin
      AFinish := TargetOfArc (A);
      ReplaceVertexSet (Result, AdjoinToVertexSet (Result, AFinish));
      DeallocateVertex (AFinish)
    end;
    DeallocateVertex (AStart)
  end;

begin { function Successors }
  V := VerticesOfDirectedGraph (G);
  { Assert (MemberOfVertexSet (Start, V)); }
  E := ArcsOfDirectedGraph (G);
  Result := TheEmptyVertexSet;
  ApplyToEachMemberOfArcSet (E, AddFinishOppositeStartToResult);
  Successors := Result
end;
(The ReplaceVertexSet procedure simply deallocates the existing storage occupied by its first argument and then copies a pointer to its second argument into that first argument; it's used when one wants to overwrite the old value of a VertexSet variable with a new one, recycling the old value first.)

If one starts with an entire set Starters of vertices, rather than a single vertex, and constructs the set of successors of members of Starters, the result is called the image of Starters (in the directed graph). Here's a function that computes the image of a given set of vertices in a given directed graph: 

function Image (G: DirectedGraph; Starters: VertexSet): VertexSet;
var
  V: VertexSet;
  E: ArcSet;
    { the components of G }
  Result: VertexSet;
    { the set of successors of Starters, as it is constructed }

  procedure AddSuccessorsToResult (Start: Vertex);
  var
    Additions: VertexSet;
      { the successors of Start }
  begin
    Additions := Successors (G, Start);
    ReplaceVertexSet (Result, UnionOfVertexSets (Result, Additions));
    DeallocateVertexSet (Additions)
  end;

begin { function Image }
  V := VerticesOfDirectedGraph (G);
  { Assert (SubsetOfVertexSet (Starters, V)); }
  E := ArcsOfDirectedGraph (G);
  Result := TheEmptyVertexSet;
  ApplyToEachMemberOfVertexSet (Starters, AddSuccessorsToResult);
  Image := Result
end;
The first of the graph-theory notions that Walker presents is that of a path from one vertex to another. Here is a function that determines whether there is a (directed) path from one given vertex to another in a given directed graph. Although it's not entirely obvious from its form, this function conducts a breadth-first search of the graph, starting from the Start vertex, until it either finds the Finish vertex (and returns True or cannot extend the partial paths it constructs to any new vertices (in which case it returns False).

function PathExists (G: DirectedGraph; Start, Finish: Vertex): Boolean;
var
  Previous: VertexSet;
    { the set of vertices that have already been considered as points
      along a path }
  Accessible: VertexSet;
    { the successors of vertices that might still constitute forwards
      progress towards the goal }
  Found: Boolean;
    { indicates whether a path from Start to Finish has yet been
      detected } 
  Newcomers: VertexSet;
    { the newly accessible vertices, not yet in Previous }
begin
  Previous := CreateSingletonVertexSet (Start);
  Accessible := Successors (G, Start);
  Found := MemberOfVertexSet (Finish, Accessible);
  Newcomers := RelativeComplementOfVertexSets (Accessible, Previous);
  while not Found and  not EmptyVertexSet (Newcomers) do begin
    ReplaceVertexSet (Previous, UnionOfVertexSets (Previous, Accessible));
    ReplaceVertexSet (Accessible, Image (G, Newcomers));
    Found := MemberOfVertexSet (Finish, Accessible);
    ReplaceVertexSet (Newcomers,
                      RelativeComplementOfVertexSets (Accessible,
                                                      Previous))
  end;
  PathExists := Found;
  DeallocateVertexSet (Previous);
  DeallocateVertexSet (Accessible);
  DeallocateVertexSet (Newcomers)
end;
It's straightforward to write functions to compute the complete graph on any set of vertices and the totally unconnected graph on any set of vertices:

function CompleteGraph (V: VertexSet): DirectedGraph;
var
  E: ArcSet;
    { the set of all arcs connecting distinct vertices in V }

  procedure AddAllOutgoingArcsToE (Start: Vertex);

    procedure AdjoinArcToE (Finish: Vertex);
    var
      A: Arc;
        { the arc from Start to Finish }
    begin
      if not EqualVertex (Start, Finish) then begin
        A := CreateArc (Start, Finish);
        ReplaceArcSet (E, AdjoinToArcSet (E, A));
        DeallocateArc (A)
      end
    end;

  begin { function AddAllOutgoingArcsToE }
    ApplyToEachMemberOfVertexSet (V, AdjoinArcToE)
  end;

begin { function CompleteGraph }
  E := TheEmptyArcSet;
  ApplyToEachMemberOfVertexSet (V, AddAllOutgoingArcsToE);
  CompleteGraph := CreateDirectedGraph (V, E);
  DeallocateArcSet (E)
end;

function TotallyUnconnectedGraph (V: VertexSet): DirectedGraph;
var
  E: ArcSet;
    { the set of all arcs connecting distinct vertices in V }
begin
  E := TheEmptyArcSet;
  TotallyUnconnectedGraph := CreateDirectedGraph (V, E);
  DeallocateArcSet (E)
end;
One graph qualifies as a subgraph of another if its vertex set is a subset of the other's and its arc set is a subset of the other's: 
function Subgraph (LeftOperand, RightOperand: DirectedGraph): Boolean;
var
  LeftVertices, RightVertices: VertexSet;
    { the vertex sets of the left and right operands }
  LeftArcs, RightArcs: ArcSet;
    { the arc sets of the left and right operands }
begin
  LeftVertices := VerticesOfDirectedGraph (LeftOperand);
  RightVertices := VerticesOfDirectedGraph (RightOperand);
  if VertexSubset (LeftVertices, RightVertices) then begin
    LeftArcs := ArcsOfDirectedGraph (LeftOperand);
    RightArcs := ArcsOfDirectedGraph (RightOperand);
    Subgraph := ArcSubset (LeftArcs, RightArcs);
    DeallocateArcSet (LeftArcs);
    DeallocateArcSet (RightArcs)
  end
  else
    Subgraph := False;
  DeallocateVertexSet (LeftVertices);
  DeallocateVertexSet (RightVertices)
end;
Walker suggests two methods of traversing the part of a graph that is reachable from a given vertex, so as to visit each vertex in that part of the graph once, presumably to perform some operation on it. One method is a ``breadth-first'' traversal, in which the vertices are processed in order of their distance from the starting vertex; the other is a ``depth-first'' traversal, in which each path is followed out until it either ends or cycles around to a previously visited vertex. Here is an implementation of each. Note that the breadth-first traversal uses a queue of vertices to keep track of those that have been visited but not yet considered for successors, while the depth-first traversal, written recursively, implicitly uses a stack:

procedure BreadthFirstTraversal (G: DirectedGraph; Start: Vertex;
  procedure Applicand (V: Vertex));
var
  Visited: VertexSet;
    { the vertices that have already been visited }
  Holding: VertexQueue;
    { unexamined successors of visited vertices }
  Selected: Vertex;
    { one vertex at a time, from Holding }
  NextBatch: VertexSet;
    { the successors of the selected vertex }

  procedure EnqueueInHolding (Vert: Vertex);
  begin
    Enqueue (Vert, Holding)
  end;

begin { procedure BreadthFirstTraversal }
  { V := VerticesOfDirectedGraph (G);
    Assert (MemberOfVertexSet (Start, V));
    DeallocateVertexSet (V); }
  Visited := TheEmptyVertexSet;
  Holding := CreateVertexQueue;
  Enqueue (Start, Holding);
  while not EmptyVertexQueue (Holding) do begin
    Selected := Dequeue (Holding);
    if not MemberOfVertexSet (Selected, Visited) then begin
      Applicand (Selected);
      ReplaceVertexSet (Visited, AdjoinToVertexSet (Visited, Selected));
      NextBatch := Successors (G, Selected);
      ApplyToEachMemberOfVertexSet (NextBatch, EnqueueInHolding);
      DeallocateVertexSet (NextBatch)
    end;
    DeallocateVertex (Selected)
  end
end;

procedure DepthFirstTraversal (G: DirectedGraph; Start: Vertex;
  procedure Applicand (V: Vertex));
var
  Visited: VertexSet;
    { the vertices that have already been visited }

  procedure DepthFirstHelper (Selected: Vertex);
  var
    NextBatch: VertexSet;
      { the successors of the selected vertex }
  begin
    if not MemberOfVertexSet (Selected, Visited) then begin
      Applicand (Selected);
      ReplaceVertexSet (Visited, AdjoinToVertexSet (Visited, Selected));
      NextBatch := Successors (G, Selected);
      ApplyToEachMemberOfVertexSet (NextBatch, DepthFirstHelper);
      DeallocateVertexSet (NextBatch)
    end
  end;

begin { procedure DepthFirstTraversal }
  { V := VerticesOfDirectedGraph (G);
    Assert (MemberOfVertexSet (Start, V));
    DeallocateVertexSet (V); }
  Visited := TheEmptyVertexSet;
  DepthFirstHelper (Start);
  DeallocateVertexSet (Visited)
end;
Many other operations on directed graphs can be coded elegantly in this implementation. Here are a few of my favorites:

Union and intersection are meaningful operations on directed graphs, and there is also a plausible notion of a complement: The complement of a given graph as the same vertex set, but its arc set contains exactly those ways of connecting vertices that are not members of the original graph's arc set. 

function UnionOfDirectedGraphs (LeftOperand, RightOperand:
  DirectedGraph): DirectedGraph; 
var
  LeftVertices, RightVertices: VertexSet;
    { the vertex sets of the left and right operands }
  LeftArcs, RightArcs: ArcSet;
    { the arc sets of the left and right operands }
  V: VertexSet;
  E: ArcSet;
    { the vertex and arc sets of the result }
begin
  LeftVertices := VerticesOfDirectedGraph (LeftOperand);
  RightVertices := VerticesOfDirectedGraph (RightOperand);
  V := UnionOfVertexSets (LeftVertices, RightVertices);
  DeallocateVertexSet (LeftVertices);
  DeallocateVertexSet (RightVertices);
  LeftArcs := ArcsOfDirectedGraph (LeftOperand);
  RightArcs := ArcsOfDirectedGraph (RightOperand);
  E := UnionOfArcSets (LeftArcs, RightArcs);
  DeallocateArcSet (LeftArcs);
  DeallocateArcSet (RightArcs);
  UnionOfDirectedGraphs := CreateDirectedGraph (V, E);
  DeallocateVertexSet (V);
  DeallocateArcSet (E)
end;

function IntersectionOfDirectedGraphs (LeftOperand, RightOperand:
  DirectedGraph): DirectedGraph; 
var
  LeftVertices, RightVertices: VertexSet;
    { the vertex sets of the left and right operands }
  LeftArcs, RightArcs: ArcSet;
    { the arc sets of the left and right operands }
  V: VertexSet;
  E: ArcSet;
    { the vertex and arc sets of the result }
begin
  LeftVertices := VerticesOfDirectedGraph (LeftOperand);
  RightVertices := VerticesOfDirectedGraph (RightOperand);
  V := IntersectionOfVertexSets (LeftVertices, RightVertices);
  DeallocateVertexSet (LeftVertices);
  DeallocateVertexSet (RightVertices);
  LeftArcs := ArcsOfDirectedGraph (LeftOperand);
  RightArcs := ArcsOfDirectedGraph (RightOperand);
  E := IntersectionOfArcSets (LeftArcs, RightArcs);
  DeallocateArcSet (LeftArcs);
  DeallocateArcSet (RightArcs);
  IntersectionOfDirectedGraphs := CreateDirectedGraph (V, E);
  DeallocateVertexSet (V);
  DeallocateArcSet (E)
end;

function ComplementOfDirectedGraph (Operand: DirectedGraph):
  DirectedGraph;
var
  OperandArcs: ArcSet;
    { the arc set of Operand }
  V: VertexSet;
  E: ArcSet;
    { the vertex and arc sets of the result }

  procedure ConditionallyAdjoinOutgoingArcs (Start: Vertex);

    procedure ConditionallyAdjoinArc (Finish: Vertex);
    var
      A: Arc;
    begin
      A := CreateArc (Start, Finish);
      if not MemberOfArcSet (A, OperandArcs) then
        ReplaceArcSet (E, AdjoinToArcSet (E, A));
      DeallocateArc (A)
    end;

  begin { procedure ConditionallyAdjoinOutgoingArcs }
    ApplyToEachMemberOfVertexSet (V, ConditionallyAdjoinArc)
  end;

begin { function ComplementOfDirectedGraph }
  V := VerticesOfDirectedGraph (Operand);
  OperandArcs := ArcsOfDirectedGraph (Operand);
  E := TheEmptyArcSet;
  ApplyToEachMemberOfVertexSet (V, ConditionallyAdjoinOutgoingArcs);
  ComplementOfDirectedGraph := CreateDirectedGraph (V, E);
  DeallocateVertexSet (V);
  DeallocateArcSet (E)
end;
The converse of a directed graph has the same vertex set, but in the converse every arc of the original graph is reversed, so that it points in the other direction. An arc from vertex u to vertex v in the original graph corresponds to an arc from vertex v to vertex u in the converse.

function ConverseOfDirectedGraph (Operand: DirectedGraph): DirectedGraph;
var
  OperandArcs: ArcSet;
    { the arc set of Operand }
  V: VertexSet;
  E: ArcSet;
    { the vertex and arc sets of the result }

  procedure AdjoinReversedArc (A: Arc);
  var
    Start, Finish: Vertex;
      { the endpoints of A }
    AReversed: Arc;
  begin
    Start := SourceOfArc (A);
    Finish := TargetOfArc (A);
    AReversed := CreateArc (Finish, Start);
    DeallocateVertex (Start);
    DeallocateVertex (Finish);
    ReplaceArcSet (E, AdjoinToArcSet (E, AReversed));
    DeallocateArc (AReversed)
  end;

begin { function ConverseOfDirectedGraph }
  V := VerticesOfDirectedGraph (Operand);
  OperandArcs := ArcsOfDirectedGraph (Operand);
  E := TheEmptyArcSet;
  ApplyToEachMemberOfArcSet (OperandArcs, AdjoinReversedArc);
  ConverseOfDirectedGraph := CreateDirectedGraph (V, E);
  DeallocateVertexSet (V);
  DeallocateArcSet (E)
end;
A directed graph is symmetric -- in effect, it is an undirected graph -- if it is a subgraph of its own converse. (Any two vertices of a symmetric graph are either connected by an arc in each direction or not connected at all. In either case, taking the converse gives you a result indistinguishable from the original.)

function SymmetricDirectedGraph (Operand: DirectedGraph): Boolean;
var
  Converse: DirectedGraph;
begin
  Converse := ConverseOfDirectedGraph (Operand);
  SymmetricDirectedGraph := Subgraph (Operand, Converse);
  DeallocateDirectedGraph (Converse)
end;
The identity graph for a given set of vertices represents the relationship of identity: each vertex bears this relation to itself, but to no other vertex. So the graph consists of nothing but loops -- for each vertex, there is an arc from that vertex to itself.

function IdentityDirectedGraph (V: VertexSet): DirectedGraph;
var
  E: ArcSet;

  procedure AdjoinLoopToE (Vert: Vertex);
  var
    Loop: Arc;
  begin
    Loop := CreateArc (Vert, Vert);
    ReplaceArcSet (E, AdjoinToArcSet (E, Loop));
    DeallocateArc (Loop)
  end;

begin { function IdentityDirectedGraph }
  E := TheEmptyArcSet;
  ApplyToEachMemberOfVertexSet (V, AdjoinLoopToE);
  IdentityDirectedGraph := CreateDirectedGraph (V, E);
  DeallocateArcSet (E)
end;
A graph is said to be reflexive if the identity graph of its vertex set is a subgraph of it (that is, if there is a loop at every vertex in it):

function ReflexiveDirectedGraph (Operand: DirectedGraph): Boolean;
var
  V: VertexSet;
    { the vertex set of Operand }
  Id: DirectedGraph;
    { the identity graph on V }
begin
  V := VerticesOfDirectedGraph (Operand);
  Id := IdentityDirectedGraph (V);
  DeallocateVertexSet (V);
  ReflexiveDirectedGraph := Subgraph (Id, Operand);
  DeallocateDirectedGraph (Id)
end;
The relational product of two directed graphs expresses a sort of compound relation; there is an arc from vertex u to vertex v in the relational product of graphs G and H if there is some vertex w, common to both graphs, such that there is an arc from u to w in G and an arc from w to v in H. Suppose, for instance, that the vertices in G and H are people -- all the people who have ever lived, for instance -- and that in G there is an arc from each person to each of his or her parents, while in H there is an arc from each perons to each of his or her sisters (if any). In the relational product of G and H, there would be an arc from each person to each of his or her aunts. (And in the relational product of G with itself, there would be an arc from each person to each of his or her grandparents.)

function RelationalProductOfDirectedGraphs (LeftOperand, RightOperand:
  DirectedGraph): DirectedGraph;
var
  LeftVertices, RightVertices: VertexSet;
    { the vertex sets of the left and right operands }
  V: VertexSet;
  E: ArcSet;
    { the vertex and arc sets of the result }

  procedure AdjoinImagesOfSuccessors (Start: Vertex);
  var
    Media: VertexSet;
      { the successors of Start in LeftOperand, from which those that
        are not vertices of RightOperand are taken away }
    Correlates: VertexSet;
      { the image of those successors -- the vertices to which an arc
        from Start must run in the relational product }

    procedure AdjoinToE (Finish: Vertex);
    var
      A: Arc;
    begin
      A := CreateArc (Start, Finish);
      ReplaceArcSet (E, AdjoinToArcSet (E, A));
      DeallocateArc (A)
    end;

  begin { procedure AdjoinImagesOfSuccessors }
    Media := Successors (LeftOperand, Start);
    ReplaceVertexSet (Media,
                      IntersectionOfVertexSets (Media, RightVertices));
    Correlates := Image (RightOperand, Media);
    DeallocateVertexSet (Media);
    ApplyToEachMemberOfVertexSet (Correlates, AdjoinToE);
    DeallocateVertexSet (Correlates)
  end;

begin { function RelationalProductOfDirectedGraphs }
  LeftVertices := VerticesOfDirectedGraph (LeftOperand);
  RightVertices := VerticesOfDirectedGraph (RightOperand);
  V := UnionOfVertexSets (LeftVertices, RightVertices);
  E := TheEmptyArcSet;
  ApplyToEachMemberOfVertexSet (LeftVertices, AdjoinImagesOfSuccessors);
  DeallocateVertexSet (LeftVertices);
  DeallocateVertexSet (RightVertices);
  RelationalProductOfDirectedGraphs := CreateDirectedGraph (V, E);
  DeallocateVertexSet (V);
  DeallocateArcSet (E)
end;
A graph is transitive if its relational product with itself is a subgraph of itself (so that whenever it contains an arc from u to v and an arc from v to w, it also contains an arc directly from u to w): 
function TransitiveDirectedGraph (Operand: DirectedGraph): Boolean;
var
  Square: DirectedGraph;
begin
  Square := RelationalProductOfDirectedGraphs (Operand, Operand);
  TransitiveDirectedGraph := Subgraph (Square, Operand);
  DeallocateDirectedGraph (Square)
end;
A graph is antisymmetric if no two distinct vertices are connected by arcs each way, or, equivalently, if the intersection of the graph and its converse is a subgraph of the identity graph on its vertices:

function AntisymmetricDirectedGraph (Operand: DirectedGraph): Boolean;
var
  Converse: DirectedGraph;
  IntersectionWithConverse: DirectedGraph;
  OperandVertices: VertexSet;
  Id: DirectedGraph;
begin
  Converse := ConverseOfDirectedGraph (Operand);
  IntersectionWithConverse :=
                      IntersectionOfDirectedGraphs (Operand, Converse);
  DeallocateDirectedGraph (Converse);
  OperandVertices := VerticesOfDirectedGraph (Operand);
  Id := IdentityDirectedGraph (OperandVertices);
  DeallocateVertexSet (OperandVertices);
  AntisymmetricDirectedGraph := Subgraph (IntersectionWithConverse, Id);
  DeallocateDirectedGraph (IntersectionWithConverse);
  DeallocateDirectedGraph (Id)
end;
A graph is a partial ordering on its vertex set if it is reflexive, antisymmetric, and transitive:

function PartialOrdering (Operand: DirectedGraph): Boolean;
begin
  if not ReflexiveDirectedGraph (Operand) then
    PartialOrdering := False
  else if not AntisymmetricDirectedGraph (Operand) then
    PartialOrdering := False
  else
    PartialOrdering := TransitiveDirectedGraph (Operand)
end;
The difference between a partial and a total ordering is that in a partial ordering there may be some pairs of distinct vertices that are not connected by arcs, whereas in a total ordering there are none -- the complete graph on the vertex set is a subgraph of the union of the graph and its converse.

function TotalOrdering (Operand: DirectedGraph): Boolean;
var
  Converse: DirectedGraph;
  UnionWithconverse: DirectedGraph;
  OperandVertices: VertexSet;
  Complete: DirectedGraph;
begin
  if not PartialOrdering (Operand) then
    TotalOrdering := False
  else begin
    Converse := ConverseOfDirectedGraph (Operand);
    UnionWithConverse := UnionOfDirectedGraphs (Operand, Converse);
    DeallocateDirectedGraph (Converse);
    OperandVertices := VerticesOfDirectedGraph (Operand);
    Complete := CompleteGraph (OperandVertices);
    DeallocateVertexSet (OperandVertices);
    TotalOrdering := Subgraph (Complete, UnionWithConverse);
    DeallocateDirectedGraph (UnionWithConverse);
    DeallocateDirectedGraph (Complete)
  end
end;
The relationship expressed by a graph is an equivalence if the graph is reflexive, symmetric, and transitive. An equivalence divides the vertex set of the graph into one or more subsets in such a way that the members of each subset are all related to one another, but no vertices in different subsets are related at all; these subsets are called the equivalence classes induced by the relation. 
function Equivalence (Operand: DirectedGraph): Boolean;
begin
  if not ReflexiveDirectedGraph (Operand) then
    Equivalence := False
  else if not SymmetricDirectedGraph (Operand) then
    Equivalence := False
  else
    Equivalence := TransitiveDirectedGraph (Operand)
end;
It would, of course, be possible to design a module in which all of these operations were defined and exported.

created December 2, 1996
last revised December 4, 1996

John David Stone (stone@math.grin.edu)