1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
|
(*
* Subgraph adaptor. This restricts the view of a graph.
*
* -- Allen
*)
signature SUBGRAPH_VIEW =
sig
(* Node induced subgraph *)
val subgraph_view : Graph.node_id list ->
('e Graph.edge -> bool) ->
('n,'e,'g) Graph.graph ->
('n,'e,'g) Graph.graph
end
structure SubgraphView : SUBGRAPH_VIEW =
struct
structure G = Graph
fun subgraph_view nodes edge_pred (G.GRAPH G) =
let val set = IntHashTable.mkTable(32,G.NotFound)
val ins = IntHashTable.insert set
val ins = fn i => ins (i,true)
fun rmv r = (IntHashTable.remove set r; ()) handle _ => ()
fun find r = getOpt(IntHashTable.find set r,false)
val _ = app ins nodes
fun edge_p (e as (i,j,_)) = find i andalso find j andalso edge_pred e
fun check i = if find i then () else raise G.Subgraph
fun check_edge e = if edge_p e then () else raise G.Subgraph
fun add_node (n as (i,_)) = (ins i; #add_node G n)
fun add_edge (e as (i,j,_)) = (check i; check j; #add_edge G e)
fun remove_node i = (check i; rmv i; #remove_node G i)
fun set_out_edges (i,es) =
(check i; app check_edge es; #set_out_edges G (i,es))
fun set_in_edges (j,es) =
(check j; app check_edge es; #set_in_edges G (j,es))
fun get_nodes () = map (fn (i,_) => (i,#node_info G i))
(IntHashTable.listItemsi set)
fun get_edges () =
let fun find_edges([],l) = l
| find_edges(e::es,l) =
if edge_p e then find_edges(es,e::l) else find_edges(es,l)
in foldr (fn ((i,_),l) => find_edges(#out_edges G i,l)) []
(IntHashTable.listItemsi set)
end
fun order () = IntHashTable.numItems set
fun size () =
let fun find_edges([],n) = n
| find_edges(e::es,n) =
if edge_p e then find_edges(es,n+1) else find_edges(es,n)
in foldr (fn ((i,_),n) => find_edges(#out_edges G i,n)) 0
(IntHashTable.listItemsi set)
end
fun out_edges i = (List.filter edge_p (#out_edges G i))
fun in_edges i = (List.filter edge_p (#in_edges G 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 andalso find j
fun has_node i = find i
fun node_info i = (check i; #node_info G i)
fun entry_edges i = (List.filter(fn (j,_,_) => not(find j))
(#in_edges G i))
fun exit_edges i = (List.filter(fn (_,j,_) => not(find j))
(#out_edges G i))
fun entries() = foldr (fn ((i,_),l) =>
if List.exists (fn (j,_,_) => not(find j))
(#in_edges G i) then i::l else l) []
(IntHashTable.listItemsi set)
fun exits() = foldr (fn ((i,_),l) =>
if List.exists (fn (_,j,_) => not(find j))
(#out_edges G i) then i::l else l) []
(IntHashTable.listItemsi set)
fun forall_nodes f = IntHashTable.appi (fn (i,_) => f(i,#node_info G i)) set
fun forall_edges f = IntHashTable.appi (fn (i,_) => app (fn e =>
if edge_p e then f e else ())
(#out_edges G i)) set
in
G.GRAPH
{ name = #name G,
graph_info = #graph_info G,
new_id = #new_id G,
add_node = add_node,
add_edge = add_edge,
remove_node = remove_node,
set_in_edges = set_in_edges,
set_out_edges = set_out_edges,
set_entries = fn _ => raise G.Readonly,
set_exits = fn _ => raise G.Readonly,
garbage_collect = #garbage_collect G,
nodes = get_nodes,
edges = get_edges,
order = order,
size = size,
capacity = #capacity G,
out_edges = out_edges,
in_edges = in_edges,
succ = get_succ,
pred = get_pred,
has_edge = has_edge,
has_node = has_node,
node_info = node_info,
entries = entries,
exits = exits,
entry_edges = entry_edges,
exit_edges = exit_edges,
forall_nodes = forall_nodes,
forall_edges = forall_edges
(*
fold_nodes = fold_nodes,
fold_edges = fold_edges
*)
}
end
end
|
