module Combinatorics.Private where

import qualified PowerSeries
import Combinatorics.Utility (scalarProduct, )

import Data.Function.HT (nest, )
import Data.Maybe (mapMaybe, catMaybes, )
import Data.List.HT (tails, partition, removeEach, splitEverywhere, viewL, )
import Data.List
         (mapAccumL, intersperse, genericIndex, genericReplicate, genericTake, )

import qualified Control.Monad.Trans.Class as MT
import qualified Control.Monad.Trans.State as MS
import qualified Control.Monad.HT as Monad
import Control.Monad (MonadPlus, liftM, forM, guard, )


{- $setup
>>> import qualified Combinatorics.Private as CombPriv
>>> import Test.Combinatorics (genPermuteRep, genVariate, genChooseIndex)
>>>
>>> import qualified Test.QuickCheck as QC
>>> import Control.Applicative ((<$>))
>>> import Data.List.HT (allEqual)
>>> import Data.Eq.HT (equating)
>>>
>>> genChoose :: QC.Gen (Int, Int)
>>> genChoose = do
>>>    n <- QC.choose (0,15)
>>>    k <- QC.choose (-2,n)
>>>    return (n,k)
>>>
>>> genTuples :: QC.Gen (Int, [Char])
>>> genTuples = do
>>>    xs <- take 16 <$> QC.arbitrary
>>>    n <- QC.choose (-1, length xs + 1)
>>>    return (n,xs)
-}


replicateM :: (MonadPlus m) => Int -> m a -> m [a]
replicateM :: forall (m :: * -> *) a. MonadPlus m => Int -> m a -> m [a]
replicateM Int
n m a
m = forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
nforall a. Ord a => a -> a -> Bool
>=Int
0) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
Monad.replicate Int
n m a
m


{- |
prop> QC.forAll (take 6 <$> QC.arbitrary) $ \xs -> CombPriv.permuteRec xs == CombPriv.permuteMSL (xs::[Int])
-}
permuteRec :: [a] -> [[a]]
permuteRec :: forall a. [a] -> [[a]]
permuteRec =
   let go :: [a] -> [[a]]
go [] = [[]]
       go [a]
x = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(a
y, [a]
ys) -> forall a b. (a -> b) -> [a] -> [b]
map (a
yforall a. a -> [a] -> [a]
:) ([a] -> [[a]]
go [a]
ys)) (forall a. [a] -> [(a, [a])]
removeEach [a]
x)
   in  forall a. [a] -> [[a]]
go

permuteMSL :: [a] -> [[a]]
permuteMSL :: forall a. [a] -> [[a]]
permuteMSL [a]
xs = forall a. Int -> [a] -> [[a]]
variateMSL (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs) [a]
xs



