{ This module defines an interface for a graph data type and implements it
  for HP 9000 Series 700 workstations under HP-UX 9.x, using HP Pascal.
  It presupposes that the vertices of the graphs it works with are members
  of an enumerated type specified below.

  Programmer: John Stone, Grinnell College.
  Original version: April 11, 1996.
}

{ The dispose() procedure does not actually recycle storage unless the
  HEAP_DISPOSE compiler option is turned on. }

$heap_dispose on$

module graphs;

export

  type
    vertex = (supermarket, library, clothing_store, post_office,
              police_station, donut_shop, drug_store);
    vertex_set = set of vertex;
    graph = ^adjacency_matrix;

  { The empty_graph function returns a graph containing no edges. }

  function empty_graph: graph;

  { The complete_graph function returns a graph in which there is an edge
    from every vertex to every other vertex within a specified set of
    vertices. } 

  function complete_graph (vs: vertex_set): graph;

  { The add_edge procedure adds to a given graph an edge from one specified
    vertex to another.  If such an edge is already present, the graph is
    not changed. }

  procedure add_edge (var g: graph; source, target: vertex);

  { The delete_edge procedure removes from a given graph an edge from one
    specified vertex to another.  If no such edge is in the graph, it
    is not changed. }

  procedure delete_edge (var g: graph; source, target: vertex);

  { The graph_union function constructs and returns a graph containing
    all of the edges that are in either of two given graphs. }

  function graph_union (g1, g2: graph): graph;

  { The graph_intersection function constructs and returns a graph
    containing those edges that are common to two given graphs. }

  function graph_intersection (g1, g2: graph): graph;

  { The graph_complement function constructs and returns a graph that
    includes an edge from vertex a to vertex b if, and only if, a given
    graph does _not_ contain such an edge. }

  function graph_complement (g: graph): graph;

  { The deallocate_graph procedure recycles any dynamic storage associated
    with a graph.  (But in this implementation there is none, so
    deallocate_graph does nothing whatever.) }

  procedure deallocate_graph (var g: graph);

  { The edge_exists function determines whether there is an edge in a given
    graph from one specified vertex to another. }

  function edge_exists (g: graph; source, target: vertex): Boolean;

  { The path_exists function determines whether there is a path in a
    given graph from one specified vertex to another. }

  function path_exists (g: graph; source, target: vertex): Boolean;

  { The is_connected function determines whether a given graph is
    connected. }

  function is_connected (g: graph): Boolean;

  { The is_subgraph function determines whether one graph is a subgraph of
    another (on the same set of vertices). }

  function is_subgraph (g1, g2: graph): Boolean;

  { The in_degree function determines how many edges there are in a given
    graph that terminate at a specified vertex. }

  function in_degree (g: graph; target: vertex): integer;

  { The out_degree function determines how many edges there are in a given
    graph that originate at a specified vertex. }

  function out_degree (g: graph; source: vertex): integer;

  { The is_functional function determines whether a graph, considered as a
    representation of a relation, represents a relation that is
    ``functional'' -- one in which at most one edge originates at each
    vertex. }

  function is_functional (g: graph): Boolean;

  { The converse_graph function constructs and returns a graph that is the
    converse of a given graph, in the sense that wherever the original
    graph has an edge from vertex a to vertex b, the converse has an edge
    from vertex b to vertex a, and vice versa. }

  function converse (g: graph): graph;

  { The is_bijection function determines whether a graph represents a
    ``bijection,'' or one-to-one correspondence. }

  function is_bijection (g: graph): Boolean;

  { The left_field function constructs and returns the set of vertices at
    which edges originate in a given graph. }

  function left_field (g: graph): vertex_set;

  { The right_field function constructs and returns the set of vertices at
    which edges terminate in a given graph. }

  function right_field (g: graph): vertex_set;

  { The correlates function constructs and returns the set of vertices that
    are adjacent to a given vertex in a given graph, in the sense that
    there is an edge from the given vertex to any member of the set of
    correlates. }

  function correlates (g: graph; source: vertex): vertex_set;

  { The image function constructs and returns the ``image'' of a given set
    under the relation expressed by a given graph -- a set containing all
    of the correlates of the members of the set. }

  function image (g: graph; sources: vertex_set): vertex_set;

  { The relational_product function constructs and returns the relational
    product of two given graphs.  In the relational product of g1 and g2,
    there is an edge from vertex a to vertex b if, and only if, there is
    some vertex c such that there is an edge from a to c in g1 and an edge
    from c to b in g2. }

  function relational_product (g1, g2: graph): graph;

  { The is_transitive function determines whether a given graph is
    transitive, in the sense that whenever there is an edge from vertex a
    to vertex b, and also an edge from vertex b to vertex c, there is an
    edge directly from a to c. }

  function is_transitive (g: graph): Boolean;

  { The is_reflexive function determines whether a given graph is reflexive
    on a given set of vertices, in the sense that it contains an edge from
    each of those vertices to itself. }

  function is_reflexive (g: graph; domain: vertex_set): Boolean;

  { The is_symmetric function determines whether a given graph is
    symmetric, in the sense that whenever there is an edge from vertex a
    to vertex b, there is also an edge from vertex b to vertex a.  (A
    symmetric graph is called a ``simple graph'' in the textbook.) }

  function is_symmetric (g: graph): Boolean;

  { The is_antisymmetric function determines whether a given graph is
    antisymmetric, in the sense that whenever there is an edge from one
    vertex a to a different vertex b, there is no edge from b to a. }

  function is_antisymmetric (g: graph): Boolean;

  { The is_partial_ordering function determines whether a given graph
    partially orders its vertices.  A partial ordering is transitive
    and antisymmetric. }

  function is_partial_ordering (g: graph): Boolean;

  { The is_total_ordering function determines whether a given graph
    completely determines a linear ordering of its vertices, specifying
    which of each pair of vertices comes first. }

  function is_total_ordering (g: graph): Boolean;

  { The is_equivalence function determines whether a given graph is an
    equivalence relation, that is, one that partitions its vertices into
    one or more complete subgraphs. }

  function is_equivalence (g: graph): Boolean;

