Major rewrite.

This breaks just about everything from v0.8

.gitignore

@@ -4,3 +4,4 @@ cabal-dev
 *.hi
 *.chi
 *.chs.h
+tests/Properties

Data/CLongArray.hs

@@ -0,0 +1,155 @@
+{-# LANGUAGE MagicHash, UnboxedTuples, ForeignFunctionInterface #-}
+
+-- |
+-- Copyright   : Anders Claesson 2013
+-- Maintainer  : Anders Claesson <anders.claesson@gmail.com>
+--
+-- Convenience functions for dealing with arrays of 'CLong's.
+
+module Data.CLongArray
+    (
+    -- * Data type
+    CLongArray
+
+    -- * Conversions
+    , fromList
+    , toList
+    , slice
+    , unsafeSlice
+
+    -- * Accessors
+    , size
+    , at
+    , unsafeAt
+
+    -- * Map
+    , imap
+
+    -- * Low level functions
+    , unsafeNew
+    , unsafeWith
+    ) where
+
+import Data.Ord
+import Foreign
+import Foreign.C.Types
+import GHC.Base
+
+infixl 9 `at`
+infixl 9 `unsafeAt`
+
+inlinePerformIO :: IO a -> a
+inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r
+{-# INLINE inlinePerformIO #-}
+
+
+-- Data type
+-- ---------
+
+-- | An array of 'CLong's
+data CLongArray = CArr {-# UNPACK #-} !(ForeignPtr CLong) -- elements
+                       {-# UNPACK #-} !Int                -- size
+
+instance Show CLongArray where
+    show w = "fromList " ++ show (toList w)
+
+instance Eq CLongArray where
+    u == v = toList u == toList v
+
+instance Ord CLongArray where
+    compare u v =
+        case comparing size u v of
+          EQ -> comparing toList u v
+          x  -> x
+
+
+-- Conversions
+-- -----------
+
+-- | Construct an array from a list of elements.
+fromList :: [Int] -> CLongArray
+fromList xs = CArr p (length xs)
+    where p = inlinePerformIO $ newForeignPtr finalizerFree =<< newArray (map fromIntegral xs)
+{-# INLINE fromList #-}
+
+-- | The list of elements.
+toList :: CLongArray -> [Int]
+toList w = map fromIntegral . inlinePerformIO . unsafeWith w $ peekArray (size w)
+{-# INLINE toList #-}
+
+-- | Slice a 'CLongArray' into contiguous segments of the given
+-- sizes. Each segment size must be positive and they must sum to the
+-- size of the array.
+slice :: [Int] -> CLongArray -> [CLongArray]
+slice ks w
+    | any (<=0) ks     = error "Data.CLongArray.slice: zero or negative parts"
+    | sum ks /= size w = error "Data.CLongArray.slice: parts doesn't sum to size of array"
+    | otherwise        = unsafeSlice ks w
+
+-- | Like 'slice' but without range checking.
+unsafeSlice :: [Int] -> CLongArray -> [CLongArray]
+unsafeSlice parts w = inlinePerformIO . unsafeWith w $ go parts
+    where
+      go []     _ = return []
+      go (k:ks) p = do
+        vs <- go ks (advancePtr p k)
+        v  <- unsafeNew k $ \q -> copyArray q p k
+        return (v:vs)
+
+
+-- Accessors
+-- ---------
+
+-- | The size/length of the given array.
+size :: CLongArray -> Int
+size (CArr _ n) = n
+{-# INLINE size #-}
+
+-- | @w \`at\` i@ is the value of @w@ at @i@, where @i@ is in @[0..size w-1]@.
+at :: CLongArray -> Int -> Int
+at w i =
+    let n = size w
+    in if (i < 0 || i >= n)
+       then error $ "Data.CLongArray.at: " ++ show i ++ " not in [0.." ++ show (n-1) ++ "]"
+       else unsafeAt w i
+{-# INLINE at #-}
+
+-- | Like 'at' but without range checking.
+unsafeAt :: CLongArray -> Int -> Int
+unsafeAt w = fromIntegral . inlinePerformIO . unsafeWith w . flip peekElemOff
+{-# INLINE unsafeAt #-}
+
+
+-- Map
+-- ---
+
+-- | Apply a function to every element of an array and its index.
+imap :: (Int -> CLong -> CLong) -> CLongArray -> CLongArray
+imap f w = inlinePerformIO . unsafeWith w $ \p -> unsafeNew n (go 0 p)
+    where
+      n = size w
+      go i p q
+        | i >= n = return ()
+        | otherwise = do
+            x <- peek p
+            poke q (f i x)
+            go (i+1) (advancePtr p 1) (advancePtr q 1)
+
+
+-- Low level functions
+-- -------------------
+
+-- | Create a new array of the given size that is initialized through
+-- an IO action.
+unsafeNew :: Int -> (Ptr CLong -> IO ()) -> IO CLongArray
+unsafeNew n act = do
+  q <- newForeignPtr finalizerFree =<< mallocArray n
+  withForeignPtr q act
+  return $ CArr q n
+{-# INLINE unsafeNew #-}
+
+-- | Pass a pointer to the array to an IO action; the array may not be
+-- modified through the pointer.
+unsafeWith :: CLongArray -> (Ptr CLong -> IO a) -> IO a
+unsafeWith (CArr p _) = withForeignPtr p
+{-# INLINE unsafeWith #-}

Data/Perm.hs

@@ -0,0 +1,85 @@
+{-# LANGUAGE ForeignFunctionInterface, TypeSynonymInstances #-}
+
+-- |
+-- Copyright   : Anders Claesson 2013
+-- Maintainer  : Anders Claesson <anders.claesson@gmail.com>
+--
+-- Generating permutations: rank and unrank
+
+module Data.Perm
+    (
+      module Data.CLongArray
+    , Perm
+    , emptyperm
+    , one
+    , idperm
+    , ebb
+    , mkPerm
+    , rank
+    , unrank
+    , perms
+    ) where
+
+import Data.List
+import Data.CLongArray
+import Foreign
+import Foreign.C.Types
+import System.IO.Unsafe
+
+-- | A permutation is just a 'CLongArray'. By convention a permutation
+-- of size @n@ is understood to be a permutation of @[0..n-1]@.
+type Perm = CLongArray
+
+-- | The unique permutation length zero.
+emptyperm :: Perm
+emptyperm = fromList []
+
+-- | The unique permutation length one.
+one :: Perm
+one = fromList [0]
+
+-- | The identity permutation.
+idperm :: Int -> Perm
+idperm n = fromList [0..n-1]
+
+-- | The reverse of the identity permutation.
+ebb :: Int -> Perm
+ebb n = fromList [n-1,n-2..0]
+
+-- | Construct a permutation from a list of elements. As opposed to
+-- 'fromList' this is a safe function in the sense that the output of
+-- @mkPerm xs@ is guaranteed to be a permutation of @[0..length xs-1]@.
+-- E.g., @mkPerm \"baxa\" == fromList [2,0,3,1]@.
+mkPerm :: Ord a => [a] -> Perm
+mkPerm xs =
+    let sti ys = map snd . sort $ zip ys [ 0::Int .. ]
+    in fromList $ (sti . sti) xs
+
+foreign import ccall unsafe "rank.h rank" c_rank
+    :: Ptr CLong -> CLong -> IO CDouble
+
+-- | The rank of the given permutation, where the rank is defined as
+-- in [W. Myrvold and F. Ruskey, Ranking and Unranking Permutations in
+-- Linear Time, Information Processing Letters, 79 (2001) 281-284].
+rank :: Perm -> Integer
+rank w =
+    let n = fromIntegral (size w)
+    in truncate . unsafeDupablePerformIO . unsafeWith w $ flip c_rank n
+{-# INLINE rank #-}
+
+foreign import ccall unsafe "rank.h unrank" c_unrank
+    :: Ptr CLong -> CLong -> CDouble -> IO ()
+
+-- | The permutation of size @n@ whose rank is @r@, where the rank
+-- is defined as in [W. Myrvold and F. Ruskey, Ranking and Unranking
+-- Permutations in Linear Time, Information Processing Letters, 79
+-- (2001) 281-284].
+unrank :: Int -> Integer -> Perm
+unrank n r =
+    unsafeDupablePerformIO . unsafeNew n $ \ptr ->
+        c_unrank ptr (fromIntegral n) (fromIntegral r)
+{-# INLINE unrank #-}
+
+-- | All permutations of a given size.
+perms :: Int -> [Perm]
+perms n = map (unrank n) [0..nFac-1] where nFac = product [1..toInteger n]

Data/Perm/Internal.hs

@@ -0,0 +1,89 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+
+-- |
+-- Copyright   : Anders Claesson 2013
+-- Maintainer  : Anders Claesson <anders.claesson@gmail.com>
+--
+
+module Data.Perm.Internal
+    (
+      Set
+    , normalize
+    , subsets
+    ) where
+
+import Data.List
+import Data.CLongArray
+import Foreign
+import Foreign.C.Types
+import System.IO.Unsafe
+
+
+-- | A set is represented by an increasing array of non-negative
+-- integers.
+type Set = CLongArray
+
+-- Utils
+-- -----
+
+-- | Sort and remove duplicates.
+normalize :: Ord a => [a] -> [a]
+normalize = map head . group . sort
+
+
+-- Bitmasks
+-- --------
+
+-- A sub-class of 'Bits' used internally. Minimal complete definiton: 'next'.
+class (Bits a, Integral a) => Bitmask a where
+    -- | Lexicographically, the next bitmask with the same Hamming weight.
+    next :: a -> a
+
+    -- | @ones k m@ is the set of indices whose bits are set in
+    -- @m@. Default implementation:
+    -- 
+    -- > ones m = fromListN (popCount m) $ filter (testBit m) [0..]
+    -- 
+    ones :: a -> CLongArray
+    ones m = fromList . take (popCount m) $ filter (testBit m) [0..]
+
+instance Bitmask CLong where
+    next = nextCLong
+    ones = onesCLong
+
+instance Bitmask Integer where
+    next = nextIntegral
+
+-- @bitmasks n k@ is the list of bitmasks with Hamming weight @k@ and
+-- size less than @2^n@.
+bitmasks :: Bitmask a => Int -> Int -> [a]
+bitmasks n k = take binomial (iterate next ((1 `shiftL` k) - 1))
+    where
+      n' = toInteger n
+      k' = toInteger k
+      binomial = fromIntegral $ product [n', n'-1 .. n'-k'+1] `div` product [1..k']
+
+-- | @subsets n k@ is the list of subsets of @[0..n-1]@ with @k@
+-- elements.
+subsets :: Int -> Int -> [Set]
+subsets n k
+    | n <= 32   = map ones (bitmasks n k :: [CLong])
+    | otherwise = map ones (bitmasks n k :: [Integer])
+
+foreign import ccall unsafe "bit.h next" c_next :: CLong -> CLong
+
+-- | Lexicographically, the next 'CLong' with the same Hamming weight.
+nextCLong :: CLong -> CLong
+nextCLong = c_next
+
+foreign import ccall unsafe "bit.h ones" c_ones :: Ptr CLong -> CLong -> IO ()
+
+-- | @onesCLong m@ gives the indices whose bits are set in @m@.
+onesCLong :: CLong -> CLongArray
+onesCLong m = unsafeDupablePerformIO . unsafeNew (popCount m) $ flip c_ones m
+
+-- | Lexicographically, the next integral number with the same Hamming weight.
+nextIntegral :: (Integral a, Bits a) => a -> a
+nextIntegral a =
+    let b = (a .|. (a - 1)) + 1
+    in  b .|. ((((b .&. (-b)) `div` (a .&. (-a))) `shiftR` 1) - 1)