diff --git a/Data/Equivalence/Persistent.hs b/Data/Equivalence/Persistent.hs --- a/Data/Equivalence/Persistent.hs +++ b/Data/Equivalence/Persistent.hs @@ -1,10 +1,10 @@ {-| - Code for manipulation equivalence classes on index types. An 'Equivalence' - is an equivalence relation. The empty equivalence relation is constructed - over a ranges of values using 'emptyEquivalence'. Less discerning - equivalence relations can be obtained with 'equate' and 'equateAll'. - The relation can be tested with 'equiv' and 'equivalent', and canonical - representatives can be chosen with 'repr'. + Code for manipulation of equivalence classes on index types. An + 'Equivalence' is an equivalence relation. The empty equivalence relation + is constructed over a ranges of values using 'emptyEquivalence'. Less + discerning equivalence relations can be obtained with 'equate' and + 'equateAll'. The relation can be tested with 'equiv' and 'equivalent', and + canonical representatives can be chosen with 'repr'. An example follows: @@ -22,6 +22,7 @@ module Data.Equivalence.Persistent ( Equivalence, emptyEquivalence, + domain, repr, equiv, equivalent, @@ -40,6 +41,14 @@ arrayFrom :: (IArray a e, Ix i) => (i,i) -> (i -> e) -> a i e arrayFrom rng f = array rng [ (x, f x) | x <- range rng ] +{- + Convenience method for building "transparent" references. These must + have the property that updating them makes no semantic change in their + value; otherwise, references really need to be created in an IO block. +-} +ref :: a -> IORef a +ref x = unsafePerformIO (newIORef x) + {-| An 'Equivalence' is an equivalence relation on a range of values of some index type. @@ -55,10 +64,17 @@ relation possible. -} emptyEquivalence :: Ix i => (i, i) -> Equivalence i -emptyEquivalence is = unsafePerformIO $ do - v <- newIORef (arrayFrom is id) - return $ Equivalence (arrayFrom is (const 0)) v +emptyEquivalence is = Equivalence (arrayFrom is (const 0)) + (ref (arrayFrom is id)) +{-| + Gets the domain of an equivalence relation, as the ordered pair of index + bounds. +-} +domain :: Ix i => Equivalence i -> (i, i) +domain (Equivalence rs _) = bounds rs + + reprHelper :: Ix i => DiffArray i i -> i -> (DiffArray i i, i) reprHelper ps i | pi == i = (ps, i) @@ -68,16 +84,18 @@ {-| 'repr' gives a canonical representative of the equivalence class containing @x@. It is chosen arbitrarily, but is always the same for a - given 'Equivalence' value. + given class and 'Equivalence' value. If you are using this function, you're probably doing something wrong. Please note that: * The representative chosen depends on the order in which the - equivalence relation was built, and are not always the same for + equivalence relation was built, and is not always the same for values that represent the same relation. + * The representative is not particularly stable. Uses of 'equate' are highly likely to change it. + * If all you need is some representative of the equivalence class, you have to provide one as input to the function anyway, so you may as well use that. @@ -86,8 +104,11 @@ contact me if you have a compelling use for it. -} repr :: Ix i => Equivalence i -> i -> i -repr (Equivalence rs vps) i = unsafePerformIO $ atomicModifyIORef vps f - where f ps = reprHelper ps (ps ! i) +repr (Equivalence rs vps) i = unsafePerformIO $ do + ps <- readIORef vps + let (ps', r) = reprHelper ps (ps ! i) + writeIORef vps ps' + return r {-| Determines if two values are equivalent under the given equivalence @@ -110,21 +131,21 @@ -} equate :: Ix i => i -> i -> Equivalence i -> Equivalence i equate x y (Equivalence rs vps) = unsafePerformIO $ do - (px, py, ps) <- atomicModifyIORef vps $ \ ps -> - let (ps', px) = reprHelper ps x - (ps'', py) = reprHelper ps' y - in (ps'', (px, py, ps'')) - return (go px py ps) + ps <- readIORef vps + let (ps', px) = reprHelper ps x + (ps'', py) = reprHelper ps' y + writeIORef vps ps'' + return (go px py ps'') where go px py ps | px == py = Equivalence rs vps | rx > ry = let ps' = ps // [(py, px)] - in Equivalence rs (unsafePerformIO (newIORef ps')) + in Equivalence rs (ref ps') | rx < ry = let ps' = ps // [(px, py)] - in Equivalence rs (unsafePerformIO (newIORef ps')) + in Equivalence rs (ref ps') | otherwise = let ps' = ps // [(py, px)] rs' = rs // [(px, (rx + 1))] - in Equivalence rs' (unsafePerformIO (newIORef ps')) + in Equivalence rs' (ref ps') where rx = rs ! px ry = rs ! py diff --git a/persistent-equivalence.cabal b/persistent-equivalence.cabal --- a/persistent-equivalence.cabal +++ b/persistent-equivalence.cabal @@ -1,5 +1,5 @@ Name: persistent-equivalence -Version: 0.1.1 +Version: 0.2 Synopsis: Persistent equivalence relations (aka union-find) Description: This is a semi-persistent data structure for equivalence relations (known in the imperative world as union-find @@ -8,10 +8,15 @@ access patterns are used. . The basic idea is as given by Conchon and Filliatre in - their 2007 paper "A persistent union-find data structure." - Unlike the implementation given in the paper, this version - is safe with multiple threads, but does not optimize - for backtracking. + their 2007 paper, \"A persistent union-find data + structure.\" Unlike the implementation given in the + paper, this version is safe with multiple threads, but + does not optimize for backtracking. + . + Version 0.2 removes unnecessary atomic operations when + doing updates that are never semantically meaningful, + hopefully leading to better scalability in a parallel + setting. License: BSD3 License-file: LICENSE Author: Chris Smith