PreviousUpNext

15.4.800  src/lib/graph/undirected-graph-g.pkg

## undirected-graph-g.pkg
#
#  Undirected graph in adjacency list format.
#
# For additional background see:
#
#     src/lib/compiler/back/low/doc/latex/graphs.tex
#
# See also:
#
#     src/lib/graph/digraph-by-adjacency-list-g.pkg

# Compiled by:
#     src/lib/graph/graphs.lib

stipulate
    package odg =  oop_digraph;                         # oop_digraph   is from   src/lib/graph/oop-digraph.pkg
herein

    generic package   undirected_graph_g   (
        #             ================== 
        #
        vec:  Rw_Vector
    )
    : (weak) Make_Empty_Graph                           # Make_Empty_Graph      is from   src/lib/graph/make-empty-graph.api
    {

        fun make_empty_graph
              {
                graph_name,                             # Arbitrary client name for graph, for human-display purposes.
                graph_info,                             # Arbitrary client value to associate with graph.
                expected_node_count                     # Hint for initial sizing of internal graph vectors.  This is not a hard limit.
              }
            =
            {   adj           = vec::make_rw_vector (expected_node_count,[]);
                nodes         = vec::make_rw_vector (expected_node_count, NULL);
                #
                node_count    = REF 0;
                edge_count    = REF 0;
                #
                entries       = REF [];
                exits         = REF [];
                new_nodes     = REF [];
                garbage_nodes = REF [];
                #
                fun allot_node_id ()
                    =
                    case *new_nodes
                         []    =>   vec::length nodes;
                         h ! t =>   { new_nodes := t;   h; };
                    esac;

                fun garbage_collect ()
                    =
                    {   new_nodes :=  *new_nodes  @  *garbage_nodes;
                        garbage_nodes := [];
                    };

                fun get_nodes ()
                    =
                    vec::keyed_fold_backward
                        (fn (i, THE n, l) =>  (i, n) ! l;
                            (_,     _, l) =>  l;
                         end)
                        []
                        nodes;


                fun get_edges ()
                    = 
                    vec::keyed_fold_backward
                        (    fn (i, es, l)
                                 =
                                 fold_backward
                                     (fn ((j, e), l)
                                         =
                                         if   (i <= j   )   (i, j, e) ! l;
                                                       else               l;  fi)
                                     l
                                     es
                        )
                        []
                        adj;

                fun order () =   *node_count;
                fun size ()  =   *edge_count;

                fun capacity () =  vec::length nodes;

                fun add_node (i, n)
                    =
                    {   case (vec::get (nodes, i))

                             NULL =>  node_count :=  1 + *node_count;
                             _    =>  ();
                        esac; 

                        vec::set (nodes, i, THE n);
                    };

                fun add_edge (i, j, e)
                    = 
                    {   vec::set (adj, i, (j, e) ! vec::get (adj, i));

                        if   (i != j)
                             vec::set (adj, j, (i, e) ! vec::get (adj, j));
                        fi;

                        edge_count := 1 + *edge_count;
                    };

                fun set_edges (i, edges)
                    =
                    {   fun rmv ([], l) => l;
                            rmv((e as (k, _)) ! es, l) => rmv (es, if (k == i ) l; else e ! l;fi);
                        end;

                        fun add (i, j, e)
                            =
                            if (i != j)
                                #
                                vec::set (adj, j, (i, e) ! vec::get (adj, j));
                            fi;

                        old_edges = vec::get (adj, i);

                        apply
                            (fn (j, _) =  vec::set (adj, j, rmv (vec::get (adj, j),[])))
                            old_edges;

                        apply add edges;

                        vec::set   (adj,   i,   map' edges (fn (_, j, e) =  (j, e)));

                        edge_count :=  *edge_count + length edges - length old_edges;
                    };

                fun remove_node i
                    =
                    case (vec::get (nodes, i))
                        #
                        NULL => ();
                        #
                        THE _ => {   set_edges (i,[]);
                                     vec::set (nodes, i, NULL);
                                     node_count    := *node_count - 1;
                                     garbage_nodes := i ! *garbage_nodes;
                                 };
                    esac;

                fun remove_nodes ns
                    =
                    apply remove_node ns;

                fun set_entries ns
                    =
                    entries := ns;

                fun set_exits ns
                    =
                    exits := ns;

                fun get_entries ()
                    =
                    *entries;

                fun get_exits ()
                    =
                    *exits;

                fun adj_edges i
                    =
                    map
                        (fn (j, e) =  (i, j, e))
                        (vec::get (adj, i));

                fun neighbors i
                    =
                    map #1 (vec::get (adj, i));

                fun has_edge (i, j)
                    =
                    list::exists
                        (fn (k, _) =  j == k)
                        (vec::get (adj, i));

                fun has_node n
                    =
                    case (vec::get (nodes, n))
                        #
                        THE _ =>  TRUE;
                        NULL  =>  FALSE;
                    esac;


                fun node_info n
                    =
                    case (vec::get (nodes, n))
                        #
                        THE x =>  x; 
                        NULL  =>  raise exception odg::NOT_FOUND;
                    esac;

                fun forall_nodes f
                    = 
                    vec::keyed_apply

                        (fn (i, THE x) =>  f (i, x);
                            _          =>  ();
                         end)

                        nodes;

                fun forall_edges f
                    =
                    vec::keyed_apply
                        (fn (i, es)
                            =
                            apply
                            (fn (j, e)
                                =
                                if (i <= j   )   f (i, j, e);   fi)
                            es )
                        adj;

                fun none _ =  [];

                odg::DIGRAPH {
                  name            => graph_name,
                  graph_info,
                  allot_node_id,
                  add_node,
                  add_edge,
                  remove_node,
                  set_in_edges    => set_edges,
                  set_out_edges   => set_edges,
                  set_entries,
                  set_exits,
                  garbage_collect,
                  nodes           => get_nodes,
                  edges           => get_edges,
                  order,
                  size,
                  capacity,
                  out_edges       => adj_edges,
                  in_edges        => adj_edges,
                  next            => neighbors,
                  prior            => neighbors,
                  has_edge,
                  has_node,
                  node_info,
                  entries         => get_entries,
                  exits           => get_exits,
                  entry_edges     => none,
                  exit_edges      => none,
                  forall_nodes,
                  forall_edges
                };
            };                                          # fun graph
    };
end;


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext