diff options
author | Ziv Scully <ziv@mit.edu> | 2014-11-10 22:04:40 -0500 |
---|---|---|
committer | Ziv Scully <ziv@mit.edu> | 2014-11-10 22:04:40 -0500 |
commit | dc5e7102563b9c0714391f86b6dcf852445ee192 (patch) | |
tree | c3d3413da82cff5b180dd917ad98e4963a48d64c /src/union_find_fn.sml | |
parent | 7b94f3433f47e4e5010dc2af6010181da49637e8 (diff) |
Progress towards invalidation based on equalities of fields.
Diffstat (limited to 'src/union_find_fn.sml')
-rw-r--r-- | src/union_find_fn.sml | 47 |
1 files changed, 47 insertions, 0 deletions
diff --git a/src/union_find_fn.sml b/src/union_find_fn.sml new file mode 100644 index 00000000..42b2d4d7 --- /dev/null +++ b/src/union_find_fn.sml @@ -0,0 +1,47 @@ +functor UnionFindFn(K : ORD_KEY) = struct + +structure M = BinaryMapFn(K) +structure S = BinarySetFn(K) + +datatype entry = + Set of S.set + | Pointer of K.ord_key + +(* First map is the union-find tree, second stores equivalence classes. *) +type unionFind = entry M.map ref * S.set M.map + +val empty : unionFind = (ref M.empty, M.empty) + +fun findPair (uf, x) = + case M.find (!uf, x) of + NONE => (S.singleton x, x) + | SOME (Set set) => (set, x) + | SOME (Pointer parent) => + let + val (set, rep) = findPair (uf, parent) + in + uf := M.insert (!uf, x, Pointer rep); + (set, rep) + end + +fun find ((uf, _), x) = (S.listItems o #1 o findPair) (uf, x) + +fun classes (_, cs) = (map S.listItems o M.listItems) cs + +fun union ((uf, cs), x, y) = + let + val (xSet, xRep) = findPair (uf, x) + val (ySet, yRep) = findPair (uf, y) + val xySet = S.union (xSet, ySet) + in + (ref (M.insert (M.insert (!uf, yRep, Pointer xRep), + xRep, Set xySet)), + M.insert (case M.find (cs, yRep) of + NONE => cs + | SOME _ => #1 (M.remove (cs, yRep)), + xRep, xySet)) + end + +fun union' ((x, y), uf) = union (uf, x, y) + +end |