{- |
Count and create combinatorial objects.
Also see 'combinat' package.
-}
module Combinatorics (
   permute,
   permuteFast,
   permuteShare,
   permuteRep,
   choose,
   variateRep,
   variate,
   tuples,
   partitions,
   rectifications,
   setPartitions,
   pairPartitions,
   chooseUnrank,
   chooseUnrankMaybe,
   chooseRank,
   factorial,
   binomial,
   binomialSeq,
   binomialGen,
   binomialSeqGen,
   multinomial,
   factorials,
   binomials,
   catalanNumber,
   catalanNumbers,
   derangementNumber,
   derangementNumbers,
   setPartitionNumbers,
   surjectiveMappingNumber,
   surjectiveMappingNumbers,
   fibonacciNumber,
   fibonacciNumbers,
   ) where

import qualified PowerSeries
import qualified Combinatorics.Private as Comb

import Data.Function.HT (nest, )
import Data.Maybe.HT (toMaybe, )
import Data.Tuple.HT (mapFst, )
import qualified Data.List.Match as Match
import Data.List.HT (mapAdjacent, removeEach, )
import Data.List (genericIndex, )

import Control.Monad (liftM2, )


{- $setup
>>> import qualified Combinatorics as Comb
>>> import qualified Test.QuickCheck as QC
>>> import Test.Utility (equalFuncList, equalFuncList2)
>>>
>>> import Control.Applicative (liftA2, (<$>))
>>> import qualified Data.List.Match as Match
>>> import qualified Data.List.Key as Key
>>> import qualified Data.List as List
>>> import qualified Data.Set as Set
>>> import Data.Tuple.HT (uncurry3)
>>> import Data.List.HT (allEqual, isAscending)
>>> import Data.List (sort, nub)
>>> import Data.Eq.HT (equating)
>>>
>>> genPermuteRep :: Int -> QC.Gen [(Char, Int)]
>>> genPermuteRep n = do
>>>    xns <- QC.listOf $ liftA2 (,) QC.arbitrary $ QC.choose (0,n)
>>>    return $ Match.take (takeWhile (<=n) $ scanl1 (+) $ map snd xns) xns
>>>
>>> genVariate :: QC.Gen [Char]
>>> genVariate = take 7 <$> QC.arbitrary
>>>
>>> genBinomial :: QC.Gen (Integer, Integer)
>>> genBinomial = do
>>>    n <- QC.choose (0,100)
>>>    k <- QC.choose (0,n)
>>>    return (n,k)
>>>
>>> genChooseIndex :: QC.Gen (Integer, Integer, Integer)
>>> genChooseIndex = do
>>>    n <- QC.choose (0,25)
>>>    k <- QC.choose (0,n)
>>>    i <- QC.choose (0, Comb.binomial n k - 1)
>>>    return (n,k,i)
-}


{-* Generate compositions from a list of elements. -}

-- several functions for permutation
-- cf. Equation.hs

{- |
Generate list of all permutations of the input list.
The list is sorted lexicographically.

>>> Comb.permute "abc"
["abc","acb","bac","bca","cab","cba"]
>>> Comb.permute "aabc"
["aabc","aacb","abac","abca","acab","acba","aabc","aacb","abac","abca","acab","acba","baac","baca","baac","baca","bcaa","bcaa","caab","caba","caab","caba","cbaa","cbaa"]

prop> QC.forAll (take 6 <$> QC.arbitrary :: QC.Gen [Int]) $ \xs -> allEqual $ map (\p -> sort (p xs)) $ Comb.permute : Comb.permuteFast : Comb.permuteShare : []
-}
permute :: [a] -> [[a]]
permute :: forall a. [a] -> [[a]]
permute = forall a. [a] -> [[a]]
Comb.permuteRec

{- |
Generate list of all permutations of the input list.
It is not lexicographically sorted.
It is slightly faster and consumes less memory
than the lexicographical ordering 'permute'.
-}
permuteFast :: [a] -> [[a]]
permuteFast :: forall a. [a] -> [[a]]
permuteFast [a]
x = forall a. [a] -> [a] -> [[a]] -> [[a]]
permuteFastStep [] [a]
x []

