permutation 0.3 → 0.4

raw patch · 7 files changed

+239/−57 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• NEWS +4/−0
• lib/Data/Permute.hs +33/−0
• lib/Data/Permute/MPermute.hs +82/−28
• permutation.cabal +3/−2
• tests/Driver.hs +38/−0
• tests/Permute.hs +72/−27
• tests/STPermute.hs +7/−0

@@ -0,0 +1,4 @@+Changes in 0.4:++* Amir Livne Bar-on implemented cycle-related functions+

@@ -17,6 +17,7 @@     permute,     listPermute,     swapsPermute,+    cyclesPermute,      -- * Accessing permutation elements     at,@@ -25,6 +26,8 @@     -- * Permutation properties     size,     elems,+    isEven,+    period,          -- * Permutation functions     inverse,@@ -34,6 +37,8 @@     -- * Applying permutations     swaps,     invSwaps,+    cycleFrom,+    cycles,          -- * Sorting     sort,@@ -76,6 +81,13 @@ swapsPermute n ss = runST $     unsafeFreeze =<< newSwapsPermute n ss +-- | Construct a permutation from a list of disjoint cycles.+-- @cyclesPermute n cs@ creates a permutation of size @n@ which is the+-- composition of the cycles @cs@.+cyclesPermute :: Int -> [[Int]] -> Permute+cyclesPermute n cs = runST $+    unsafeFreeze =<< newCyclesPermute n cs+ -- | @at p i@ gets the value of the @i@th element of the permutation -- @p@.  The index @i@ must be in the range @0..(n-1)@, where @n@ is the -- size of the permutation.@@ -124,6 +136,27 @@ invSwaps :: Permute -> [(Int,Int)] invSwaps p = runST $     getInvSwaps =<< unsafeThaw p++-- | @cycleFrom p i@ gets the list of elements reachable from @i@ by+-- repeated application of @p@.+cycleFrom :: Permute -> Int -> [Int]+cycleFrom p i = runST $+    flip getCycleFrom i =<< unsafeThaw p++-- | @cycles p@ returns the list of disjoin cycles in @p@.+cycles :: Permute -> [[Int]]+cycles p = runST $+    getCycles =<< unsafeThaw p++-- | Whether or not the permutation is made from an even number of swaps+isEven :: Permute -> Bool+isEven p = runST $+    getIsEven =<< unsafeThaw p++-- | @period p@ - The first power of @p@ that is the identity permutation+period :: Permute -> Integer+period p = runST $+    getPeriod =<< unsafeThaw p   -- | @sort n xs@ sorts the first @n@ elements of @xs@ and returns a 