runPermuteRep :: ([(a,Int)] -> [[a]]) -> [(a,Int)] -> [[a]]
runPermuteRep :: forall a. ([(a, Int)] -> [[a]]) -> [(a, Int)] -> [[a]]
runPermuteRep [(a, Int)] -> [[a]]
f [(a, Int)]
xs =
   let ([(a, Int)]
ps,[(a, Int)]
ns) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((forall a. Ord a => a -> a -> Bool
>Int
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(a, Int)]
xs
   in  if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((forall a. Ord a => a -> a -> Bool
<Int
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(a, Int)]
ns
         then []
         else [(a, Int)] -> [[a]]
f [(a, Int)]
ps

{- |
prop> QC.forAll (genPermuteRep 10) $ \xs -> CombPriv.permuteRep xs == CombPriv.permuteRepM xs
-}
permuteRep :: [(a,Int)] -> [[a]]
permuteRep :: forall a. [(a, Int)] -> [[a]]
permuteRep =
   let go :: [(a, a)] -> [[a]]
go [] = [[]]
       go [(a, a)]
xs =
         forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\([(a, a)]
ys,(a
a,a
n),[(a, a)]
zs) ->
            let m :: a
m = forall a. Enum a => a -> a
pred a
n
            in  forall a b. (a -> b) -> [a] -> [b]
map (a
aforall a. a -> [a] -> [a]
:) ([(a, a)] -> [[a]]
go ([(a, a)]
ys forall a. [a] -> [a] -> [a]
++ (a
mforall a. Ord a => a -> a -> Bool
>a
0, (a
a, a
m)) forall a. (Bool, a) -> [a] -> [a]
?: [(a, a)]
zs))) forall a b. (a -> b) -> a -> b
$
         forall a. (a -> Bool) -> [a] -> [a]
filter (\([(a, a)]
_,(a
_,a
n),[(a, a)]
_) -> a
nforall a. Ord a => a -> a -> Bool
>a
0) forall a b. (a -> b) -> a -> b
$
         forall a. [a] -> [([a], a, [a])]
splitEverywhere [(a, a)]
xs
   in forall a. ([(a, Int)] -> [[a]]) -> [(a, Int)] -> [[a]]
runPermuteRep forall {a} {a}. (Ord a, Num a, Enum a) => [(a, a)] -> [[a]]
go

permuteRepM :: [(a,Int)] -> [[a]]
permuteRepM :: forall a. [(a, Int)] -> [[a]]
permuteRepM =
   let go :: [(a, a)] -> [[a]]
go [] = [[]]
       go [(a, a)]
xs =
         do ([(a, a)]
ys,(a
a,a
n),[(a, a)]
zs) <- forall a. [a] -> [([a], a, [a])]
splitEverywhere [(a, a)]
xs
            let m :: a
m = forall a. Enum a => a -> a
pred a
n
            forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (a
aforall a. a -> [a] -> [a]
:) ([(a, a)] -> [[a]]
go ([(a, a)]
ys forall a. [a] -> [a] -> [a]
++ (a
mforall a. Ord a => a -> a -> Bool
>a
0, (a
a, a
m)) forall a. (Bool, a) -> [a] -> [a]
?: [(a, a)]
zs))
   in forall a. ([(a, Int)] -> [[a]]) -> [(a, Int)] -> [[a]]
runPermuteRep forall {a} {a}. (Ord a, Num a, Enum a) => [(a, a)] -> [[a]]
go


infixr 5 ?:

(?:) :: (Bool, a) -> [a] -> [a]
(Bool
True,a
a)  ?: :: forall a. (Bool, a) -> [a] -> [a]
?: [a]
xs = a
aforall a. a -> [a] -> [a]
:[a]
xs
(Bool
False,a
_) ?: [a]
xs = [a]
xs


{- |
prop> QC.forAll genChoose $ \(n,k) -> allEqual $ CombPriv.chooseRec n k : CombPriv.chooseMSL n k : CombPriv.chooseMSL0 n k : []
-}
chooseRec :: Int -> Int -> [[Bool]]
chooseRec :: Int -> Int -> [[Bool]]
chooseRec =
   let go :: t -> t -> [[Bool]]
go t
n t
k =
         if t
kforall a. Ord a => a -> a -> Bool
<t
0 Bool -> Bool -> Bool
|| t
kforall a. Ord a => a -> a -> Bool
>t
n
           then []
           else
             if t
nforall a. Eq a => a -> a -> Bool
==t
0
               then [[]]
               else
                 forall a b. (a -> b) -> [a] -> [b]
map (Bool
Falseforall a. a -> [a] -> [a]
:) (t -> t -> [[Bool]]
go (forall a. Enum a => a -> a
pred t
n) t
k) forall a. [a] -> [a] -> [a]
++
                 forall a b. (a -> b) -> [a] -> [b]
map (Bool
Trueforall a. a -> [a] -> [a]
:)  (t -> t -> [[Bool]]
go (forall a. Enum a => a -> a
pred t
n) (forall a. Enum a => a -> a
pred t
k))
   in forall {t}. (Ord t, Num t, Enum t) => t -> t -> [[Bool]]
go

chooseMSL :: Int -> Int -> [[Bool]]
chooseMSL :: Int -> Int -> [[Bool]]
chooseMSL Int
n0 Int
k0 =
   forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
MS.evalStateT Int
k0 forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall a b. (a -> b) -> a -> b
$
   forall a. a -> [a] -> [a]
intersperse (forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
MS.StateT forall a b. (a -> b) -> a -> b
$ \Int
k -> [(forall a. a -> Maybe a
Just Bool
False, Int
k), (forall a. a -> Maybe a
Just Bool
True, forall a. Enum a => a -> a
pred Int
k)]) forall a b. (a -> b) -> a -> b
$
   forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> [a] -> [b]
map [Int
n0,Int
n0forall a. Num a => a -> a -> a
-Int
1..Int
0] forall a b. (a -> b) -> a -> b
$ \Int
n ->
   forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
MS.gets (\Int
k -> Int
0forall a. Ord a => a -> a -> Bool
<=Int
k Bool -> Bool -> Bool
&& Int
kforall a. Ord a => a -> a -> Bool
<=Int
n) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

chooseMSL0 :: Int -> Int -> [[Bool]]
chooseMSL0 :: Int -> Int -> [[Bool]]
chooseMSL0 Int
n0 Int
k0 =
   forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
MS.evalStateT Int
k0 forall a b. (a -> b) -> a -> b
$ do
   [Bool]
count <-
      forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int
n0,Int
n0forall a. Num a => a -> a -> a
-Int
1..Int
1] forall a b. (a -> b) -> a -> b
$ \Int
n ->
      forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
