## 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.libstipulate
package odg = oop_digraph; # oop_digraph is from src/lib/graph/oop-digraph.pkgherein
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
(\\ (i, THE n, l) => (i, n) ! l;
(_, _, l) => l;
end)
[]
nodes;
fun get_edges ()
=
vec::keyed_fold_backward
( \\ (i, es, l)
=
fold_backward
(\\ ((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
(\\ (j, _) = vec::set (adj, j, rmv (vec::get (adj, j),[])))
old_edges;
apply add edges;
vec::set (adj, i, map' edges (\\ (_, 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
(\\ (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
(\\ (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
(\\ (i, THE x) => f (i, x);
_ => ();
end)
nodes;
fun forall_edges f
=
vec::keyed_apply
(\\ (i, es)
=
apply
(\\ (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;