combinat 0.2.4 → 0.2.4.1

raw patch · 11 files changed

+459/−32 lines, 11 filesdep +transformersdep −mtlPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: transformers

Dependencies removed: mtl

API changes (from Hackage documentation)

Files

• LICENSE +1/−1
• Math/Combinat.hs +2/−2
• Math/Combinat/Combinations.hs +4/−1
• Math/Combinat/Compositions.hs +68/−0
• Math/Combinat/Graphviz.hs +22/−9
• Math/Combinat/Numbers.hs +11/−0
• Math/Combinat/Numbers/Primes.hs +290/−0
• Math/Combinat/Permutations.hs +11/−1
• Math/Combinat/Sets.hs +5/−1
• Math/Combinat/Trees/Nary.hs +28/−2
• combinat.cabal +17/−15

@@ -1,4 +1,4 @@-Copyright (c) 2008-2009, Balazs Komuves+Copyright (c) 2008-2011, Balazs Komuves All rights reserved.  Redistribution and use in source and binary forms, with or without

@@ -29,7 +29,7 @@   ( module Math.Combinat.Numbers   , module Math.Combinat.Sets   , module Math.Combinat.Tuples-  , module Math.Combinat.Combinations+  , module Math.Combinat.Compositions   , module Math.Combinat.Partitions   , module Math.Combinat.Permutations   , module Math.Combinat.Tableaux@@ -40,7 +40,7 @@ import Math.Combinat.Numbers import Math.Combinat.Sets import Math.Combinat.Tuples-import Math.Combinat.Combinations+import Math.Combinat.Compositions import Math.Combinat.Partitions import Math.Combinat.Permutations import Math.Combinat.Tableaux

@@ -1,5 +1,8 @@ --- | Combinations+-- | Combinations.+-- This module is depracated; it is equivalent to the module "Compositions", +-- but it turns out that \"compositions\" is the accepted name. I will+-- remove this module in the future.  module Math.Combinat.Combinations where 

@@ -0,0 +1,68 @@++-- | Compositions. +-- This module is equivalent to the module "Combinations", +-- but it turns out that \"compositions\" is the accepted name. I will+-- remove the "Combinations" module in the future.++module Math.Combinat.Compositions where++import Math.Combinat.Numbers (factorial,binomial)++-------------------------------------------------------++-- | Compositions fitting into a given shape and having a given degree.+--   The order is lexicographic, that is, +--+-- > sort cs == cs where cs = compositions' shape k+--+compositions'  +  :: [Int]         -- ^ shape+  -> Int           -- ^ sum+  -> [[Int]]+compositions' [] 0 = [[]]+compositions' [] _ = []+compositions' shape@(s:ss) n = +  [ x:xs | x <- [0..min s n] , xs <- compositions' ss (n-x) ] ++countCompositions' :: [Int] -> Int -> Integer+countCompositions' [] 0 = 1+countCompositions' [] _ = 0+countCompositions' shape@(s:ss) n = sum +  [ countCompositions' ss (n-x) | x <- [0..min s n] ] ++-- | All compositions fitting into a given shape.+allCompositions' :: [Int] -> [[[Int]]]+allCompositions' shape = map (compositions' shape) [0..d] where d = sum shape++-- | Compositions of a given length.+compositions +  :: Integral a +  => a       -- ^ length+  -> a       -- ^ sum+  -> [[Int]]+compositions len' d' = compositions' (replicate len d) d where+  len = fromIntegral len'+  d   = fromIntegral d'++-- | # = \\binom { len+d-1 } { len-1 }+countCompositions :: Integral a => a -> a -> Integer+countCompositions len d = binomial (len+d-1) (len-1)++-- | Positive compositions of a given length.+compositions1  +  :: Integral a +  => a       -- ^ length+  -> a       -- ^ sum+  -> [[Int]]+compositions1 len' d' +  | len > d = []+  | otherwise = map plus1 $ compositions len (d-len)+  where+    plus1 = map (+1)+    len = fromIntegral len'+    d   = fromIntegral d'++countCompositions1 :: Integral a => a -> a -> Integer+countCompositions1 len d = countCompositions len (d-len)++-------------------------------------------------------

@@ -15,8 +15,6 @@ import Data.Tree  import Control.Applicative-import Control.Monad.State-import Data.Traversable (traverse)  import Math.Combinat.Trees.Binary (BinTree(..), BinTree'(..)) import Math.Combinat.Trees.Nary (addUniqueLabelsTree, addUniqueLabelsForest)@@ -76,8 +74,14 @@ -- | Generates graphviz @.dot@ file from a forest. The first argument tells whether -- to make the individual trees clustered subgraphs; the second is the name of the -- graph.-forestDot :: Show a => Bool -> String -> Forest a -> Dot-forestDot clustered graphname forest = digraphBracket graphname lines where+forestDot +  :: Show a +  => Bool        -- ^ make the individual trees clustered subgraphs+  -> Bool        -- ^ reverse the direction of the arrows+  -> String      -- ^ name of the graph+  -> Forest a +  -> Dot+forestDot clustered revarrows graphname forest = digraphBracket graphname lines where   lines = concat $ zipWith cluster [(1::Int)..] (addUniqueLabelsForest forest)    name unique = "node_"++show unique   cluster j tree = let treelines = worker (0::Int) tree in case clustered of@@ -86,17 +90,26 @@   worker depth (Node (label,unique) subtrees) = vertex : edges ++ concatMap (worker (depth+1)) subtrees where     vertex = name unique ++ "[label=\"" ++ show label ++ "\"" ++ "];"     edges = map edge subtrees-    edge (Node (_,unique') _) = name unique ++ " -> " ++ name unique'   -  +    edge (Node (_,unique') _) = if not revarrows +      then name unique  ++ " -> " ++ name unique'   +      else name unique' ++ " -> " ++ name unique+       -- | Generates graphviz @.dot@ file from a tree. The first argument is -- the name of the graph.-treeDot :: Show a => String -> Tree a -> Dot-treeDot graphname tree = digraphBracket graphname lines where+treeDot +  :: Show a +  => Bool     -- ^ reverse the direction of the arrow+  -> String   -- ^ name of the graph+  -> Tree a +  -> Dot+treeDot revarrows graphname tree = digraphBracket graphname lines where   lines = worker (0::Int) (addUniqueLabelsTree tree)    name unique = "node_"++show unique   worker depth (Node (label,unique) subtrees) = vertex : edges ++ concatMap (worker (depth+1)) subtrees where     vertex = name unique ++ "[label=\"" ++ show label ++ "\"" ++ "];"     edges = map edge subtrees-    edge (Node (_,unique') _) = name unique ++ " -> " ++ name unique'+    edge (Node (_,unique') _) = if not revarrows +      then name unique  ++ " -> " ++ name unique'   +      else name unique' ++ " -> " ++ name unique  --------------------------------------------------------------------------------

@@ -44,6 +44,17 @@     k' = fromIntegral k     n' = fromIntegral n +-- | A given row of the Pascal triangle; equivalent to a sequence of binomial +-- numbers, but much more efficient. You can also left-fold over it.+--+-- > pascalRow n == [ binomial n k | k<-[0..n] ]+pascalRow :: Integral a => a -> [Integer]+pascalRow n' = worker 0 1 where+  n = fromIntegral n'+  worker j x+    | j>n   = [] +    | True  = let j'=j+1 in x : worker j' (div (x*(n-j)) j') + multinomial :: Integral a => [a] -> Integer multinomial xs = div   (factorial (sum xs))

@@ -0,0 +1,290 @@++-- | Prime numbers and related number theoretical stuff.++module Math.Combinat.Numbers.Primes +  ( -- * List of prime numbers+    primes+  , primesSimple+  , primesTMWE+    -- * Prime factorization+  , groupIntegerFactors+  , integerFactorsTrialDivision+    -- * Integer logarithm+  , integerLog2+  , ceilingLog2+    -- * Integer square root+  , isSquare+  , integerSquareRoot+  , ceilingSquareRoot+  , integerSquareRoot' +  , integerSquareRootNewton'+    -- * Modulo @m@ arithmetic+  , powerMod+    -- * Prime testing+  , millerRabinPrimalityTest+  )+  where++--------------------------------------------------------------------------------++-- import Math.Combinat.Numbers++import Data.List ( group , sort )+import Data.Bits++--------------------------------------------------------------------------------+-- List of prime numbers ++-- | Infinite list of primes, using the TMWE algorithm.+primes :: [Integer]+primes = primesTMWE++-- | A relatively simple but still quite fast implementation of list of primes.+-- By Will Ness <http://www.haskell.org/pipermail/haskell-cafe/2009-November/068441.html>+primesSimple :: [Integer]+primesSimple = 2 : 3 : sieve 0 primes' 5 where+  primes' = tail primesSimple+  sieve k (p:ps) x = noDivs k h ++ sieve (k+1) ps (t+2) where+    t = p*p +    h = [x,x+2..t-2]+  noDivs k = filter (\x -> all (\y -> rem x y /= 0) (take k primes'))+  +-- | List of primes, using tree merge with wheel. Code by Will Ness.+primesTMWE :: [Integer]+primesTMWE = 2:3:5:7: gaps 11 wheel (fold3t $ roll 11 wheel primes') where                                                             ++  primes' = 11: gaps 13 (tail wheel) (fold3t $ roll 11 wheel primes')+  fold3t ((x:xs): ~(ys:zs:t)) +    = x : union xs (union ys zs) `union` fold3t (pairs t)            +  pairs ((x:xs):ys:t) = (x : union xs ys) : pairs t +  wheel = 2:4:2:4:6:2:6:4:2:4:6:6:2:6:4:2:6:4:6:8:4:2:4:2:  +          4:8:6:4:6:2:4:6:2:6:6:4:2:4:6:2:6:4:2:4:2:10:2:10:wheel +  gaps k ws@(w:t) cs@ ~(c:u) +    | k==c  = gaps (k+w) t u              +    | True  = k : gaps (k+w) t cs  +  roll k ws@(w:t) ps@ ~(p:u) +    | k==p  = scanl (\c d->c+p*d) (p*p) ws : roll (k+w) t u              +    | True  = roll (k+w) t ps   ++  minus xxs@(x:xs) yys@(y:ys) = case compare x y of +    LT -> x : minus xs  yys+    EQ ->     minus xs  ys +    GT ->     minus xxs ys+  minus xs [] = xs+  minus [] _  = []+  +  union xxs@(x:xs) yys@(y:ys) = case compare x y of +    LT -> x : union xs  yys+    EQ -> x : union xs  ys +    GT -> y : union xxs ys+  union xs [] = xs+  union [] ys =ys++--------------------------------------------------------------------------------+-- Prime factorization++-- | Groups integer factors. Example: from [2,2,2,3,3,5] we produce [(2,3),(3,2),(5,1)]  +groupIntegerFactors :: [Integer] -> [(Integer,Int)]+groupIntegerFactors = map f . group . sort where+  f xs = (head xs, length xs)++-- | The naive trial division algorithm.+integerFactorsTrialDivision :: Integer -> [Integer]+integerFactorsTrialDivision n +  | n<1 = error "integerFactorsTrialDivision: n should be at least 1"+  | otherwise = go primes n +  where+    go _  1 = []+    go rs k = sub ps k where+      sub [] k = [k]+      sub qqs@(q:qs) k = case mod k q of+        0 -> q : go qqs (div k q)+        _ -> sub qs k+      ps = takeWhile (\p -> p*p <= k) rs  +{-+    go 1 = []+    go k = sub ps k where+      sub [] k = [k]+      sub (q:qs) k = case mod k q of+        0 -> q : go (div k q)+        _ -> sub qs k+      ps = takeWhile (\p -> p*p <= k) primes+-}++{-    +-- brute force testing of factors+ifactorsTest :: (Integer -> [Integer]) -> Integer -> Bool+ifactorsTest alg n = and [ product (alg k) == k | k<-[1..n] ]   +-}++--------------------------------------------------------------------------------+-- Integer logarithm++-- | Largest integer @k@ such that @2^k@ is smaller or equal to @n@+integerLog2 :: Integer -> Integer+integerLog2 n = go n where+  go 0 = -1+  go k = 1 + go (shiftR k 1)++-- | Smallest integer @k@ such that @2^k@ is larger or equal to @n@+ceilingLog2 :: Integer -> Integer+ceilingLog2 0 = 0+ceilingLog2 n = 1 + go (n-1) where+  go 0 = -1+  go k = 1 + go (shiftR k 1)+  +--------------------------------------------------------------------------------+-- Integer square root++isSquare :: Integer -> Bool+isSquare n = +  if (fromIntegral $ mod n 32) `elem` rs +    then snd (integerSquareRoot' n) == 0+    else False+  where+    rs = [0,1,4,9,16,17,25] :: [Int]+    +-- | Integer square root (largest integer whose square is smaller or equal to the input)+-- using Newton's method, with a faster (for large numbers) inital guess based on bit shifts.+integerSquareRoot :: Integer -> Integer+integerSquareRoot = fst . integerSquareRoot'++-- | Smallest integer whose square is larger or equal to the input+ceilingSquareRoot :: Integer -> Integer+ceilingSquareRoot n = (if r>0 then u+1 else u) where (u,r) = integerSquareRoot' n ++-- | We also return the excess residue; that is+--+-- > (a,r) = integerSquareRoot' n+-- +-- means that+--+-- > a*a + r = n+-- > a*a <= n < (a+1)*(a+1)+integerSquareRoot' :: Integer -> (Integer,Integer)+integerSquareRoot' n+  | n<0 = error "integerSquareRoot: negative input"+  | n<2 = (n,0)+  | otherwise = go firstGuess +  where+    k = integerLog2 n+    firstGuess = 2^(div (k+2) 2) -- !! note that (div (k+1) 2) is NOT enough !!+    go a = +      if m < a+        then go a' +        else (a, r + a*(m-a))+      where+        (m,r) = divMod n a+        a' = div (m + a) 2++-- | Newton's method without an initial guess. For very small numbers (<10^10) it+-- is somewhat faster than the above version.+integerSquareRootNewton' :: Integer -> (Integer,Integer)+integerSquareRootNewton' n+  | n<0 = error "integerSquareRootNewton: negative input"+  | n<2 = (n,0)+  | otherwise = go (div n 2) +  where+    go a = +      if m < a+        then go a' +        else (a, r + a*(m-a))+      where+        (m,r) = divMod n a+        a' = div (m + a) 2++{-+-- brute force test of integer square root+isqrt_test n1 n2 = +  [ k +  | k<-[n1..n2] +  , let (a,r) = integerSquareRoot' k+  , (a*a+r/=k) || (a*a>k) || (a+1)*(a+1)<=k +  ]+-}++--------------------------------------------------------------------------------+-- Modulo @m@ arithmetic++-- | Efficient powers modulo m.+-- +-- > powerMod a k m == (a^k) `mod` m+powerMod :: Integer -> Integer -> Integer -> Integer+powerMod a' k m = {- debug bs $ -} go a bs where++  bs = bin k++  bin 0 = []+  bin x = (x .&. 1 /= 0) : bin (shiftR x 1)++  a = mod a' m++  go _ [] = 1+  go x (b:bs) = -- debug (x,b) $ +    if b +      then mod (x*rest) m+      else rest+    where +      rest = go (mod (x*x) m) bs +      +--------------------------------------------------------------------------------+-- Prime testing+ +-- | Miller-Rabin Primality Test (taken from Haskell wiki). +-- We test the primality of the first argument @n@ by using the second argument @a@ as a candidate witness.+-- If it returs @False@, then @n@ is composite. If it returns @True@, then @n@ is either prime or composite.+--+-- A random choice between @2@ and @(n-2)@ is a good choice for @a@.+millerRabinPrimalityTest :: Integer -> Integer -> Bool+millerRabinPrimalityTest n a+  | a <= 1 || a >= n-1 = +      error $ "millerRabinPrimalityTest: a out of range (" ++ show a ++ " for "++ show n ++ ")" +  | n < 2 = False+  | even n = False+  | b0 == 1 || b0 == n' = True+  | otherwise = iter (tail b)+  where+    n' = n-1+    (k,m) = find2km n'+    b0 = powMod n a m+    b = take (fromIntegral k) $ iterate (squareMod n) b0+    iter [] = False+    iter (x:xs)+      | x == 1 = False+      | x == n' = True+      | otherwise = iter xs+++{-# SPECIALIZE find2km :: Integer -> (Integer,Integer) #-}+find2km :: Integral a => a -> (a,a)+find2km n = f 0 n where +  f k m+    | r == 1 = (k,m)+    | otherwise = f (k+1) q+    where (q,r) = quotRem m 2        + +{-# SPECIALIZE pow' :: (Integer -> Integer -> Integer) -> (Integer -> Integer) -> Integer -> Integer -> Integer #-}+pow' :: (Num a, Integral b) => (a -> a -> a) -> (a -> a) -> a -> b -> a+pow' _ _ _ 0 = 1+pow' mul sq x' n' = f x' n' 1 where +  f x n y+    | n == 1 = x `mul` y+    | r == 0 = f x2 q y+    | otherwise = f x2 q (x `mul` y)+    where+      (q,r) = quotRem n 2+      x2 = sq x+ +{-# SPECIALIZE mulMod :: Integer -> Integer -> Integer -> Integer #-}+mulMod :: Integral a => a -> a -> a -> a+mulMod a b c = (b * c) `mod` a++{-# SPECIALIZE squareMod :: Integer -> Integer -> Integer #-}+squareMod :: Integral a => a -> a -> a+squareMod a b = (b * b) `rem` a++{-# SPECIALIZE powMod :: Integer -> Integer -> Integer -> Integer #-}+powMod :: Integral a => a -> a -> a -> a+powMod m = pow' (mulMod m) (squareMod m)++--------------------------------------------------------------------------------

@@ -11,6 +11,7 @@   , fromPermutation   , permutationArray   , toPermutationUnsafe+  , arrayToPermutationUnsafe   , isPermutation   , toPermutation   , permutationSize@@ -28,6 +29,7 @@   , permuteList   , multiply   , inverse+  , identity     -- * Simple permutations   , permutations   , _permutations@@ -95,6 +97,10 @@   n = length xs   perm = listArray (1,n) xs +-- Indexing starts from 1.+arrayToPermutationUnsafe :: Array Int Int -> Permutation+arrayToPermutationUnsafe = Permutation+ -- | Checks whether the input is a permutation of the numbers @[1..n]@. isPermutation :: [Int] -> Bool isPermutation xs = (ar!0 == 0) && and [ ar!j == 1 | j<-[1..n] ] where@@ -267,12 +273,16 @@    infixr 7 `multiply`       --- | The inverse permutation+-- | The inverse permutation. inverse :: Permutation -> Permutation     inverse (Permutation perm1) = Permutation result   where     result = array (1,n) $ map swap $ assocs perm1     (_,n) = bounds perm1+    +-- | The trivial permutation.+identity :: Int -> Permutation +identity n = Permutation $ listArray (1,n) [1..n]  -------------------------------------------------------------------------------- -- * Permutations of distinct elements

@@ -4,7 +4,7 @@ module Math.Combinat.Sets    (      choose-  , combine+  , combine , compose   , tuplesFromList   , listTensor     -- @@ -33,6 +33,10 @@ combine 0 _  = [[]] combine k [] = [] combine k xxs@(x:xs) = map (x:) (combine (k-1) xxs) ++ combine k xs  ++-- | A synonym for 'combine'.+compose :: Int -> [a] -> [[a]]+compose = combine  -- | \"Tensor power\" for lists. Special case of 'listTensor': --

@@ -14,6 +14,12 @@   , labelDepthForest   , labelDepthTree_   , labelDepthForest_+    -- * labelling by number of children+  , labelNChildrenTree+  , labelNChildrenForest+  , labelNChildrenTree_+  , labelNChildrenForest_+       ) where  @@ -22,7 +28,9 @@ import Data.Tree  import Control.Applicative-import Control.Monad.State++--import Control.Monad.State+import Control.Monad.Trans.State import Data.Traversable (traverse)  import Math.Combinat.Sets (listTensor)@@ -49,6 +57,8 @@  addUniqueLabelsForest_ :: Forest a -> Forest Int addUniqueLabelsForest_ = map (fmap snd) . addUniqueLabelsForest++--------------------------------------------------------------------------------      -- | Attaches the depth to each node. The depth of the root is 0.  labelDepthTree :: Tree a -> Tree (a,Int) @@ -63,10 +73,26 @@  labelDepthForest_ :: Forest a -> Forest Int  labelDepthForest_ = map (fmap snd) . labelDepthForest++--------------------------------------------------------------------------------++-- | Attaches the number of children to each node. +labelNChildrenTree :: Tree a -> Tree (a,Int)+labelNChildrenTree (Node x subforest) = +  Node (x, length subforest) (map labelNChildrenTree subforest)+  +labelNChildrenForest :: Forest a -> Forest (a,Int) +labelNChildrenForest forest = map labelNChildrenTree forest++labelNChildrenTree_ :: Tree a -> Tree Int+labelNChildrenTree_ = fmap snd . labelNChildrenTree++labelNChildrenForest_ :: Forest a -> Forest Int +labelNChildrenForest_ = map (fmap snd) . labelNChildrenForest      -------------------------------------------------------------------------------- --- | Computes the set of equivalence classes of trees (in the +-- | Computes the set of equivalence classes of rooted trees (in the  -- sense that the leaves of a node are /unordered/)  -- with @n = length ks@ leaves where the set of heights of  -- the leaves matches the given set of numbers. 

@@ -1,5 +1,5 @@ Name:                combinat-Version:             0.2.4+Version:             0.2.4.1 Synopsis:            Generation of various combinatorial objects. Description:         A collection of functions to generate combinatorial                      objects like partitions, combinations, permutations,@@ -7,12 +7,12 @@ License:             BSD3 License-file:        LICENSE Author:              Balazs Komuves-Copyright:           (c) 2008-2009 Balazs Komuves+Copyright:           (c) 2008-2011 Balazs Komuves Maintainer:          bkomuves (plus) hackage (at) gmail (dot) com Homepage:            http://code.haskell.org/~bkomuves/ Stability:           Experimental Category:            Math-Tested-With:         GHC == 6.10.1+Tested-With:         GHC == 6.12.3 Cabal-Version:       >= 1.2 Build-Type:          Simple @@ -29,10 +29,10 @@ Library   if flag(splitBase)     if flag(base4)-      Build-Depends:       base >= 4 && < 5, array, containers, random, mtl+      Build-Depends:       base >= 4 && < 5, array, containers, random, transformers       cpp-options:         -DBASE_VERSION=4     else -      Build-Depends:       base >= 3 && < 4, array, containers, random, mtl+      Build-Depends:       base >= 3 && < 4, array, containers, random, transformers       cpp-options:         -DBASE_VERSION=3     if flag(withQuickCheck)       Build-Depends:       QuickCheck@@ -41,16 +41,18 @@     cpp-options:         -DBASE_VERSION=2  -  Exposed-Modules:     Math.Combinat, -                       Math.Combinat.Numbers,-                       Math.Combinat.Numbers.Series,-                       Math.Combinat.Sets,-                       Math.Combinat.Tuples, -                       Math.Combinat.Combinations,-                       Math.Combinat.Partitions,-                       Math.Combinat.Permutations,-                       Math.Combinat.Tableaux,-                       Math.Combinat.Tableaux.Kostka,+  Exposed-Modules:     Math.Combinat+                       Math.Combinat.Numbers+                       Math.Combinat.Numbers.Series+                       Math.Combinat.Numbers.Primes+                       Math.Combinat.Sets+                       Math.Combinat.Tuples +                       Math.Combinat.Combinations+                       Math.Combinat.Compositions+                       Math.Combinat.Partitions+                       Math.Combinat.Permutations+                       Math.Combinat.Tableaux+                       Math.Combinat.Tableaux.Kostka                        Math.Combinat.Trees                        Math.Combinat.Trees.Binary                        Math.Combinat.Trees.Nary