{- |
Each element of (allcycles x) has a different element at the front.
Iterate cycling on the tail elements of each element list of (allcycles x).
-}
permuteFastStep :: [a] -> [a] -> [[a]] -> [[a]]
permuteFastStep :: forall a. [a] -> [a] -> [[a]] -> [[a]]
permuteFastStep [a]
suffix [] [[a]]
tl = [a]
suffixforall a. a -> [a] -> [a]
:[[a]]
tl
permuteFastStep [a]
suffix [a]
x  [[a]]
tl =
   forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\[a]
c -> forall a. [a] -> [a] -> [[a]] -> [[a]]
permuteFastStep (forall a. [a] -> a
head [a]
c forall a. a -> [a] -> [a]
: [a]
suffix) (forall a. [a] -> [a]
tail [a]
c)) [[a]]
tl (forall a. [a] -> [[a]]
allCycles [a]
x)

{- |
All permutations share as much suffixes as possible.
The reversed permutations are sorted lexicographically.
-}
permuteShare :: [a] -> [[a]]
permuteShare :: forall a. [a] -> [[a]]
permuteShare [a]
x =
   forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$
--   map (\(y,[]) -> y) $  -- safer but inefficient
   forall a. Int -> (a -> a) -> a -> a
nest (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
x) (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. ([a], [a]) -> [([a], [a])]
permuteShareStep) [([], [a]
x)]

permuteShareStep :: ([a], [a]) -> [([a], [a])]
permuteShareStep :: forall a. ([a], [a]) -> [([a], [a])]
permuteShareStep ([a]
perm,[a]
todo) =
   forall a b. (a -> b) -> [a] -> [b]
map
      (forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (forall a. a -> [a] -> [a]
:[a]
perm))
      (forall a. [a] -> [(a, [a])]
removeEach [a]
todo)


{- |
>>> Comb.permuteRep [('a',2), ('b',1), ('c',1)]
["aabc","aacb","abac","abca","acab","acba","baac","baca","bcaa","caab","caba","cbaa"]

prop> QC.forAll (genPermuteRep  7) $ \xs -> let perms = Comb.permuteRep $ Key.nub fst xs in perms == nub perms
prop> QC.forAll (genPermuteRep 10) $ \xs -> let perms = Comb.permuteRep $ Key.nub fst xs in List.sort perms == Set.toList (Set.fromList perms)
prop> QC.forAll (genPermuteRep 10) $ isAscending . Comb.permuteRep . Key.nub fst . sort
prop> QC.forAll (QC.choose (0,10)) $ \n k -> Comb.choose n k == Comb.permuteRep [(False, n-k), (True, k)]
-}
permuteRep :: [(a,Int)] -> [[a]]
permuteRep :: forall a. [(a, Int)] -> [[a]]
permuteRep = forall a. [(a, Int)] -> [[a]]
Comb.permuteRep


{- |
>>> map (map (\b -> if b then 'x' else '.')) $ Comb.choose 5 3
["..xxx",".x.xx",".xx.x",".xxx.","x..xx","x.x.x","x.xx.","xx..x","xx.x.","xxx.."]
>>> map (map (\b -> if b then 'x' else '.')) $ Comb.choose 3 5
[]

prop> QC.forAll (QC.choose (0,10)) $ \n k -> all (\x  ->  n == length x  &&  k == length (filter id x)) (Comb.choose n k)
-}
choose :: Int -> Int -> [[Bool]]
choose :: Int -> Int -> [[Bool]]
choose = Int -> Int -> [[Bool]]
Comb.chooseRec


{- |
Generate all choices of n elements out of the list x with repetitions.
\"variation\" seems to be used historically,
but I like it more than \"k-permutation\".

>>> Comb.variateRep 2 "abc"
["aa","ab","ac","ba","bb","bc","ca","cb","cc"]
-}
variateRep :: Int -> [a] -> [[a]]
variateRep :: forall a. Int -> [a] -> [[a]]
variateRep = forall a. Int -> [a] -> [[a]]
Comb.variateRep


