#
# Subgraph adaptor. This restricts the view of a graph.
#
# -- Allen Leung
# Compiled by:
#
src/lib/graph/graphs.libstipulate
package odg = oop_digraph; # oop_digraph is from
src/lib/graph/oop-digraph.pkgherein
api Subgraph_View {
#
# Node induced subgraph:
subgraph_view: List( odg::Node_Id )
->
(odg::Edge(E) -> Bool)
->
odg::Digraph(N,E,G) # Here N,E,G stand stead for the types of client-package-supplied records associated with (respectively) nodes, edges and graphs.
->
odg::Digraph(N,E,G);
};
end;
stipulate
package iht = int_hashtable; # int_hashtable is from
src/lib/src/int-hashtable.pkg package odg = oop_digraph; # oop_digraph is from
src/lib/graph/oop-digraph.pkgherein
package subgraph_view
: (weak) Subgraph_View # Subgraph_View is from
src/lib/graph/subgraph.pkg {
fun subgraph_view nodes edge_pred (odg::DIGRAPH graph)
=
{ set = iht::make_hashtable { size_hint => 32, not_found_exception => odg::NOT_FOUND };
ins = iht::set set;
ins = \\ i = ins (i, TRUE);
fun rmv r
=
iht::drop set r;
fun find r
=
the_else (iht::find set r, FALSE);
apply ins nodes;
fun edge_p (e as (i, j, _))
=
find i and
find j and
edge_pred e;
fun check i
=
if (find i)
#
raise exception odg::SUBGRAPH;
fi;
fun check_edge e
=
if (edge_p e)
#
raise exception odg::SUBGRAPH;
fi;
fun add_node (n as (i, _))
=
{ ins i;
#
graph.add_node n;
};
fun add_edge (e as (i, j, _))
=
{ check i;
check j;
graph.add_edge e;
};
fun remove_node i
=
{ check i;
rmv i;
graph.remove_node i;
};
fun set_out_edges (i, es)
=
{ check i;
apply check_edge es;
graph.set_out_edges (i, es);
};
fun set_in_edges (j, es)
=
{ check j;
apply check_edge es;
graph.set_in_edges (j, es);
};
fun get_nodes ()
=
map
(\\ (i, _)
=
(i, graph.node_info i)
)
(iht::keyvals_list set);
fun get_edges ()
=
{ fun find_edges ([], l)
=>
l;
find_edges (e ! es, l)
=>
if (edge_p e) find_edges (es, e ! l);
else find_edges (es, l); fi;
end;
fold_backward
(\\ ((i, _), l)
=
find_edges (graph.out_edges i, l))
[]
(iht::keyvals_list set);
};
fun order ()
=
iht::vals_count set;
fun size ()
=
{ fun find_edges ([], n)
=>
n;
find_edges (e ! es, n)
=>
if (edge_p e) find_edges (es, n+1);
else find_edges (es, n); fi;
end;
fold_backward
(\\ ((i, _), n) = find_edges (graph.out_edges i, n))
0
(iht::keyvals_list set);
};
fun out_edges i = (list::filter edge_p (graph.out_edges i));
fun in_edges i = (list::filter edge_p (graph.in_edges i));
fun get_succ i = map #2 (out_edges i);
fun get_pred i = map #1 (in_edges i);
fun has_edge (i, j) = find i and find j;
fun has_node i = find i;
fun node_info i
=
{ check i;
graph.node_info i;
};
fun entry_edges i
=
list::filter
(\\ (j, _, _) = not (find j))
(graph.in_edges i);
fun exit_edges i
=
list::filter
(\\ (_, j, _) = not (find j))
(graph.out_edges i);
fun entries ()
=
fold_backward
(\\ ((i, _), l)
=
if (list::exists
(\\ (j, _, _) = not (find j))
(graph.in_edges i))
i ! l;
else l; fi)
[]
(iht::keyvals_list set);
fun exits ()
=
fold_backward
(\\ ((i, _), l)
=
if (list::exists
(\\ (_, j, _) = not (find j))
(graph.out_edges i))
i ! l;
else l; fi)
[]
(iht::keyvals_list set);
fun forall_nodes f
=
iht::keyed_apply
(\\ (i, _) = f (i, graph.node_info i))
set;
fun forall_edges f
=
iht::keyed_apply
(\\ (i, _)
=
apply
(\\ e
=
if (edge_p e ) f e; fi)
(graph.out_edges i))
set;
odg::DIGRAPH
{
name => graph.name,
graph_info => graph.graph_info,
allot_node_id => graph.allot_node_id,
add_node,
add_edge,
remove_node,
set_in_edges,
set_out_edges,
set_entries => \\ _ = raise exception odg::READ_ONLY,
set_exits => \\ _ = raise exception odg::READ_ONLY,
garbage_collect => graph.garbage_collect,
nodes => get_nodes,
edges => get_edges,
order,
size,
capacity => graph.capacity,
out_edges,
in_edges,
next => get_succ,
prior => get_pred,
has_edge,
has_node,
node_info,
entries,
exits,
entry_edges,
exit_edges,
forall_nodes,
forall_edges
# fold_nodes,
# fold_edges
};
};
};
end;