@@ -21,6 +21,7 @@     newPermute_,     newListPermute,     newSwapsPermute,+    newCyclesPermute,     newCopyPermute,     copyPermute,     setIdentity,@@ -35,6 +36,8 @@     getElems,     setElems,     isValid,+    getIsEven,+    getPeriod,      -- * Permutation functions     getInverse,@@ -45,6 +48,8 @@     -- * Applying permutations     getSwaps,     getInvSwaps,+    getCycleFrom,+    getCycles,          -- * Sorting     getSort,@@ -63,6 +68,7 @@     -- * Unsafe operations     unsafeNewListPermute,     unsafeNewSwapsPermute,+    unsafeNewCyclesPermute,     unsafeGetElem,     unsafeSetElem,     unsafeSwapElems,@@ -155,6 +161,24 @@     return p {-# INLINE newSwapsPermuteHelp #-} +-- | Construct a permutation from a list of disjoint cycles.+-- @newCyclesPermute n cs@ creates a permutation of size @n@ which is the+-- composition of the cycles @cs@.+newCyclesPermute :: (MPermute p m) => Int -> [[Int]] -> m p+newCyclesPermute n cs =+    newSwapsPermute n $ concatMap cycleToSwaps cs+{-# INLINE newCyclesPermute #-}++unsafeNewCyclesPermute :: (MPermute p m) => Int -> [[Int]] -> m p+unsafeNewCyclesPermute n cs =+    unsafeNewSwapsPermute n $ concatMap cycleToSwaps cs+{-# INLINE unsafeNewCyclesPermute #-}++cycleToSwaps :: [Int] -> [(Int, Int)]+cycleToSwaps [] = error "Empty cycle"+cycleToSwaps (i:is) = [(i,j) | j <- reverse is]+{-# INLINE cycleToSwaps #-}+ -- | Construct a new permutation by copying another. newCopyPermute :: (MPermute p m) => p -> m p newCopyPermute p = do@@ -331,44 +355,74 @@ -- then @i1 \<-> j1@, and so on until @ik \<-> jk@.  The laziness makes this -- function slightly dangerous if you are modifying the permutation. getSwaps :: (MPermute p m) => p -> m [(Int,Int)]-getSwaps = getSwapsHelp False+getSwaps = getSwapsHelp overlapping_pairs+  where+    overlapping_pairs []           = []+    overlapping_pairs [_]          = []+    overlapping_pairs (x:xs@(y:_)) = (x,y) : overlapping_pairs xs {-# INLINE getSwaps #-}  -- | Get a lazy list of swaps equivalent to the inverse of a permutation. getInvSwaps :: (MPermute p m) => p -> m [(Int,Int)]-getInvSwaps = getSwapsHelp True+getInvSwaps = getSwapsHelp pairs_withstart+  where+    pairs_withstart []     = error "Empty cycle"+    pairs_withstart (x:xs) = [(x,y) | y <- xs] {-# INLINE getInvSwaps #-} -getSwapsHelp :: (MPermute p m) => Bool -> p -> m [(Int,Int)]-getSwapsHelp inv p = do+getSwapsHelp :: (MPermute p m) => ([Int] -> [(Int, Int)]) -> p -> m [(Int,Int)]+getSwapsHelp swapgen p = do+    liftM (concatMap swapgen) $ getCycles p+{-# INLINE getSwapsHelp #-}++-- | @getCycleFrom p i@ gets the list of elements reachable from @i@+-- by repeated application of @p@.+getCycleFrom :: (MPermute p m) => p -> Int -> m [Int]+getCycleFrom p i =+    liftM (i:) $ go i+  where+    go j = unsafeInterleaveM $ do+        next <- unsafeGetElem p j+        if next == i+            then return []+            else liftM (next:) $ go next+{-# INLINE getCycleFrom #-}++-- | @getCycles p@ returns the list of disjoin cycles in @p@.+getCycles :: (MPermute p m) => p -> m [[Int]]+getCycles p = do     n <- getSize p-    liftM concat $ go n 0+    go n 0   where+     go n i | i == n    = return []            | otherwise = unsafeInterleaveM $ do-        i'    <- unsafeGetElem p i-        least <- isLeast i i'-        c     <- if least -                     then doCycle i i i'-                     else return []-        cs    <- go n (i+1)-        return (c:cs)-      -    isLeast i k -        | k > i = do-            k' <- unsafeGetElem p k-            isLeast i k'-        | k < i     = return False-        | otherwise = return True-        -    doCycle start i i'-        | i' == start = return []-        | otherwise = unsafeInterleaveM $ do-            i'' <- unsafeGetElem p i'-            let s = if inv then (start,i') else (i,i')-            ss <- doCycle start i' i''-            return (s:ss)-{-# INLINE getSwapsHelp #-}+        least <- isLeast i i+        if least+            then do+                c <- getCycleFrom p i+                liftM (c:) $ go n (i+1)+            else go n (i+1)++    isLeast i j = do+        k <- unsafeGetElem p j+        case compare i k of+            LT -> isLeast i k+            EQ -> return True+            GT -> return False+{-# INLINE getCycles #-}++-- | Whether or not the permutation is made from an even number of swaps+getIsEven :: (MPermute p m) => p -> m Bool+getIsEven p = do+    liftM (even . length) $ getSwaps p++-- | @getPeriod p@ - The first power of @p@ that is the identity permutation+getPeriod :: (MPermute p m) => p -> m Integer+getPeriod p = do+    cycles <- getCycles p+    let lengths = map List.genericLength cycles+    return $ List.foldl' lcm 1 lengths  -- | Convert a mutable permutation to an immutable one. freeze :: (MPermute p m) => p -> m Permute

@@ -1,5 +1,5 @@ name:            permutation-version:         0.3+version:         0.4 homepage:        http://stat.stanford.edu/~patperry/code/permutation synopsis:        A library for permutations and combinations. description:@@ -23,7 +23,7 @@ copyright:       (c) 2008. Patrick Perry <patperry@stanford.edu> author:          Patrick Perry maintainer:      Patrick Perry <patperry@stanford.edu>-cabal-version: >= 1.2.0+cabal-version: >= 1.2.3 build-type:      Custom tested-with:     GHC ==6.8.2, GHC ==6.10.1 @@ -37,6 +37,7 @@                      tests/Permute.hs                      tests/STPermute.hs                      tests/Makefile+                     NEWS  library     hs-source-dirs:  lib

@@ -13,6 +13,7 @@     ListChoose(..),         ListPermute(..),     SwapsPermute(..),+    CyclesPermute(..),     Sort(..),     SortBy(..),     Swap(..),@@ -89,6 +90,43 @@     i <- choose (0,n-1)     j <- choose (0,n-1)     return (i,j)++data CyclesPermute = CyclesPermute Int [[Int]] deriving (Eq,Show)+instance Arbitrary CyclesPermute where+    arbitrary = do+        (Nat n) <- arbitrary+        cs <- exhaust randomCycle null [0..n]+        cs' <- cutSomeSingletons cs+        return $ CyclesPermute (n+1) cs'++    coarbitrary = undefined++exhaust :: Monad m => (a -> m (b, a)) -> (a -> Bool) -> a -> m [b]+exhaust _ p x | p x = return []+exhaust f p x = do+    (r, y) <- f x+    rs <- exhaust f p y+    return (r:rs)++cutSomeSingletons [] = return []+cutSomeSingletons ([x]:xs) = do+    is <- elements [True, False]+    if is+        then liftM ([x]:) $ cutSomeSingletons xs+        else cutSomeSingletons xs+cutSomeSingletons (x:xs) = liftM (x:) $ cutSomeSingletons xs++randomCycle xs = do+    first <- elements xs+    complete first (xs \\ [first])+  where+    complete first rest = do+        next <- elements (first:rest)+        if next == first+            then return ([first], rest)+            else do+                (more, leftover) <- complete first (rest \\ [next])+                return ((next:more), leftover)   data Swap = Swap Int Int Int deriving (Eq,Show)

@@ -8,6 +8,7 @@ import Data.List( foldl' ) import qualified Data.List as List import Data.Maybe( fromJust )+import qualified Data.Set as Set  import Data.Permute @@ -38,6 +39,16 @@                    | k == j    = i                    | otherwise = k +prop_size_cyclesPermute (CyclesPermute n cs) =+    size (cyclesPermute n cs) == n+prop_elems_cyclesPermute (CyclesPermute n cs) =+    elems (cyclesPermute n cs) == map at [0..(n-1)]+  where+    at i = foldl' doCycle i cs+    doCycle k cyc = case List.findIndex (k==) cyc of+        Nothing -> k+        Just ind -> cycle cyc !! (ind + 1)+ prop_at       = prop_at_help at prop_unsafeAt = prop_at_help unsafeAt prop_at_help a =@@ -127,35 +138,69 @@ prop_swapsPermute_swaps (p :: Permute) =     swapsPermute (size p) (swaps p) == p +prop_isEven_permute (Nat n) =+    isEven (permute n) +prop_isEven_swaps (p :: Permute) =+    isEven p == even (length (swaps p))++prop_cyclesPermute_cycles (p :: Permute) =+    cyclesPermute (size p) (cycles p) == p++prop_cycles_cycleFrom (p :: Permute) =+    let n = size p+        cycles1 = Set.fromList (map Set.fromList (cycles p))+        cycles2 = Set.fromList [Set.fromList (cycleFrom p i) | i <- [0..(n-1)]]+    in cycles1 == cycles2++prop_cycles_wholerange (p :: Permute) =+    let n = size p+    in List.sort (concat (cycles p)) == [0..(n-1)]++prop_period_permute (Nat n) =+    period (permute n) == 1++prop_period_onecycle (Nat n) =+    n >= 1 ==> period (listPermute n $ [1..(n-1)] ++ [0]) == toInteger n++ tests_Permute = -    [ ("size . permute"          , mytest prop_size_permute)-    , ("elems . permute"         , mytest prop_elems_permute)-    , ("size . listPermute"      , mytest prop_size_listPermute)-    , ("elems . listPermute"     , mytest prop_elems_listPermute)-    , ("size . swapsPermute"     , mytest prop_size_swapsPermute)-    , ("elems . swapsPermute"    , mytest prop_elems_swapsPermute)-    , ("at"                      , mytest prop_at)-    , ("unsafeAt"                , mytest prop_unsafeAt)-    , ("size . inverse"          , mytest prop_size_inverse)-    , ("elems . inverse"         , mytest prop_elems_inverse)-    , ("swaps"                   , mytest prop_swaps)-    , ("invSwaps"                , mytest prop_invSwaps)-    , ("swaps . inverse"         , mytest prop_swaps_inverse)-    , ("invSwaps . inverse"      , mytest prop_invSwaps_inverse)-    , ("prev . permute"          , mytest prop_prev_permute)-    , ("next (last permutation)" , mytest prop_next_last)-    , ("next . prev"             , mytest prop_next_prev)-    , ("prev . next"             , mytest prop_prev_next)-    , ("fst . sort"              , mytest prop_fst_sort)-    , ("snd . sort"              , mytest prop_snd_sort)-    , ("fst . sortBy"            , mytest prop_fst_sortBy)-    , ("snd . sortBy"            , mytest prop_snd_sortBy)-    , ("order"                   , mytest prop_order)-    , ("orderBy"                 , mytest prop_orderBy)-    , ("rank"                    , mytest prop_rank)-    , ("rankBy"                  , mytest prop_rankBy)-    , ("swapsPermute . swaps"    , mytest prop_swapsPermute_swaps)+    [ ("size . permute"             , mytest prop_size_permute)+    , ("elems . permute"            , mytest prop_elems_permute)+    , ("size . listPermute"         , mytest prop_size_listPermute)+    , ("elems . listPermute"        , mytest prop_elems_listPermute)+    , ("size . swapsPermute"        , mytest prop_size_swapsPermute)+    , ("elems . swapsPermute"       , mytest prop_elems_swapsPermute)+    , ("size . cyclesPermute"       , mytest prop_size_cyclesPermute)+    , ("elems . cyclesPermute"      , mytest prop_elems_cyclesPermute)+    , ("at"                         , mytest prop_at)+    , ("unsafeAt"                   , mytest prop_unsafeAt)+    , ("size . inverse"             , mytest prop_size_inverse)+    , ("elems . inverse"            , mytest prop_elems_inverse)+    , ("swaps"                      , mytest prop_swaps)+    , ("invSwaps"                   , mytest prop_invSwaps)+    , ("swaps . inverse"            , mytest prop_swaps_inverse)+    , ("invSwaps . inverse"         , mytest prop_invSwaps_inverse)+    , ("prev . permute"             , mytest prop_prev_permute)+    , ("next (last permutation)"    , mytest prop_next_last)+    , ("next . prev"                , mytest prop_next_prev)+    , ("prev . next"                , mytest prop_prev_next)+    , ("fst . sort"                 , mytest prop_fst_sort)+    , ("snd . sort"                 , mytest prop_snd_sort)+    , ("fst . sortBy"               , mytest prop_fst_sortBy)+    , ("snd . sortBy"               , mytest prop_snd_sortBy)+    , ("order"                      , mytest prop_order)+    , ("orderBy"                    , mytest prop_orderBy)+    , ("rank"                       , mytest prop_rank)+    , ("rankBy"                     , mytest prop_rankBy)+    , ("swapsPermute . swaps"       , mytest prop_swapsPermute_swaps)+    , ("isEven . permute"           , mytest prop_isEven_permute)+    , ("isEven == even . swaps"     , mytest prop_isEven_swaps)+    , ("cyclesPermute . cycles"     , mytest prop_cyclesPermute_cycles)+    , ("cycles == all cycleFrom"    , mytest prop_cycles_cycleFrom)+    , ("concat . cycles == [0..n]"  , mytest prop_cycles_wholerange)+    , ("period . permute"           , mytest prop_period_permute)+    , ("period [1..n,0] == n"       , mytest prop_period_onecycle)     ]  

@@ -33,6 +33,11 @@ prop_UnsafeNewSwapsPermute (SwapsPermute n ss) =     unsafeNewSwapsPermute n ss `equivalent` newSwapsPermute_S n ss +newCyclesPermute_S n cs = cyclesPermute n cs+prop_NewCyclesPermute (CyclesPermute n cs) =+    newCyclesPermute n cs `equivalent` newCyclesPermute_S n cs+prop_UnsafeNewCyclesPermute (CyclesPermute n cs) =+    unsafeNewCyclesPermute n cs `equivalent` newCyclesPermute_S n cs   newCopyPermute_S p = (p, p)@@ -112,6 +117,8 @@     , ("newListPermute"           , mytest prop_NewListPermute)     , ("newSwapsPermute"          , mytest prop_NewSwapsPermute)     , ("unsafeNewSwapsPermute"    , mytest prop_UnsafeNewSwapsPermute)+    , ("newCyclesPermute"         , mytest prop_NewCyclesPermute)+    , ("unsafeNewCyclesPermute"   , mytest prop_UnsafeNewCyclesPermute)     , ("newCopyPermute"           , mytest prop_NewCopyPermute)     , ("copyPermute"              , mytest prop_CopyPermute)     , ("setIdentity"              , mytest prop_SetIdentity)