{- |
Generate all choices of n elements out of the list x without repetitions.

>>> Comb.variate 2 "abc"
["ab","ac","ba","bc","ca","cb"]
>>> Comb.variate 2 "abcd"
["ab","ac","ad","ba","bc","bd","ca","cb","cd","da","db","dc"]
>>> Comb.variate 3 "abcd"
["abc","abd","acb","acd","adb","adc","bac","bad","bca","bcd","bda","bdc","cab","cad","cba","cbd","cda","cdb","dab","dac","dba","dbc","dca","dcb"]

prop> QC.forAll genVariate $ \xs -> Comb.variate (length xs) xs == Comb.permute xs
prop> \xs -> equating (take 1000) (Comb.variate (length xs) xs) (Comb.permute (xs::String))
-}
variate :: Int -> [a] -> [[a]]
variate :: forall a. Int -> [a] -> [[a]]
variate = forall a. Int -> [a] -> [[a]]
Comb.variateRec


{- |
Generate all choices of n elements out of the list x
respecting the order in x and without repetitions.

>>> Comb.tuples 2 "abc"
["ab","ac","bc"]
>>> Comb.tuples 2 "abcd"
["ab","ac","ad","bc","bd","cd"]
>>> Comb.tuples 3 "abcd"
["abc","abd","acd","bcd"]
-}
tuples :: Int -> [a] -> [[a]]
tuples :: forall a. Int -> [a] -> [[a]]
tuples = forall a. Int -> [a] -> [[a]]
Comb.tuplesRec


{- |
>>> Comb.partitions "abc"
[("abc",""),("bc","a"),("ac","b"),("c","ab"),("ab","c"),("b","ac"),("a","bc"),("","abc")]

prop> QC.forAll genVariate $ \xs -> length (Comb.partitions xs)  ==  2 ^ length xs
-}
partitions :: [a] -> [([a],[a])]
partitions :: forall a. [a] -> [([a], [a])]
partitions =
   forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
      (\a
x -> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\([a]
lxs,[a]
rxs) -> [(a
xforall a. a -> [a] -> [a]
:[a]
lxs,[a]
rxs), ([a]
lxs,a
xforall a. a -> [a] -> [a]
:[a]
rxs)]))
      [([],[])]

{- |
Number of possibilities arising in rectification of a predicate
in deductive database theory.
Stefan Brass, \"Logische Programmierung und deduktive Datenbanken\", 2007,
page 7-60
This is isomorphic to the partition of @n@-element sets
into @k@ non-empty subsets.
<http://oeis.org/A048993>

>>> Comb.rectifications 4 "abc"
["aabc","abac","abbc","abca","abcb","abcc"]
>>> map (length . uncurry Comb.rectifications) $ do x<-[0..10]; y<-[0..x]; return (x,[1..y::Int])
[1,0,1,0,1,1,0,1,3,1,0,1,7,6,1,0,1,15,25,10,1,0,1,31,90,65,15,1,0,1,63,301,350,140,21,1,0,1,127,966,1701,1050,266,28,1,0,1,255,3025,7770,6951,2646,462,36,1,0,1,511,9330,34105,42525,22827,5880,750,45,1]

prop> QC.forAll (QC.choose (0,7)) $ \k xs -> isAscending . Comb.rectifications k . nub . sort $ (xs::String)
-}
rectifications :: Int -> [a] -> [[a]]
rectifications :: forall a. Int -> [a] -> [[a]]
rectifications =
   let recourse :: [a] -> t -> [a] -> [[a]]
recourse [a]
_ t
0 [a]
xt =
          if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xt
            then [[]]
            else []
       recourse [a]
ys t
n [a]
xt =
          let n1 :: t
n1 = forall a. Enum a => a -> a
pred t
n
          in  forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (:) [a]
ys ([a] -> t -> [a] -> [[a]]
recourse [a]
ys t
n1 [a]
xt) forall a. [a] -> [a] -> [a]
++
              case [a]
xt of
                 [] -> []
                 (a
x:[a]
xs) -> forall a b. (a -> b) -> [a] -> [b]
map (a
xforall a. a -> [a] -> [a]
:) ([a] -> t -> [a] -> [[a]]
recourse ([a]
ysforall a. [a] -> [a] -> [a]
++[a
x]) t
n1 [a]
xs)
   in  forall {t} {a}. (Eq t, Num t, Enum t) => [a] -> t -> [a] -> [[a]]
recourse []