MS.StateT forall a b. (a -> b) -> a -> b
$ \Int
k ->
      forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
0forall a. Ord a => a -> a -> Bool
<=Int
k Bool -> Bool -> Bool
&& Int
kforall a. Ord a => a -> a -> Bool
<=Int
n) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [(Bool
False, Int
k), (Bool
True, forall a. Enum a => a -> a
pred Int
k)]
   forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
MS.gets (Int
0forall a. Eq a => a -> a -> Bool
==) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (f :: * -> *). Alternative f => Bool -> f ()
guard
   forall (m :: * -> *) a. Monad m => a -> m a
return [Bool]
count


{- |
prop> QC.forAll (QC.choose (-1,7)) $ \n -> QC.forAll genVariate $ \xs -> CombPriv.variateRep n xs == CombPriv.variateRepM n xs
-}
variateRep :: Int -> [a] -> [[a]]
variateRep :: forall a. Int -> [a] -> [[a]]
variateRep Int
n [a]
x =
   if Int
nforall a. Ord a => a -> a -> Bool
<Int
0 then [] else forall a. Int -> (a -> a) -> a -> a
nest Int
n (\[[a]]
y -> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\a
z -> forall a b. (a -> b) -> [a] -> [b]
map (a
zforall a. a -> [a] -> [a]
:) [[a]]
y) [a]
x) [[]]

variateRepM :: Int -> [a] -> [[a]]
variateRepM :: forall a. Int -> [a] -> [[a]]
variateRepM = forall (m :: * -> *) a. MonadPlus m => Int -> m a -> m [a]
replicateM


{- |
prop> QC.forAll (QC.choose (-1,7)) $ \n -> QC.forAll genVariate $ \xs -> CombPriv.variateRec n xs == CombPriv.variateMSL n xs
-}
variateRec :: Int -> [a] -> [[a]]
variateRec :: forall a. Int -> [a] -> [[a]]
variateRec =
   let go :: t -> [a] -> [[a]]
go t
n =
         case forall a. Ord a => a -> a -> Ordering
compare t
n t
0 of
            Ordering
LT -> forall a b. a -> b -> a
const []
            Ordering
EQ -> forall a b. a -> b -> a
const [[]]
            Ordering
GT -> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(a
y, [a]
ys) -> forall a b. (a -> b) -> [a] -> [b]
map (a
yforall a. a -> [a] -> [a]
:) (t -> [a] -> [[a]]
go (t
nforall a. Num a => a -> a -> a
-t
1) [a]
ys)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [(a, [a])]
removeEach
   in  forall {t} {a}. (Ord t, Num t) => t -> [a] -> [[a]]
