-- | A simple, purely functional implementation of union-find. 
module Nettle.Netkit.UnionFind where

import Data.Set (Set)
import qualified Data.Set as Set

type Partition a = Set (Set a)

discretePartition :: Ord a => [a] -> Partition a
discretePartition xs = Set.fromList [ Set.singleton x | x <- xs ]

unionParts :: Ord a => a -> a -> Partition a -> Partition a
unionParts x y part = 
  let [repX] = Set.toList $ Set.filter (Set.member x) part
      [repY] = Set.toList $ Set.filter (Set.member y) part
  in Set.insert (Set.union repX repY) $ Set.delete repY $ Set.delete repX part
     
finestPartition :: Ord a => [(a,a)] -> Partition a     
finestPartition pairs = 
  foldl (\part (x,y) -> unionParts x y part) (discretePartition items) pairs
  where items = concatMap (\(x,y) -> [x,y]) pairs