|
@@ -0,0 +1,79 @@
|
|
|
|
+(* Mesh = Zusammenhangskomponente eines einfachen Graphen *)
|
|
|
|
+
|
|
|
|
+structure Mesh =
|
|
|
|
+struct
|
|
|
|
+
|
|
|
|
+ structure OrdInt : ORD_KEY =
|
|
|
|
+ struct
|
|
|
|
+ type ord_key = Int.int
|
|
|
|
+ val compare = Int.compare
|
|
|
|
+ end
|
|
|
|
+
|
|
|
|
+ structure OrdIntPair : ORD_KEY =
|
|
|
|
+ struct
|
|
|
|
+ type ord_key = OrdInt.ord_key * OrdInt.ord_key
|
|
|
|
+ fun compare (i as (i1, i2), j as (j1, j2)) =
|
|
|
|
+ let val (ia, ib) = if i2 < i1 then (i2, i1) else i
|
|
|
|
+ val (ja, jb) = if j2 < j1 then (j2, j1) else j
|
|
|
|
+ in case OrdInt.compare (ia, ja)
|
|
|
|
+ of EQUAL => OrdInt.compare (ib, jb)
|
|
|
|
+ | unequal => unequal
|
|
|
|
+ end
|
|
|
|
+ end
|
|
|
|
+
|
|
|
|
+ structure Set = SplaySetFn (OrdInt)
|
|
|
|
+ structure PairSet = SplaySetFn (OrdIntPair)
|
|
|
|
+
|
|
|
|
+ type mesh = { nodes : Set.set,
|
|
|
|
+ edges : PairSet.set }
|
|
|
|
+ type meshes = mesh list
|
|
|
|
+
|
|
|
|
+ fun find_mesh _ [] = NONE
|
|
|
|
+ | find_mesh id ((mesh : mesh) :: meshes) =
|
|
|
|
+ if Set.member ((#nodes mesh), id)
|
|
|
|
+ then SOME mesh
|
|
|
|
+ else find_mesh id meshes
|
|
|
|
+
|
|
|
|
+ local
|
|
|
|
+ fun add_link' (k as (k1, k2)) [] =
|
|
|
|
+ [{ nodes = Set.add (Set.singleton k1, k2),
|
|
|
|
+ edges = PairSet.singleton k }]
|
|
|
|
+ | add_link' (k as (k1, k2)) ((mesh as { nodes, edges }) :: meshes) =
|
|
|
|
+ if Set.member (nodes, k1)
|
|
|
|
+ then
|
|
|
|
+ if Set.member (nodes, k2)
|
|
|
|
+ then { nodes = nodes,
|
|
|
|
+ edges = PairSet.add (edges, k) }
|
|
|
|
+ :: meshes
|
|
|
|
+ else case find_mesh k2 meshes
|
|
|
|
+ of NONE => { nodes = Set.add (nodes, k2),
|
|
|
|
+ edges = PairSet.add (edges, k) }
|
|
|
|
+ :: meshes
|
|
|
|
+ | SOME { nodes = nodes2, edges = edges2 }
|
|
|
|
+ => { nodes = Set.union (nodes, nodes2),
|
|
|
|
+ edges = PairSet.add
|
|
|
|
+ (PairSet.union (edges, edges2),
|
|
|
|
+ k) }
|
|
|
|
+ :: (List.filter
|
|
|
|
+ (fn m => not (Set.member (#nodes m, k2)))
|
|
|
|
+ meshes)
|
|
|
|
+ else
|
|
|
|
+ if Set.member (nodes, k2)
|
|
|
|
+ then case find_mesh k1 meshes
|
|
|
|
+ of NONE => { nodes = Set.add (nodes, k1),
|
|
|
|
+ edges = PairSet.add (edges, k) }
|
|
|
|
+ :: meshes
|
|
|
|
+ | SOME { nodes = nodes1, edges = edges1 }
|
|
|
|
+ => { nodes = Set.union (nodes, nodes1),
|
|
|
|
+ edges = PairSet.add (PairSet.union (edges, edges1), k) }
|
|
|
|
+ :: (List.filter
|
|
|
|
+ (fn m => not (Set.member (#nodes m, k1)))
|
|
|
|
+ meshes)
|
|
|
|
+ else mesh :: (add_link' k meshes)
|
|
|
|
+ in
|
|
|
|
+ fun add_link (k as (k1, k2)) meshes =
|
|
|
|
+ let val (ka, kb) = if k2 < k1 then (k2, k1) else k
|
|
|
|
+ in add_link' (ka, kb) meshes
|
|
|
|
+ end
|
|
|
|
+ end
|
|
|
|
+end
|