permutation 0.2 → 0.2.1

raw patch · 4 files changed

+61/−22 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• lib/Data/Permute/MPermute.hs +18/−16
• permutation.cabal +3/−3
• tests/Main.hs +15/−2
• tests/ST.hs +25/−1

@@ -214,7 +214,8 @@ isValid :: (MPermute p m) => p -> m Bool isValid p = do     n <- getSize p-    liftM and $ validIndices n+    valid <- liftM and $ validIndices n+    return $! valid   where     j `existsIn` i = do         seen <- liftM (take i) $ getElems p@@ -224,15 +225,15 @@         i' <- unsafeGetElem p i         valid  <- return $ i' >= 0 && i' < n         unique <- liftM not (i' `existsIn` i)-        return $ valid && unique+        return $! valid && unique      validIndices n = validIndicesHelp n 0      validIndicesHelp n i         | i == n = return []-        | otherwise = do+        | otherwise = unsafeInterleaveM $ do             a  <- isValidIndex n i-            as <- unsafeInterleaveM $ validIndicesHelp n (i+1)+            as <- validIndicesHelp n (i+1)             return (a:as) {-# INLINE isValid #-} @@ -341,17 +342,18 @@ getSwapsHelp :: (MPermute p m) => Bool -> p -> m [(Int,Int)] getSwapsHelp inv p = do     n <- getSize p-    liftM concat $-        forM [0..(n-1)] $ \i -> do-            k <- unsafeGetElem p i-            least <- isLeast i k-            if least -                then do-                    i' <- unsafeGetElem p i-                    unsafeInterleaveM $ doCycle i i i'-                else-                    return []+    liftM concat $ 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@@ -361,10 +363,10 @@              doCycle start i i'         | i' == start = return []-        | otherwise = do+        | otherwise = unsafeInterleaveM $ do             i'' <- unsafeGetElem p i'             let s = if inv then (start,i') else (i,i')-            ss <- unsafeInterleaveM $ doCycle start i' i''+            ss <- doCycle start i' i''             return (s:ss) {-# INLINE getSwapsHelp #-} 

@@ -1,12 +1,12 @@ name:            permutation-version:         0.2+version:         0.2.1 homepage:        http://stat.stanford.edu/~patperry/code/permutation synopsis:        A library for representing and applying permutations. description:     This library includes data types for storing permutations.  It-    implements pure and impure types, the latter which can be modified+    implements pure and impure types, the latter of which can be modified     in-place.  The main utility of the library is converting between-    the linear representation of a permutation to a sequence of swaps.+    the linear representation of a permutation and a sequence of swaps.     This allows, for instance, applying a permutation or its inverse     to an array with O(1) memory use.     .

@@ -12,6 +12,16 @@     args <- getArgs     let n = if null args then 100 else read (head args)     +    (smokeResults, smokePassed) <- liftM unzip $+        foldM ( \prev (name,subtests) -> do+                    printf "\n%s\n" name+                    printf "%s\n" $ replicate (length name) '-'+                    cur <- mapM (\(s,a) -> printf "%-30s: " s >> a 1) subtests+                    return (prev ++ cur)+              )+              []+              smoke+     (results, passed) <- liftM unzip $         foldM ( \prev (name,subtests) -> do                      printf "\n%s\n" name@@ -22,9 +32,12 @@               []               tests                -    printf "\nPassed %d tests!\n\n" (sum passed)-    when (not . and $ results) $ fail "\nNot all tests passed!"+    printf "\nPassed %d tests!\n\n" (sum $ smokePassed ++ passed)+    when (not . and $ smokeResults ++ results) $ fail "\nNot all tests passed!"  where++    smoke = [ ("STPermute", smoke_STPermute) +            ]      tests = [ ("Permute"   , tests_Permute)             , ("STPermute" , tests_STPermute)

@@ -1,6 +1,7 @@ {-# LANGUAGE Rank2Types #-} module ST (-    tests_STPermute+    tests_STPermute,+    smoke_STPermute     ) where      import Control.Monad@@ -85,8 +86,26 @@ getElems_S p = (elems p, p) prop_GetElems = getElems `implements` getElems_S +prop_IsValid_Strict = runST $ do+    p <- newPermute 10+    setElem p 0 1+    valid <- isValid p+    setElem p 0 0+    return $ valid == False +prop_GetSwaps_Lazy1 = runST $ do+    p <- newPermute 10+    ss <- getSwaps p+    swapElems p 0 1+    return $ length ss == 1 +prop_GetSwaps_Lazy2 = runST $ do+    p <- newPermute 10+    ss <- getSwaps p+    swapElems p 0 1+    swapElems p 3 4+    head ss `seq` swapElems p 3 4+    return $ length ss == 1  tests_STPermute =      [ ("newPermute"               , mytest prop_NewPermute)@@ -104,6 +123,11 @@     , ("getElems"                 , mytest prop_GetElems)     ] +smoke_STPermute =+    [ ("isValid is strict"             , mytest prop_IsValid_Strict)+    , ("getSwaps is lazy (test 1)"     , mytest prop_GetSwaps_Lazy1)+    , ("getSwaps is lazy (test 2)"     , mytest prop_GetSwaps_Lazy2)+    ]  ------------------------------------------------------------------------ --