go

variateMSL :: Int -> [a] -> [[a]]
variateMSL :: forall a. Int -> [a] -> [[a]]
variateMSL Int
n = forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
MS.evalStateT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadPlus m => Int -> m a -> m [a]
replicateM Int
n forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
MS.StateT forall a. [a] -> [(a, [a])]
removeEach



{- |
prop> QC.forAll genTuples $ \(n,xs) -> allEqual $ CombPriv.tuplesRec n xs : CombPriv.tuplesRec0 n xs : CombPriv.tuplesMSL n xs : CombPriv.tuplesMSL0 n xs : []
-}
tuplesRec :: Int -> [a] -> [[a]]
tuplesRec :: forall a. Int -> [a] -> [[a]]
tuplesRec =
   let go :: t -> [a] -> [[a]]
go t
r =
         case forall a. Ord a => a -> a -> Ordering
compare t
r t
0 of
            Ordering
LT -> forall a b. a -> b -> a
const []
            Ordering
EQ -> forall a b. a -> b -> a
const [[]]
            Ordering
GT -> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(a
y:[a]
ys) -> forall a b. (a -> b) -> [a] -> [b]
map (a
yforall a. a -> [a] -> [a]
:) (t -> [a] -> [[a]]
go (t
rforall a. Num a => a -> a -> a
-t
1) [a]
ys)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
init forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [[a]]
tails
   in  forall {t} {a}. (Ord t, Num t) => t -> [a] -> [[a]]
go

tuplesRec0 :: Int -> [a] -> [[a]]
tuplesRec0 :: forall a. Int -> [a] -> [[a]]
tuplesRec0 =
   let go :: t -> [a] -> [[a]]
go t
k =
         if t
kforall a. Ord a => a -> a -> Bool
<t
0
           then forall a b. a -> b -> a
const []
           else
             \ [a]
xt ->
             case [a]
xt of
                [] -> forall (f :: * -> *). Alternative f => Bool -> f ()
guard (t
kforall a. Eq a => a -> a -> Bool
==t
0) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [[]]
                a
x:[a]
xs -> forall a b. (a -> b) -> [a] -> [b]
map (a
xforall a. a -> [a] -> [a]
:) (t -> [a] -> [[a]]
go (forall a. Enum a => a -> a
pred t
k) [a]
xs) forall a. [a] -> [a] -> [a]
++ t -> [a] -> [[a]]
go t
k [a]
xs
   in forall {t} {a}. (Ord t, Num t, Enum t) => t -> [a] -> [[a]]
go

tuplesMSL :: Int -> [a] -> [[a]]
tuplesMSL :: forall a. Int -> [a] -> [[a]]
tuplesMSL Int
n [a]
xs =
   forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
MS.evalStateT [a]
xs forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadPlus m => Int -> m a -> m [a]
replicateM Int
n forall a b. (a -> b) -> a -> b
$
   forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
MS.StateT forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall a. [a] -> Maybe (a, [a])
viewL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [[a]]
tails

tuplesMSL0 :: Int -> [a] -> [[a]]
tuplesMSL0 :: forall a. Int -> [a] -> [[a]]
tuplesMSL0 Int
n [a]
xs =
   forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
MS.evalStateT [a]
xs forall a b. (a -> b) -> a -> b
$
   forall (m :: * -> *) a. MonadPlus m => Int -> m a -> m [a]
replicateM Int
n forall a b. (a -> b) -> a -> b
$ do
      [a]
yl <- forall (m :: * -> *) s. Monad m => StateT s m s
MS.get
      (a
y:[a]
ys) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
MT.lift forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [[a]]
tails [a]
yl
      forall (m :: * -> *) s. Monad m => s -> StateT s m ()
MS.put [a]
ys
      forall (m :: * -> *) a. Monad m => a -> m a
return a
y


