200 |
200 |
201 (* join and merge *) |
201 (* join and merge *) |
202 |
202 |
203 fun no_edges (i, _) = (i, ([], [])); |
203 fun no_edges (i, _) = (i, ([], [])); |
204 |
204 |
205 fun join f (Graph tab1, G2 as Graph tab2) = |
205 fun join f (G1 as Graph tab1, G2 as Graph tab2) = |
206 let fun join_node key ((i1, edges1), (i2, _)) = (f key (i1, i2), edges1) |
206 let fun join_node key ((i1, edges1), (i2, _)) = (f key (i1, i2), edges1) in |
207 in fold add_edge (edges G2) (Graph (Table.join join_node (tab1, Table.map no_edges tab2))) end; |
207 if pointer_eq (G1, G2) then G1 |
208 |
208 else fold add_edge (edges G2) (Graph (Table.join join_node (tab1, Table.map no_edges tab2))) |
209 fun gen_merge add eq (Graph tab1, G2 as Graph tab2) = |
209 end; |
210 let fun eq_node ((i1, _), (i2, _)) = eq (i1, i2) |
210 |
211 in fold add (edges G2) (Graph (Table.merge eq_node (tab1, Table.map no_edges tab2))) end; |
211 fun gen_merge add eq (G1 as Graph tab1, G2 as Graph tab2) = |
|
212 let fun eq_node ((i1, _), (i2, _)) = eq (i1, i2) in |
|
213 if pointer_eq (G1, G2) then G1 |
|
214 else fold add (edges G2) (Graph (Table.merge eq_node (tab1, Table.map no_edges tab2))) |
|
215 end; |
212 |
216 |
213 fun merge eq GG = gen_merge add_edge eq GG; |
217 fun merge eq GG = gen_merge add_edge eq GG; |
214 |
218 |
215 |
219 |
216 (* irreducible paths -- Hasse diagram *) |
220 (* irreducible paths -- Hasse diagram *) |
271 fun add_edge_trans_acyclic (x, y) G = |
275 fun add_edge_trans_acyclic (x, y) G = |
272 add_edge_acyclic (x, y) G |
276 add_edge_acyclic (x, y) G |
273 |> fold_product (curry add_edge) (all_preds G [x]) (all_succs G [y]); |
277 |> fold_product (curry add_edge) (all_preds G [x]) (all_succs G [y]); |
274 |
278 |
275 fun merge_trans_acyclic eq (G1, G2) = |
279 fun merge_trans_acyclic eq (G1, G2) = |
276 merge_acyclic eq (G1, G2) |
280 if pointer_eq (G1, G2) then G1 |
277 |> fold add_edge_trans_acyclic (diff_edges G1 G2) |
281 else |
278 |> fold add_edge_trans_acyclic (diff_edges G2 G1); |
282 merge_acyclic eq (G1, G2) |
|
283 |> fold add_edge_trans_acyclic (diff_edges G1 G2) |
|
284 |> fold add_edge_trans_acyclic (diff_edges G2 G1); |
279 |
285 |
280 |
286 |
281 (*final declarations of this structure!*) |
287 (*final declarations of this structure!*) |
282 val fold = fold_graph; |
288 val fold = fold_graph; |
283 |
289 |