Added basic path compression in the union-find data structure

src/Bisimulation.hs

@@ -5,29 +5,35 @@ import Data.Map.Strict qualified as Map
 import Data.Sequence qualified as Seq
 
 
--- Dit is niet de echte union-find datastructuur (niet efficient),
--- maar wel erg simpel en beter dan niks.
+-- Dit is niet de echte union-find datastructuur (niet erg efficient),
+-- maar wel simpel en beter dan niks.
 newtype UnionFind x = MkUnionFind { unUnionFind :: Map.Map x x }
 
+-- Alle elementen zijn hun eigen klasse, dit geven we aan met Nothing.
 empty :: UnionFind x
 empty = MkUnionFind Map.empty
 
-root :: Ord x => x -> UnionFind x -> x
-root x uf = case Map.lookup x . unUnionFind $ uf of
-  Nothing -> x
-  Just y -> root y uf
-
+-- Omdat we een pure interface hebben, doen we hier geen path-compression.
 equivalent :: Ord x => x -> x -> UnionFind x -> Bool
-equivalent x y uf = root x uf == root y uf
+equivalent x y (MkUnionFind m) = root x == root y where
+  root z = case Map.lookup z m of
+    Nothing -> z
+    Just w -> root w
 
--- Ik zou eigenlijk naar de grootte van de boompjes moeten kijken
+-- Hier kunnen we wel path-compression doen. We zouden ook nog een rank
+-- optimalisatie kunnen (moeten?) doen. Maar dan moeten we meer onthouden.
 equate :: Ord x => x -> x -> UnionFind x -> UnionFind x
-equate x y uf =
-  let rx = root x uf
-      ry = root y uf
-  in case rx == ry of
-    True -> uf
-    False -> MkUnionFind . Map.insert rx ry . unUnionFind $ uf
+equate x y (MkUnionFind m1) =
+  let (rx, m2) = rootCP x m1 rx
+      (ry, m3) = rootCP y m2 ry
+  in if rx == ry
+      then MkUnionFind m3
+      else MkUnionFind (Map.insert rx ry m3)
+  where
+    rootCP z m r = case Map.lookup z m of
+      Nothing -> (z, m)
+      Just w -> Map.insert z r <$> rootCP w m r
+
 
 
 -- Bisimulatie in 1 machine