persistent-equivalence (empty) → 0.1

raw patch · 4 files changed

+189/−0 lines, 4 filesdep +arraydep +basedep +diffarraysetup-changed

Dependencies added: array, base, diffarray

Files

• Data/Equivalence/Persistent.hs +130/−0
• LICENSE +30/−0
• Setup.hs +2/−0
• persistent-equivalence.cabal +27/−0

@@ -0,0 +1,130 @@+{-|+    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'.++    An example follows:++    > import Data.Equivalence.Persistent+    >+    > rel = equateAll [1,3,5,7,9]+    >     . equate 5 6+    >     . equate 2 4+    >     $ emptyEquivalence (1,10)+    >+    > test1 = equiv rel 3 5 -- This is True+    > test2 = equiv rel 1 6 -- This is True+    > test3 = equiv rel 4 6 -- This is False+-}+module Data.Equivalence.Persistent (+    Equivalence,+    emptyEquivalence,+    repr,+    equiv,+    equivalent,+    equate,+    equateAll+    )+    where++import Control.Concurrent.MVar+import Control.Monad+import Data.Array.Diff+import Data.IORef+import Data.List+import System.IO.Unsafe++arrayFrom :: (IArray a e, Ix i) => (i,i) -> (i -> e) -> a i e+arrayFrom rng f = array rng [ (x, f x) | x <- range rng ]++{-|+    An 'Equivalence' is an equivalence relation on a range of values of some+    index type.+-}+data Equivalence i = Equivalence {+    ranks :: DiffArray i Int,+    parents :: IORef (DiffArray i i)+    }++{-|+    'emptyEquivalence' is an equivalence relation that equates two values+    only when they are equal to each other.  It is the most discerning such+    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++reprHelper :: Ix i => DiffArray i i -> i -> (DiffArray i i, i)+reprHelper ps i+    | pi == i   = (ps, i)+    | otherwise = let (ps', r) = reprHelper ps pi in (ps' // [(i,r)], r)+  where pi = ps ! i++{-|+    'repr' gives a canonical representative of the equivalence class+    containing @x@.  It is chosen arbitrarily, but is always the same for a+    given equivalence relation.++    This function is slightly unsafe.  In particular, it's possible to build+    the same equivalence relation by equating values in two different orders,+    and the choice of canonical representatives will differ.  You can either+    think of a value of type 'Equivalence' as an equivalence relation together+    with a choice of canonical representatives, or you can consider this not a+    pure function.  Since 'Equivalence' is not an instance of @Eq@ and equality+    is not observable, both perspectives are valid.+-}+repr :: Ix i => Equivalence i -> i -> i+repr (Equivalence rs vps) i = unsafePerformIO $ atomicModifyIORef vps f+  where f ps = reprHelper ps (ps ! i)++{-|+    Determines if two values are equivalent under the given equivalence+    relation.+-}+equiv :: Ix i => Equivalence i -> i -> i -> Bool+equiv eq x y = repr eq x == repr eq y++{-|+    Determines if all of the given values are equivalent under the given+    equivalence relation.+-}+equivalent :: Ix i => Equivalence i -> [i] -> Bool+equivalent eq []     = True+equivalent eq (x:xs) = all (== repr eq x) (map (repr eq) xs)++{-|+    Construct the equivalence relation obtained by equating the given two+    values.  This combines equivalence classes.+-}+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)+  where+    go px py ps+        | px == py  = Equivalence rs vps+        | rx > ry   = let ps' = ps // [(py, px)]+                      in Equivalence rs (unsafePerformIO (newIORef ps'))+        | rx < ry   = let ps' = ps // [(px, py)]+                      in Equivalence rs (unsafePerformIO (newIORef ps'))+        | otherwise = let ps' = ps // [(py, px)]+                          rs' = rs // [(px, (rx + 1))]+                      in Equivalence rs (unsafePerformIO (newIORef ps'))+      where rx = rs ! px+            ry = rs ! py++{-|+    Construct the equivalence relation obtained by equating all of the given+    values.  This combines equivalence classes.+-}+equateAll :: Ix i => [i] -> Equivalence i -> Equivalence i+equateAll []     eq = eq+equateAll (x:xs) eq = foldl' (flip (equate x)) eq xs

@@ -0,0 +1,30 @@+Copyright (c)2011, Chris Smith <cdsmith@gmail.com>++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Chris Smith <cdsmith@gmail.com> nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,27 @@+Name:                persistent-equivalence+Version:             0.1+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+                     or disjoint set union).  It exhibits optimal performance+                     when used in a linear pattern, but degrades when other+                     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.+License:             BSD3+License-file:        LICENSE+Author:              Chris Smith <cdsmith@gmail.com>+Maintainer:          Chris Smith <cdsmith@gmail.com>+Category:            Data+Build-type:          Simple+Cabal-version:       >=1.6++Library+  Exposed-modules:   Data.Equivalence.Persistent+  Build-depends:     base >= 3 && < 5,+                     array == 0.3.*,+                     diffarray == 0.1.*