{- |
Their number is @k^n@.
-}
{-
setPartitionsEmpty :: Int -> [a] -> [[[a]]]
setPartitionsEmpty k =
   let recourse [] = [replicate k []]
       recourse (x:xs) =
          map (\(ys0,y,ys1) -> ys0 ++ [x:y] ++ ys1) $
          concatMap splitEverywhere (recourse xs)
{-
          do xs1 <- recourse xs
             (ys0,y,ys1) <- splitEverywhere xs1
             return (ys0 ++ [x:y] ++ ys1)
-}
   in  recourse
-}

-- TestMe: isAscending . Comb.setPartitions k . nub . sort
setPartitions :: Int -> [a] -> [[[a]]]
setPartitions :: forall a. Int -> [a] -> [[[a]]]
setPartitions Int
0 [a]
xs =
   if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xs
     then [[]]
     else [  ]
setPartitions Int
_ [] = []
setPartitions Int
1 [a]
xs = [[[a]
xs]]  -- unnecessary for correctness, but useful for efficiency
setPartitions Int
k (a
x:[a]
xs) =
   do ([a]
rest, [a]
choosen) <- forall a. [a] -> [([a], [a])]
partitions [a]
xs
      [[a]]
part <- forall a. Int -> [a] -> [[[a]]]
setPartitions (forall a. Enum a => a -> a
pred Int
k) [a]
rest
      forall (m :: * -> *) a. Monad m => a -> m a
return ((a
xforall a. a -> [a] -> [a]
:[a]
choosen) forall a. a -> [a] -> [a]
: [[a]]
part)


{- |
All ways of separating a list of terms into pairs.
All partitions are given in a canonical form,
sorted lexicographically.
The canonical form is:
The list of pairs is ordered with respect to the first pair members,
and the elements in each pair are ordered.
The order is implied by the order in the input list.

<http://oeis.org/A123023>
-}
pairPartitions :: [a] -> [[(a,a)]]
pairPartitions :: forall a. [a] -> [[(a, a)]]
pairPartitions [a]
xs =
   if forall a. Integral a => a -> Bool
odd (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs)
      then []
      else
         let go :: [b] -> [[(b, b)]]
go (b
y:[b]
ys) = do
               (b
z,[b]
zs) <- forall a. [a] -> [(a, [a])]
removeEach [b]
ys
               forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b
y,b
z)forall a. a -> [a] -> [a]
:) forall a b. (a -> b) -> a -> b
$ [b] -> [[(b, b)]]
go [b]
zs
             go [] = [[]]
         in forall a. [a] -> [[(a, a)]]
go [a]
xs


{-* Rank and unrank combinatorial objects. -}

{- |
@chooseUnrank n k i == choose n k !! i@

prop> QC.forAll (QC.choose (0,10)) $ \n k -> map (Comb.chooseUnrank n k) [0 .. Comb.binomial n k - 1]  ==  Comb.choose n k
prop> QC.forAll genChooseIndex $ \(n,k,i) -> Comb.chooseRank (Comb.chooseUnrank n k i)  ==  (n, k, i)
prop> \bs -> uncurry3 Comb.chooseUnrank (Comb.chooseRank bs :: (Integer, Integer, Integer))  ==  bs
-}
chooseUnrank :: Integral a => a -> a -> a -> [Bool]
chooseUnrank :: forall a. Integral a => a -> a -> a -> [Bool]
chooseUnrank = forall a. Integral a => a -> a -> a -> [Bool]
Comb.chooseUnrankRec

chooseUnrankMaybe :: Int -> Int -> Int -> Maybe [Bool]
chooseUnrankMaybe :: Int -> Int -> Int -> Maybe [Bool]
chooseUnrankMaybe Int
n Int
k Int
i =
   forall a. Bool -> a -> Maybe a
toMaybe
      (Int
0 forall a. Ord a => a -> a -> Bool
<= Int
i Bool -> Bool -> Bool
&& Int
i forall a. Ord a => a -> a -> Bool
< forall a. Integral a => a -> a -> a
binomial Int
n Int
k)
      (forall a. Integral a => a -> a -> a -> [Bool]
chooseUnrank Int
n Int
k Int
i)
-- error ("chooseUnrank: out of range " ++ show (n, k, i))


