6 */ |
6 */ |
7 |
7 |
8 package isabelle |
8 package isabelle |
9 |
9 |
10 |
10 |
|
11 import scala.collection.immutable.{SortedMap, SortedSet} |
11 import scala.annotation.tailrec |
12 import scala.annotation.tailrec |
12 |
13 |
13 |
14 |
14 object Graph |
15 object Graph |
15 { |
16 { |
16 class Duplicate[Key](x: Key) extends Exception |
17 class Duplicate[Key](x: Key) extends Exception |
17 class Undefined[Key](x: Key) extends Exception |
18 class Undefined[Key](x: Key) extends Exception |
18 class Cycles[Key](cycles: List[List[Key]]) extends Exception |
19 class Cycles[Key](cycles: List[List[Key]]) extends Exception |
19 |
20 |
20 private val empty_val: Graph[Any, Nothing] = new Graph[Any, Nothing](Map.empty) |
21 def empty[Key, A](implicit ord: Ordering[Key]): Graph[Key, A] = |
21 def empty[Key, A]: Graph[Key, A] = empty_val.asInstanceOf[Graph[Key, A]] |
22 new Graph[Key, A](SortedMap.empty(ord)) |
22 } |
23 } |
23 |
24 |
24 |
25 |
25 class Graph[Key, A] private(rep: Map[Key, (A, (Set[Key], Set[Key]))]) |
26 class Graph[Key, A] private(rep: SortedMap[Key, (A, (SortedSet[Key], SortedSet[Key]))]) |
26 extends Iterable[(Key, (A, (Set[Key], Set[Key])))] |
27 extends Iterable[(Key, (A, (SortedSet[Key], SortedSet[Key])))] |
27 { |
28 { |
28 type Keys = Set[Key] |
29 type Keys = SortedSet[Key] |
29 type Entry = (A, (Keys, Keys)) |
30 type Entry = (A, (Keys, Keys)) |
30 |
31 |
|
32 def ordering: Ordering[Key] = rep.ordering |
|
33 def empty_keys: Keys = SortedSet.empty[Key](ordering) |
|
34 |
31 override def iterator: Iterator[(Key, Entry)] = rep.iterator |
35 override def iterator: Iterator[(Key, Entry)] = rep.iterator |
32 |
36 |
33 def is_empty: Boolean = rep.isEmpty |
37 def is_empty: Boolean = rep.isEmpty |
34 |
38 |
35 def keys: Set[Key] = rep.keySet.toSet |
39 def keys: List[Key] = rep.keySet.toList |
36 |
40 |
37 def dest: List[(Key, List[Key])] = |
41 def dest: List[(Key, List[Key])] = |
38 (for ((x, (_, (_, succs))) <- iterator) yield (x, succs.toList)).toList |
42 (for ((x, (_, (_, succs))) <- iterator) yield (x, succs.toList)).toList |
39 |
43 |
40 |
44 |
54 |
58 |
55 def get_node(x: Key): A = get_entry(x)._1 |
59 def get_node(x: Key): A = get_entry(x)._1 |
56 |
60 |
57 def map_node(x: Key, f: A => A): Graph[Key, A] = |
61 def map_node(x: Key, f: A => A): Graph[Key, A] = |
58 map_entry(x, { case (i, ps) => (f(i), ps) }) |
62 map_entry(x, { case (i, ps) => (f(i), ps) }) |
59 |
|
60 def map_nodes[B](f: A => B): Graph[Key, B] = |
|
61 new Graph[Key, B](rep mapValues { case (i, ps) => (f(i), ps) }) |
|
62 |
63 |
63 |
64 |
64 /* reachability */ |
65 /* reachability */ |
65 |
66 |
66 /*nodes reachable from xs -- topologically sorted for acyclic graphs*/ |
67 /*nodes reachable from xs -- topologically sorted for acyclic graphs*/ |
79 { |
80 { |
80 val (rss, r_set) = reached |
81 val (rss, r_set) = reached |
81 val (rs, r_set1) = reach((Nil, r_set), x) |
82 val (rs, r_set1) = reach((Nil, r_set), x) |
82 (rs :: rss, r_set1) |
83 (rs :: rss, r_set1) |
83 } |
84 } |
84 ((List.empty[List[Key]], Set.empty[Key]) /: xs)(reachs) |
85 ((List.empty[List[Key]], empty_keys) /: xs)(reachs) |
85 } |
86 } |
86 |
87 |
87 /*immediate*/ |
88 /*immediate*/ |
88 def imm_preds(x: Key): Keys = get_entry(x)._2._1 |
89 def imm_preds(x: Key): Keys = get_entry(x)._2._1 |
89 def imm_succs(x: Key): Keys = get_entry(x)._2._2 |
90 def imm_succs(x: Key): Keys = get_entry(x)._2._2 |
93 def all_succs(xs: List[Key]): List[Key] = reachable(imm_succs, xs)._1.flatten |
94 def all_succs(xs: List[Key]): List[Key] = reachable(imm_succs, xs)._1.flatten |
94 |
95 |
95 /*strongly connected components; see: David King and John Launchbury, |
96 /*strongly connected components; see: David King and John Launchbury, |
96 "Structuring Depth First Search Algorithms in Haskell"*/ |
97 "Structuring Depth First Search Algorithms in Haskell"*/ |
97 def strong_conn: List[List[Key]] = |
98 def strong_conn: List[List[Key]] = |
98 reachable(imm_preds, all_succs(keys.toList))._1.filterNot(_.isEmpty).reverse |
99 reachable(imm_preds, all_succs(keys))._1.filterNot(_.isEmpty).reverse |
99 |
100 |
100 |
101 |
101 /* minimal and maximal elements */ |
102 /* minimal and maximal elements */ |
102 |
103 |
103 def minimals: List[Key] = |
104 def minimals: List[Key] = |
115 /* nodes */ |
116 /* nodes */ |
116 |
117 |
117 def new_node(x: Key, info: A): Graph[Key, A] = |
118 def new_node(x: Key, info: A): Graph[Key, A] = |
118 { |
119 { |
119 if (rep.isDefinedAt(x)) throw new Graph.Duplicate(x) |
120 if (rep.isDefinedAt(x)) throw new Graph.Duplicate(x) |
120 else new Graph[Key, A](rep + (x -> (info, (Set.empty, Set.empty)))) |
121 else new Graph[Key, A](rep + (x -> (info, (empty_keys, empty_keys)))) |
121 } |
122 } |
122 |
123 |
123 def default_node(x: Key, info: A): Graph[Key, A] = |
124 def default_node(x: Key, info: A): Graph[Key, A] = |
124 { |
125 { |
125 if (rep.isDefinedAt(x)) this |
126 if (rep.isDefinedAt(x)) this |
126 else new_node(x, info) |
127 else new_node(x, info) |
127 } |
128 } |
128 |
129 |
129 def del_nodes(xs: List[Key]): Graph[Key, A] = |
130 private def del_adjacent(fst: Boolean, x: Key)(map: SortedMap[Key, Entry], y: Key) |
130 { |
131 : SortedMap[Key, Entry] = |
131 xs.foreach(get_entry) |
|
132 new Graph[Key, A]( |
|
133 (rep -- xs) mapValues { case (i, (preds, succs)) => (i, (preds -- xs, succs -- xs)) }) |
|
134 } |
|
135 |
|
136 private def del_adjacent(fst: Boolean, x: Key)(map: Map[Key, Entry], y: Key): Map[Key, Entry] = |
|
137 map.get(y) match { |
132 map.get(y) match { |
138 case None => map |
133 case None => map |
139 case Some((i, (preds, succs))) => |
134 case Some((i, (preds, succs))) => |
140 map + (y -> (i, if (fst) (preds - x, succs) else (preds, succs - x))) |
135 map + (y -> (i, if (fst) (preds - x, succs) else (preds, succs - x))) |
141 } |
136 } |
170 else this |
165 else this |
171 |
166 |
172 |
167 |
173 /* irreducible paths -- Hasse diagram */ |
168 /* irreducible paths -- Hasse diagram */ |
174 |
169 |
175 private def irreducible_preds(x_set: Set[Key], path: List[Key], z: Key): List[Key] = |
170 private def irreducible_preds(x_set: Keys, path: List[Key], z: Key): List[Key] = |
176 { |
171 { |
177 def red(x: Key)(x1: Key) = is_edge(x, x1) && x1 != z |
172 def red(x: Key)(x1: Key) = is_edge(x, x1) && x1 != z |
178 @tailrec def irreds(xs0: List[Key], xs1: List[Key]): List[Key] = |
173 @tailrec def irreds(xs0: List[Key], xs1: List[Key]): List[Key] = |
179 xs0 match { |
174 xs0 match { |
180 case Nil => xs1 |
175 case Nil => xs1 |