{- |
prop> QC.forAll genChooseIndex $ \(n,k,i) -> CombPriv.chooseUnrankRec n k i  ==  CombPriv.chooseUnrankList n k i
-}
chooseUnrankRec :: Integral a => a -> a -> a -> [Bool]
chooseUnrankRec :: forall a. Integral a => a -> a -> a -> [Bool]
chooseUnrankRec =
   let go :: t -> t -> t -> [Bool]
go t
n t
0 t
_ = forall i a. Integral i => i -> a -> [a]
genericReplicate t
n Bool
False
       go t
n t
k t
i =
          let n1 :: t
n1 = forall a. Enum a => a -> a
pred t
n
              p :: t
p = forall a. Integral a => a -> a -> a
binomial t
n1 t
k
              b :: Bool
b = t
iforall a. Ord a => a -> a -> Bool
>=t
p
              (t
k1,t
i1) = if Bool
b then (forall a. Enum a => a -> a
pred t
k, t
iforall a. Num a => a -> a -> a
-t
p) else (t
k,t
i)
          in  Bool
b forall a. a -> [a] -> [a]
: t -> t -> t -> [Bool]
go t
n1 t
k1 t
i1
   in forall a. Integral a => a -> a -> a -> [Bool]
go

chooseUnrankList :: Integral a => a -> a -> a -> [Bool]
chooseUnrankList :: forall a. Integral a => a -> a -> a -> [Bool]
chooseUnrankList a
n a
k0 a
i0 =
--   (\((0,0), xs) -> xs) $
   forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$
   forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL
      (\(a
k,a
i) [a]
bins ->
          let p :: a
p = forall i a. Integral i => [a] -> i -> a
genericIndex ([a]
binsforall a. [a] -> [a] -> [a]
++[a
0]) a
k
              b :: Bool
b = a
iforall a. Ord a => a -> a -> Bool
>=a
p
          in  (if Bool
b
                 then (forall a. Enum a => a -> a
pred a
k, a
iforall a. Num a => a -> a -> a
-a
p)
                 else (a
k, a
i),
               Bool
b))
      (a
k0,a
i0) forall a b. (a -> b) -> a -> b
$
   forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$
   forall i a. Integral i => i -> [a] -> [a]
genericTake a
n forall a. Num a => [[a]]
binomials


binomial :: Integral a => a -> a -> a
binomial :: forall a. Integral a => a -> a -> a
binomial a
n a
k =
   let bino :: a -> i -> a
bino a
n' i
k' =
         if i
k'forall a. Ord a => a -> a -> Bool
<i
0
           then a
0
           else forall i a. Integral i => [a] -> i -> a
