File: Enumerate.hs

package info (click to toggle)
haskell-permutation 0.5.0.5-3
  • links: PTS
  • area: main
  • in suites: buster
  • size: 208 kB
  • sloc: haskell: 2,055; makefile: 19
file content (81 lines) | stat: -rw-r--r-- 2,501 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
module Main where
    
import Control.Monad
import Control.Monad.ST
import Data.List( permutations )
import Data.STRef
import System.Environment

import Data.Permute
import Data.Permute.MPermute
    
-- | Execute an action on every permutation of a given order.  This function
-- is unsafe, because it only allocates space for a single permutation.  The
-- action @f@ should not retain any references to the passed-in @Permute@
-- object, otherwise bad things will happen.  For instance, running
-- >
-- >    forAllPermutes 2 id
-- >
-- in ghci yields @[listPermute 2 [1,0],listPermute 2 [1,0]]@.
--
forAllPermutes :: Int -> (Permute -> a) -> [a]
forAllPermutes n f = runST $ do
    -- Allocate a mutable permutation initialized to the identity
    p  <- newPermute n
    
    -- Run the action on all successors of p
    runOnSuccessors p
    
  where
    runOnSuccessors p = do
        -- Cast the mutable permutation to an immutable one
        -- and the action on the immutable
        a <- liftM f (unsafeFreeze p)

        -- Set the permutation to be equal to its successor
        hasNext <- setNext p
        
        -- If a successor exists, recurse, otherwise stop
        as <- unsafeInterleaveST $
            if hasNext then runOnSuccessors p 
                       else return []
        return (a:as)


forAllPermutesM_ :: (MPermute p m) => Int -> (Permute -> m a) -> m () 
forAllPermutesM_ n f = sequence_ $ forAllPermutes n f
{-# INLINE forAllPermutesM_ #-}

-- | Count the number of permutations of a given order
countAllPermutes :: Int -> Int
countAllPermutes n = length $ forAllPermutes n id

-- | Another version of the same function.  This one is slightly slower.
countAllPermutes2 :: Int -> Int
countAllPermutes2 n = runST $ do
    count <- newSTRef 0
    forAllPermutesM_ n $ (const $ modifySTRef' count (+1))
    readSTRef count
  where
    modifySTRef' var f = do
        old <- readSTRef var
        writeSTRef var $! f old

-- | Yet another version, this time using 'permutations' from Data.List.
-- This version is faster but uses more memory.
countAllPermutes3 :: Int -> Int
countAllPermutes3 n = length $ permutations [0 .. n-1]


-- | Print all permutations of a given order.
printAllPermutes :: Int -> IO ()
printAllPermutes n =
    forAllPermutesM_ n (putStrLn . show . elems)


main = do
    n  <- fmap (read . head) getArgs
    let count = countAllPermutes n
    putStrLn $ 
        "There are " ++ show count ++ " permutations of order " ++ show n ++ "."