{- |
<https://en.wikipedia.org/wiki/Combinatorial_number_system>
-}
chooseRank :: Integral a => [Bool] -> (a, a, a)
chooseRank :: forall a. Integral a => [Bool] -> (a, a, a)
chooseRank =
   forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl
      (\(a
n,a
k0,a
i0) ([a]
bins,Bool
b) ->
        let (a
k1,a
i1) = if Bool
b then (forall a. Enum a => a -> a
succ a
k0, a
i0 forall a. Num a => a -> a -> a
+ forall i a. Integral i => [a] -> i -> a
genericIndex ([a]
binsforall a. [a] -> [a] -> [a]
++[a
0]) a
k1) else (a
k0,a
i0)
        in  (forall a. Enum a => a -> a
succ a
n, a
k1, a
i1))
      (a
0,a
0,a
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall a b. [a] -> [b] -> [(a, b)]
zip forall a. Num a => [[a]]
binomials forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall a. [a] -> [a]
reverse


{-* Generate complete lists of combinatorial numbers. -}


{- |
prop> QC.forAll (take 8 <$> QC.arbitrary) $ \xs -> length (Comb.permute xs) == Comb.factorial (length (xs::String))
prop> QC.forAll (take 6 <$> QC.arbitrary) $ \xs -> sum (map sum (Comb.permute xs)) == sum xs * Comb.factorial (length xs)
-}
factorial :: Integral a => a -> a
factorial :: forall a. Integral a => a -> a
factorial a
n = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [a
1..a
n]

{- |
Pascal's triangle containing the binomial coefficients.

prop> QC.forAll (QC.choose (0,12)) $ \n k -> length (Comb.choose n k) == Comb.binomial n k
prop> QC.forAll genBinomial $ \(n,k) -> let (q, r) = divMod (Comb.factorial n) (Comb.factorial k * Comb.factorial (n-k)) in r == 0 && Comb.binomial n k == q
prop> QC.forAll (take 16 <$> QC.arbitrary) $ \xs k -> length (Comb.tuples k xs) == Comb.binomial (length (xs::String)) k
-}
binomial :: Integral a => a -> a -> a
binomial :: forall a. Integral a => a -> a -> a
binomial = forall a. Integral a => a -> a -> a
Comb.binomial

binomialSeq :: Integral a => a -> [a]
binomialSeq :: forall a. Integral a => a -> [a]
binomialSeq = forall a. Integral a => a -> [a]
Comb.binomialSeq


binomialGen :: (Integral a, Fractional b) => b -> a -> b
binomialGen :: forall a b. (Integral a, Fractional b) => b -> a -> b
binomialGen b
n a
k = forall i a. Integral i => [a] -> i -> a
genericIndex (forall b. Fractional b => b -> [b]
binomialSeqGen b
n) a
k

binomialSeqGen :: (Fractional b) => b -> [b]
binomialSeqGen :: forall b. Fractional b => b -> [b]
binomialSeqGen b
n =
   forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (\b
acc (b
num,b
den) -> b
accforall a. Num a => a -> a -> a
*b
num forall a. Fractional a => a -> a -> a
/ b
den) b
1
         (forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. (a -> a) -> a -> [a]
iterate (forall a. Num a => a -> a -> a
subtract b
1) b
n) (forall a. (a -> a) -> a -> [a]
iterate (b
1forall a. Num a => a -> a -> a
+) b
1))


{- |
prop> QC.forAll (genPermuteRep 10) $ \xs -> length (Comb.permuteRep xs) == Comb.multinomial (map snd xs)
prop> QC.forAll (QC.listOf $ QC.choose (0,300::Integer)) $ \xs -> Comb.multinomial xs == Comb.multinomial (sort xs)
-}
multinomial :: Integral a => [a] -> a
multinomial :: forall a. Integral a => [a] -> a
multinomial =
   forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> a -> b) -> [a] -> [b]
mapAdjacent forall a. Integral a => a -> a -> a
binomial forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> a) -> [a] -> [a]
scanr1 forall a. Num a => a -> a -> a
(+)


{-* Generate complete lists of factorial numbers. -}

{- |
prop> equalFuncList Comb.factorial Comb.factorials 1000
-}
factorials :: Num a => [a]
factorials :: forall a. Num a => [a]
factorials = forall a. Num a => [a]
Comb.factorials