genericIndex (forall a. Integral a => a -> [a]
binomialSeq a
n') i
k'
   in  if a
nforall a. Ord a => a -> a -> Bool
<a
2forall a. Num a => a -> a -> a
*a
k
         then forall {i} {a}. (Integral i, Integral a) => a -> i -> a
bino a
n (a
nforall a. Num a => a -> a -> a
-a
k)
         else forall {i} {a}. (Integral i, Integral a) => a -> i -> a
bino a
n a
k

binomialSeq :: Integral a => a -> [a]
binomialSeq :: forall a. Integral a => a -> [a]
binomialSeq a
n =
   {- this does not work because the corresponding numbers are not always divisible
    product (zipWith div [n', pred n' ..] [1..k'])
   -}
   forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (\a
acc (a
num,a
den) -> forall a. Integral a => a -> a -> a
div (a
accforall a. Num a => a -> a -> a
*a
num) a
den) a
1
         (forall a b. [a] -> [b] -> [(a, b)]
zip [a
n, forall a. Enum a => a -> a
pred a
n ..] [a
1..a
n])


factorials :: Num a => [a]
factorials :: forall a. Num a => [a]
factorials = forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl forall a. Num a => a -> a -> a
(*) a
1 (forall a. (a -> a) -> a -> [a]
iterate (forall a. Num a => a -> a -> a
+a
1) a
1)

{-|
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.
-}
binomials :: Num a => [[a]]
binomials :: forall a. Num a => [[a]]
binomials =
   let conv11 :: [c] -> [c]
conv11 [c]
x = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. Num a => a -> a -> a
(+) ([c
0]forall a. [a] -> [a] -> [a]
++[c]
x) ([c]
xforall a. [a] -> [a] -> [a]
++[c
0])
   in  forall a. (a -> a) -> a -> [a]
iterate forall {c}. Num c => [c] -> [c]
conv11 [a
1]


{- |
prop> allEqual $ map (take 1000) (CombPriv.derangementNumbersPS0 : CombPriv.derangementNumbersPS1 : CombPriv.derangementNumbersInclExcl : [] :: [[Integer]])
-}
derangementNumbersPS0 :: Num a => [a]
derangementNumbersPS0 :: forall a. Num a => [a]
derangementNumbersPS0 =
   -- OEIS-A166: a(n) = n·a(n-1)+(-1)^n
   -- y(x) = 1/(1+x) + x · (t -> y(t)·t)'(x)
   let xs :: [a]
xs = forall a. Num a => [a] -> [a] -> [a]
PowerSeries.add
               (forall a. [a] -> [a]
cycle [a
1,-a
1])
               (a
0 forall a. a -> [a] -> [a]
: forall {c}. Num c => [c] -> [c]
PowerSeries.differentiate (a
0 forall a. a -> [a] -> [a]
: [a]
xs))
   in  [a]
xs

derangementNumbersPS1 :: Num a => [a]
derangementNumbersPS1 :: forall a. Num a => [a]
derangementNumbersPS1 =
   -- OEIS-A166: a(n) = (n-1)·(a(n-1)+a(n-2))
   -- y(x) = 1 + x^2 · (t -> y(t)·(1+t))'(x)
   let xs :: [a]
xs = a
1 forall a. a -> [a] -> [a]
: a
0 forall a. a -> [a] -> [a]
: forall {c}. Num c => [c] -> [c]
PowerSeries.differentiate (forall a. Num a => [a] -> [a] -> [a]
PowerSeries.add [a]
xs (a
0 forall a. a -> [a] -> [a]
: [a]
xs))
   in  [a]
xs

derangementNumbersInclExcl :: Num a => [a]
derangementNumbersInclExcl :: forall a. Num a => [a]
derangementNumbersInclExcl =
   let xs :: [a]
xs = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) forall a. Num a => [a]
factorials (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Num a => [a] -> [a] -> a
scalarProduct [a]
xs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
init) forall a. Num a => [[a]]
binomials)
   in  [a]
xs


setPartitionNumbers :: Num a => [[a]]
setPartitionNumbers :: forall a. Num a => [[a]]
setPartitionNumbers =
   -- s_{n+1,k} = s_{n,k-1} + k·s_{n,k}
   forall a. (a -> a) -> a -> [a]
iterate (\[a]
x -> a
0 forall a. a -> [a] -> [a]
: forall a. Num a => [a] -> [a] -> [a]
PowerSeries.add [a]
x (forall {c}. Num c => [c] -> [c]
PowerSeries.differentiate [a]
x)) [a
1]


{- |
prop> equating (take 20) CombPriv.surjectiveMappingNumbersPS (CombPriv.surjectiveMappingNumbersStirling :: [[Integer]])
-}
surjectiveMappingNumbersPS :: Num a => [[a]]
surjectiveMappingNumbersPS :: forall a. Num a => [[a]]
surjectiveMappingNumbersPS =
   forall a. (a -> a) -> a -> [a]
iterate
      (\[a]
x -> a
0 forall a. a -> [a] -> [a]
: forall {c}. Num c => [c] -> [c]
PowerSeries.differentiate (forall a. Num a => [a] -> [a] -> [a]
PowerSeries.add [a]
x (a
0 forall a. a -> [a] -> [a]
: [a]
x)))
      [a
1]

surjectiveMappingNumbersStirling :: Num a => [[a]]
surjectiveMappingNumbersStirling :: forall a. Num a => [[a]]
surjectiveMappingNumbersStirling =
   forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. Num a => a -> a -> a
(*) forall a. Num a => [a]
factorials) forall a. Num a => [[a]]
setPartitionNumbers