implement

  const
    first_vertex = supermarket;
    last_vertex = drug_store;

  type
    adjacency_matrix = array [vertex, vertex] of Boolean;

  function empty_graph: graph;
  var
    result: graph;
      { a pointer to the matrix to be returned }
    source, target: vertex;
      { run through all the possible pairs of vertices }
  begin
    new (result);
    for source := first_vertex to last_vertex do
      for target := first_vertex to last_vertex do
        result^[source, target] := FALSE;
    empty_graph := result
  end;

  function complete_graph (vs: vertex_set): graph;
  var
    result: graph;
      { a pointer to the matrix to be returned }
    source, target: vertex;
      { run through all the possible pairs of vertices }
  begin
    new (result);
    for source := first_vertex to last_vertex do
      for target := first_vertex to last_vertex do
        result^[source, target] := (source in vs) and (target in vs) and
                                   (source <> target);
    complete_graph := result
  end;

  procedure add_edge (var g: graph; source, target: vertex);
  begin
    g^[source, target] := TRUE
  end;

  procedure delete_edge (var g: graph; source, target: vertex);
  begin
    g^[source, target] := FALSE
  end;

  function graph_union (g1, g2: graph): graph;
  var
    result: graph;
      { a pointer to the matrix to be returned }
    source, target: vertex;
      { run through all the possible pairs of vertices }
  begin
    new (result);
    for source := first_vertex to last_vertex do
      for target := first_vertex to last_vertex do
        result^[source, target] :=
            g1^[source, target] or g2^[source, target];
    graph_union := result
  end;

  function graph_intersection (g1, g2: graph): graph;
  var
    result: graph;
      { a pointer to the matrix to be returned }
    source, target: vertex;
      { run through all the possible pairs of vertices }
  begin
    new (result);
    for source := first_vertex to last_vertex do
      for target := first_vertex to last_vertex do
        result^[source, target] :=
            g1^[source, target] and g2^[source, target];
    graph_intersection := result
  end;

  function graph_complement (g: graph): graph;
  var
    result: graph;
      { a pointer to the matrix to be returned }
    source, target: vertex;
      { run through all the possible pairs of vertices }
  begin
    new (result);
    for source := first_vertex to last_vertex do
      for target := first_vertex to last_vertex do
        result^[source, target] := not g^[source, target];
    graph_complement := result
  end;

  procedure deallocate_graph (var g: graph);
  begin
    dispose (g);
    g := NIL
  end;

  function edge_exists (g: graph; source, target: vertex): Boolean;
  begin
    edge_exists := g^[source, target]
  end;

  function path_exists (g: graph; source, target: vertex): Boolean;

    { The p_e_excluding function determines whether there is a path in the
      graph g from a specified vertex (stage) to the ultimate target
      vertex that does not include any of the vertices in a specified
      vertex set.  (This vertex set contains vertices that have already
      been added to a path from the original source vertex to the current
      stage.) }

    function p_e_excluding (stage: vertex; excluded: vertex_set): Boolean;
    label
      99;
        { bail out as soon as a path is detected }
    var
      next_stage: vertex;
        { a vertex adjacent to stage }
    begin
      if stage = target then
        p_e_excluding := TRUE
      else begin
        for next_stage := first_vertex to last_vertex do
          if g^[stage, next_stage] and not (next_stage in excluded) then
            if p_e_excluding (next_stage, excluded + [stage]) then begin
              p_e_excluding := TRUE;
              goto 99
            end;
        p_e_excluding := FALSE
      end;
    99:
    end;

  begin { path_exists }
    path_exists := p_e_excluding (source, [])
  end;

  function is_connected (g: graph): Boolean;
  label
    99;
      { bail out when a pair of vertices not connected by a (directed)
        path is encountered }
  var
    source, target: vertex;
      { run through all the possible pairs of vertices }
  begin
    for source := first_vertex to last_vertex do
      for target := first_vertex to last_vertex do
        if not path_exists (g, source, target) then begin
          is_connected := FALSE;
          goto 99
        end;
    is_connected := TRUE;
  99:
  end;
    
  function is_subgraph (g1, g2: graph): Boolean;
  label
    99;
      { bail out when an edge in g1 that is not in g2 is encountered }
  var
    source, target: vertex;
      { run through all the possible pairs of vertices }
  begin
    for source := first_vertex to last_vertex do
      for target := first_vertex to last_vertex do
        if g1^[source, target] and not g2^[source, target] then begin
          is_subgraph := FALSE;
          goto 99
        end;
    is_subgraph := TRUE;
  99:
  end;

  function in_degree (g: graph; target: vertex): integer;
  var
    result: integer;
      { a tally of the edges terminating at target }
    source: vertex;
      { runs through possible origination points for such edges }
  begin
    result := 0;
    for source := first_vertex to last_vertex do
      if g^[source, target] then
        result := result + 1;
    in_degree := result
  end;

  function out_degree (g: graph; source: vertex): integer;
  var
    result: integer;
      { a tally of the edges originating at source }
    target: vertex;
      { runs through possible termination points for such edges }
  begin
    result := 0;
    for target := first_vertex to last_vertex do
      if g^[source, target] then
        result := result + 1;
    out_degree := result
  end;

  function is_functional (g: graph): Boolean;
  label
    99;
      { bail out if a vertex with two edges leading out of it is detected }
  var
    source, target: vertex;
      { run through all the possible pairs of vertices }
    edge_found: Boolean;
      { indicates whether an edge originating at the current source vertex
        has already been detected }
  begin
    for source := first_vertex to last_vertex do begin
      edge_found := FALSE;
      for target := first_vertex to last_vertex do
        if not edge_found then
          edge_found := g^[source, target]
        else if g^[source, target] then begin
          is_functional := FALSE;
          goto 99
        end
    end;
    is_functional := TRUE;
  99:
  end;

  function converse (g: graph): graph;
  var
    result: graph;
      { a pointer to the matrix to be returned }
    source, target: vertex;
      { run through all the possible pairs of vertices }
  begin
    new (result);
    for source := first_vertex to last_vertex do
      for target := first_vertex to last_vertex do
        result^[source, target] := g^[target, source];
    converse := result
  end;

  function is_bijection (g: graph): Boolean;
  var
    g_prime: graph;
      { the converse of g }
  begin
    if is_functional (g) then begin
      g_prime := converse (g);
      is_bijection := is_functional (g_prime);
      deallocate_graph (g_prime)
    end
    else
      is_bijection := FALSE
  end;

  function left_field (g: graph): vertex_set;
  label
    9;
      { stop looking for edges originating from a vertex when such an
        edge has been found }
  var
    result: vertex_set;
      { accumulates the elements of the left field }
    source, target: vertex;
      { run through all the possible pairs of vertices }
  begin
    result := [];
    for source := first_vertex to last_vertex do begin
      for target := first_vertex to last_vertex do
        if g^[source, target] then begin
          result := result + [source];
          goto 9
        end;
    9:
    end;
    left_field := result
  end;

  function right_field (g: graph): vertex_set;
  label
    9;
      { stop looking for edges terminating at a vertex when such an
        edge has been found }
  var
    result: vertex_set;
      { accumulates the elements of the right field }
    source, target: vertex;
      { run through all the possible pairs of vertices }
  begin
    result := [];
    for target := first_vertex to last_vertex do begin
      for source := first_vertex to last_vertex do
        if g^[source, target] then begin
          result := result + [target];
          goto 9
        end;
    9:
    end;
    right_field := result
  end;

  function correlates (g: graph; source: vertex): vertex_set;
  var
    result: vertex_set;
      { accumulates the correlates }
    target: vertex;
      { runs through all the possible terminations }
  begin
    result := [];
    for target := first_vertex to last_vertex do
      if g^[source, target] then
        result := result + [target];
    correlates := result
  end;

  function image (g: graph; sources: vertex_set): vertex_set;
  var
    result: vertex_set;
      { accumulates the image }
    source: vertex;
      { runs through all the members of the sources set }
  begin
    result := [];
    for source := first_vertex to last_vertex do
      if source in sources then
        result := result + correlates (g, source);
    image := result
  end;

  function relational_product (g1, g2: graph): graph;
  var
    result: graph;
      { the product graph, as it is constructed }
    source, target: vertex;
      { run through all the possible pairs of vertices }
    relata: vertex_set;
      { the set of vertices to which a given source vertex is related in
        the product }
  begin
    new (result);
    for source := first_vertex to last_vertex do begin
      relata := image (g2, correlates (g1, source));
      for target := first_vertex to last_vertex do
        result^[source, target] := target in relata
    end;
    relational_product := result
  end;

  function is_transitive (g: graph): Boolean;
  var
    prod: graph;
      { a graph in which there is an edge from vertex a to vertex c just in
        case the original graph contains an edge from a to some vertex b
        and an edge from b to c }
  begin
    prod := relational_product (g, g);
    is_transitive := is_subgraph (prod, g);
    deallocate_graph (prod)
  end;

  function is_reflexive (g: graph; domain: vertex_set): Boolean;
  label
    99;
      { bail out if a vertex is found in the domain without an edge from
        itself to itself }
  var
    v: vertex;
      { runs through the vertices in the domain }
  begin
    for v := first_vertex to last_vertex do
      if (v in domain) and not g^[v, v] then begin
        is_reflexive := FALSE;
        goto 99
      end;
    is_reflexive := TRUE;
  99:
  end;

  function is_symmetric (g: graph): Boolean;
  label
    99;
      { bail out if an edge is found with no converse edge }
  var
    source, target: vertex;
      { run through all the possible pairs of vertices }
  begin
    for source := first_vertex to pred (last_vertex) do
      for target := succ (source) to last_vertex do
        if g^[source, target] <> g^[target, source] then begin
          is_symmetric := FALSE;
          goto 99
        end;
    is_symmetric := TRUE;
  99:
  end;

  function is_antisymmetric (g: graph): Boolean;
  label
    99;
      { bail out if an edge is found with a converse edge }
  var
    source, target: vertex;
      { run through all the possible pairs of vertices }
  begin
    for source := first_vertex to last_vertex do
      for target := first_vertex to last_vertex do
        if g^[source, target] and g^[target, source] and
            (source <> target) then begin
          is_antisymmetric := FALSE;
          goto 99
        end;
    is_antisymmetric := TRUE;
  99:
  end;

  function is_partial_ordering (g: graph): Boolean;
  begin
    is_partial_ordering := is_transitive (g) and is_antisymmetric (g)
  end;

  function is_total_ordering (g: graph): Boolean;
  label
    99;
      { bail out if two vertices are found that are not connected by
        exactly one edge }
  var
    field: vertex_set;
      { the set of all the vertices connected by the relation }
    source, target: vertex;
      { run through all the possible pairs of vertices }
  begin
    field := left_field (g) + right_field (g);
    for source := first_vertex to last_vertex do
      if source in field then
        for target := first_vertex to last_vertex do
          if (target in field) and (g^[source, target] = g^[target, source])
               and (source <> target) then begin
            is_total_ordering := FALSE;
            goto 99
          end;
    is_total_ordering := TRUE;
  99:
  end;

  { The is_equivalence function determines whether a given graph is an
    equivalence relation, that is, one that partitions its vertices into
    one or more complete subgraphs. }

  function is_equivalence (g: graph): Boolean;
  begin
    is_equivalence := is_symmetric (g) and is_transitive (g) and
                      is_reflexive (g, left_field (g) + right_field (g))
  end;

end.