{-|
Pascal's triangle containing the binomial coefficients.
Only efficient if a prefix of all rows is required.
It is not efficient for picking particular rows
or even particular elements.

prop> equalFuncList2 Comb.binomial Comb.binomials 100
-}
binomials :: Num a => [[a]]
binomials :: forall a. Num a => [[a]]
binomials = forall a. Num a => [[a]]
Comb.binomials


{- |
@catalanNumber n@ computes the number of binary trees with @n@ nodes.
-}
catalanNumber :: Integer -> Integer
catalanNumber :: Integer -> Integer
catalanNumber Integer
n =
   case forall a. Integral a => a -> a -> (a, a)
divMod (forall a. Integral a => a -> a -> a
binomial (Integer
2forall a. Num a => a -> a -> a
*Integer
n) Integer
n) (Integer
nforall a. Num a => a -> a -> a
+Integer
1) of
      (Integer
c,Integer
0) -> Integer
c
      (Integer, Integer)
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"catalanNumber: Integer implementation broken"

{- |
Compute the sequence of Catalan numbers by recurrence identity.
It is @catalanNumbers !! n == catalanNumber n@

prop> equalFuncList Comb.catalanNumber Comb.catalanNumbers 1000
-}
catalanNumbers :: Num a => [a]
catalanNumbers :: forall a. Num a => [a]
catalanNumbers =
   let xs :: [a]
xs = a
1 forall a. a -> [a] -> [a]
: forall a. Num a => [a] -> [a] -> [a]
PowerSeries.mul [a]
xs [a]
xs
   in  [a]
xs



derangementNumber :: Integer -> Integer
derangementNumber :: Integer -> Integer
derangementNumber Integer
n =
   forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl forall a. Num a => a -> a -> a
(*) ((-Integer
1) forall a b. (Num a, Integral b) => a -> b -> a
^ forall a. Integral a => a -> a -> a
mod Integer
n Integer
2) [-Integer
n,Integer
1forall a. Num a => a -> a -> a
-Integer
n..(-Integer
1)])

{- |
Number of fix-point-free permutations with @n@ elements.

<http://oeis.org/A000166>

prop> equalFuncList Comb.derangementNumber Comb.derangementNumbers 1000
-}
derangementNumbers :: Num a => [a]
derangementNumbers :: forall a. Num a => [a]
derangementNumbers = forall a. Num a => [a]
Comb.derangementNumbersPS0


-- generation of all possibilities and computation of their number should be in different modules

{- |
Number of partitions of an @n@ element set into @k@ non-empty subsets.
Known as Stirling numbers <http://oeis.org/A048993>.

prop> QC.forAll (QC.choose (0,10000)) $ \k -> QC.forAll (take 7 <$> QC.arbitrary) $ \xs -> length (Comb.setPartitions k xs) == (Comb.setPartitionNumbers !! length (xs::String) ++ repeat 0) !! k
prop> QC.forAll (QC.choose (0,7)) $ \k xs -> length (Comb.rectifications k xs) == (Comb.setPartitionNumbers !! k ++ repeat 0) !! length (xs::String)
-}
setPartitionNumbers :: Num a => [[a]]
setPartitionNumbers :: forall a. Num a => [[a]]
setPartitionNumbers = forall a. Num a => [[a]]
Comb.setPartitionNumbers


{- |
@surjectiveMappingNumber n k@ computes the number of surjective mappings
from a @n@ element set to a @k@ element set.

<http://oeis.org/A019538>
-}
surjectiveMappingNumber :: Integer -> Integer -> Integer
surjectiveMappingNumber :: Integer -> Integer -> Integer
surjectiveMappingNumber Integer
n Integer
k =
   forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall a. Num a => a -> a -> a
subtract Integer
0 forall a b. (a -> b) -> a -> b
$
   forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. Num a => a -> a -> a
(*)
      (forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (Num a, Integral b) => a -> b -> a
^Integer
n) [Integer
0..])
      (forall a. Integral a => a -> [a]
binomialSeq Integer
k)

{- |
prop> equalFuncList2 Comb.surjectiveMappingNumber Comb.surjectiveMappingNumbers 20
-}
surjectiveMappingNumbers :: Num a => [[a]]
surjectiveMappingNumbers :: forall a. Num a => [[a]]
surjectiveMappingNumbers = forall a. Num a => [[a]]
Comb.surjectiveMappingNumbersPS


{- |
Multiply two Fibonacci matrices, that is matrices of the form

> /F[n-1] F[n]  \
> \F[n]   F[n+1]/
-}
fiboMul ::
   (Integer,Integer,Integer) ->
   (Integer,Integer,Integer) ->
   (Integer,Integer,Integer)
fiboMul :: (Integer, Integer, Integer)
-> (Integer, Integer, Integer) -> (Integer, Integer, Integer)
fiboMul (Integer
f0,Integer
f1,Integer
f2) (Integer
g0,Integer
g1,Integer
g2) =
   let h0 :: Integer
h0 = Integer
f0forall a. Num a => a -> a -> a
*Integer
g0 forall a. Num a => a -> a -> a
+ Integer
f1forall a. Num a => a -> a -> a
*Integer
g1
       h1 :: Integer
h1 = Integer
f0forall a. Num a => a -> a -> a
*Integer
g1 forall a. Num a => a -> a -> a
+ Integer
f1forall a. Num a => a -> a -> a
*Integer
g2
--     h1 = f1*g0 + f2*g1
       h2 :: Integer
h2 = Integer
f1forall a. Num a => a -> a -> a
*Integer
g1 forall a. Num a => a -> a -> a
+ Integer
f2forall a. Num a => a -> a -> a
*Integer
g2
   in  (Integer
h0,Integer
h1,Integer
h2)


{-
Fast computation using matrix power of

> /0 1\
> \1 1/

Hard-coded fast power with integer exponent.
Better use a generic algorithm.
-}
fibonacciNumber :: Integer -> Integer
fibonacciNumber :: Integer -> Integer
fibonacciNumber Integer
x =
   let aux :: a -> (Integer, Integer, Integer)
aux   a
0  = (Integer
1,Integer
0,Integer
1)
       aux (-1) = (-Integer
1,Integer
1,Integer
0)
       aux a
n =
          let (a
m,a
r) = forall a. Integral a => a -> a -> (a, a)
divMod a
n a
2
              f :: (Integer, Integer, Integer)
f = a -> (Integer, Integer, Integer)
aux a
m
              f2 :: (Integer, Integer, Integer)
f2 = (Integer, Integer, Integer)
-> (Integer, Integer, Integer) -> (Integer, Integer, Integer)
fiboMul (Integer, Integer, Integer)
f (Integer, Integer, Integer)
f
          in  if a
rforall a. Eq a => a -> a -> Bool
==a
0
                then (Integer, Integer, Integer)
f2
                else (Integer, Integer, Integer)
-> (Integer, Integer, Integer) -> (Integer, Integer, Integer)
fiboMul (Integer
0,Integer
1,Integer
1) (Integer, Integer, Integer)
f2
       (Integer
_,Integer
y,Integer
_) = forall {a}. Integral a => a -> (Integer, Integer, Integer)
aux Integer
x
   in  Integer
y


{- |
Number of possibilities to compose a 2 x n rectangle of n bricks.

>  |||   |--   --|
>  |||   |--   --|

prop> equalFuncList Comb.fibonacciNumber Comb.fibonacciNumbers 10000
-}
fibonacciNumbers :: [Integer]
fibonacciNumbers :: [Integer]
fibonacciNumbers =
   let xs :: [Integer]
xs = Integer
0 forall a. a -> [a] -> [a]
: [Integer]
ys
       ys :: [Integer]
ys = Integer
1 forall a. a -> [a] -> [a]
: forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. Num a => a -> a -> a
(+) [Integer]
xs [Integer]
ys
   in  [Integer]
xs



{- * Auxiliary functions -}

{- candidates for Useful -}

{- | Create a list of all possible rotations of the input list. -}
allCycles :: [a] -> [[a]]
allCycles :: forall a. [a] -> [[a]]
allCycles [a]
x =
   forall b a. [b] -> [a] -> [a]
Match.take [a]
x (forall a b. (a -> b) -> [a] -> [b]
map (forall b a. [b] -> [a] -> [a]
Match.take [a]
x) (forall a. (a -> a) -> a -> [a]
iterate forall a. [a] -> [a]
tail (forall a. [a] -> [a]
cycle [a]
x)))