-- | Partitions of integers.
-- Integer partitions are nonincreasing sequences of positive integers.
--
-- See:
--
--  * Donald E. Knuth: The Art of Computer Programming, vol 4, pre-fascicle 3B.
--
--  * <http://en.wikipedia.org/wiki/Partition_(number_theory)>
--
-- For example the partition
--
-- > Partition [8,6,3,3,1]
--
-- can be represented by the (English notation) Ferrers diagram:
--
-- <<svg/ferrers.svg>>
-- 

{-# LANGUAGE CPP, BangPatterns, ScopedTypeVariables #-}
module Math.Combinat.Partitions.Integer where

--------------------------------------------------------------------------------

import Data.List
import Control.Monad ( liftM , replicateM )

-- import Data.Map (Map)
-- import qualified Data.Map as Map

import Math.Combinat.Classes
import Math.Combinat.ASCII as ASCII
import Math.Combinat.Numbers (factorial,binomial,multinomial)
import Math.Combinat.Helper

import Data.Array
import System.Random

--------------------------------------------------------------------------------
-- * Type and basic stuff

-- | A partition of an integer. The additional invariant enforced here is that partitions 
-- are monotone decreasing sequences of /positive/ integers. The @Ord@ instance is lexicographical.
newtype Partition = Partition [Int] deriving (Partition -> Partition -> Bool
(Partition -> Partition -> Bool)
-> (Partition -> Partition -> Bool) -> Eq Partition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Partition -> Partition -> Bool
$c/= :: Partition -> Partition -> Bool
== :: Partition -> Partition -> Bool
$c== :: Partition -> Partition -> Bool
Eq,Eq Partition
Eq Partition
-> (Partition -> Partition -> Ordering)
-> (Partition -> Partition -> Bool)
-> (Partition -> Partition -> Bool)
-> (Partition -> Partition -> Bool)
-> (Partition -> Partition -> Bool)
-> (Partition -> Partition -> Partition)
-> (Partition -> Partition -> Partition)
-> Ord Partition
Partition -> Partition -> Bool
Partition -> Partition -> Ordering
Partition -> Partition -> Partition
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Partition -> Partition -> Partition
$cmin :: Partition -> Partition -> Partition
max :: Partition -> Partition -> Partition
$cmax :: Partition -> Partition -> Partition
>= :: Partition -> Partition -> Bool
$c>= :: Partition -> Partition -> Bool
> :: Partition -> Partition -> Bool
$c> :: Partition -> Partition -> Bool
<= :: Partition -> Partition -> Bool
$c<= :: Partition -> Partition -> Bool
< :: Partition -> Partition -> Bool
$c< :: Partition -> Partition -> Bool
compare :: Partition -> Partition -> Ordering
$ccompare :: Partition -> Partition -> Ordering
$cp1Ord :: Eq Partition
Ord,Int -> Partition -> ShowS
[Partition] -> ShowS
Partition -> String
(Int -> Partition -> ShowS)
-> (Partition -> String)
-> ([Partition] -> ShowS)
-> Show Partition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Partition] -> ShowS
$cshowList :: [Partition] -> ShowS
show :: Partition -> String
$cshow :: Partition -> String
showsPrec :: Int -> Partition -> ShowS
$cshowsPrec :: Int -> Partition -> ShowS
Show,ReadPrec [Partition]
ReadPrec Partition
Int -> ReadS Partition
ReadS [Partition]
(Int -> ReadS Partition)
-> ReadS [Partition]
-> ReadPrec Partition
-> ReadPrec [Partition]
-> Read Partition
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Partition]
$creadListPrec :: ReadPrec [Partition]
readPrec :: ReadPrec Partition
$creadPrec :: ReadPrec Partition
readList :: ReadS [Partition]
$creadList :: ReadS [Partition]
readsPrec :: Int -> ReadS Partition
$creadsPrec :: Int -> ReadS Partition
Read)

instance HasNumberOfParts Partition where
  numberOfParts :: Partition -> Int
numberOfParts (Partition [Int]
p) = [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
p

---------------------------------------------------------------------------------
  
-- | Sorts the input, and cuts the nonpositive elements.
mkPartition :: [Int] -> Partition
mkPartition :: [Int] -> Partition
mkPartition [Int]
xs = [Int] -> Partition
Partition ([Int] -> Partition) -> [Int] -> Partition
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Ordering) -> [Int] -> [Int]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
reverseCompare) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0) [Int]
xs

-- | Assumes that the input is decreasing.
toPartitionUnsafe :: [Int] -> Partition
toPartitionUnsafe :: [Int] -> Partition
toPartitionUnsafe = [Int] -> Partition
Partition

-- | Checks whether the input is an integer partition. See the note at 'isPartition'!
toPartition :: [Int] -> Partition
toPartition :: [Int] -> Partition
toPartition [Int]
xs = if [Int] -> Bool
isPartition [Int]
xs
  then [Int] -> Partition
toPartitionUnsafe [Int]
xs
  else String -> Partition
forall a. HasCallStack => String -> a
error String
"toPartition: not a partition"
  
-- | This returns @True@ if the input is non-increasing sequence of 
-- /positive/ integers (possibly empty); @False@ otherwise.
--
isPartition :: [Int] -> Bool
isPartition :: [Int] -> Bool
isPartition []  = Bool
True
isPartition [Int
x] = Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
isPartition (Int
x:xs :: [Int]
xs@(Int
y:[Int]
_)) = (Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
y) Bool -> Bool -> Bool
&& [Int] -> Bool
isPartition [Int]
xs

isEmptyPartition :: Partition -> Bool
isEmptyPartition :: Partition -> Bool
isEmptyPartition (Partition [Int]
p) = [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
p

emptyPartition :: Partition
emptyPartition :: Partition
emptyPartition = [Int] -> Partition
Partition []

instance CanBeEmpty Partition where
  empty :: Partition
empty   = Partition
emptyPartition
  isEmpty :: Partition -> Bool
isEmpty = Partition -> Bool
isEmptyPartition

fromPartition :: Partition -> [Int]
fromPartition :: Partition -> [Int]
fromPartition (Partition [Int]
part) = [Int]
part

-- | The first element of the sequence.
partitionHeight :: Partition -> Int
partitionHeight :: Partition -> Int
partitionHeight (Partition [Int]
part) = case [Int]
part of
  (Int
p:[Int]
_) -> Int
p
  []    -> Int
0
  
-- | The length of the sequence (that is, the number of parts).
partitionWidth :: Partition -> Int
partitionWidth :: Partition -> Int
partitionWidth (Partition [Int]
part) = [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
part

instance HasHeight Partition where
  height :: Partition -> Int
height = Partition -> Int
partitionHeight
 
instance HasWidth Partition where
  width :: Partition -> Int
width = Partition -> Int
partitionWidth

heightWidth :: Partition -> (Int,Int)
heightWidth :: Partition -> (Int, Int)
heightWidth Partition
part = (Partition -> Int
forall a. HasHeight a => a -> Int
height Partition
part, Partition -> Int
forall a. HasWidth a => a -> Int
width Partition
part)

-- | The weight of the partition 
--   (that is, the sum of the corresponding sequence).
partitionWeight :: Partition -> Int
partitionWeight :: Partition -> Int
partitionWeight (Partition [Int]
part) = [Int] -> Int
forall a. Num a => [a] -> a
sum' [Int]
part

instance HasWeight Partition where 
  weight :: Partition -> Int
weight = Partition -> Int
partitionWeight

-- | The dual (or conjugate) partition.
dualPartition :: Partition -> Partition
dualPartition :: Partition -> Partition
dualPartition (Partition [Int]
part) = [Int] -> Partition
Partition ([Int] -> [Int]
_dualPartition [Int]
part)

instance HasDuality Partition where 
  dual :: Partition -> Partition
dual = Partition -> Partition
dualPartition

data Pair = Pair !Int !Int

_dualPartition :: [Int] -> [Int]
_dualPartition :: [Int] -> [Int]
_dualPartition [] = []
_dualPartition [Int]
xs = Int -> [Int] -> [Int] -> [Int]
forall t. Num t => t -> [Int] -> [Int] -> [t]
go Int
0 ([Int] -> [Int]
diffSequence [Int]
xs) [] where
  go :: t -> [Int] -> [Int] -> [t]
go !t
i (Int
d:[Int]
ds) [Int]
acc = t -> [Int] -> [Int] -> [t]
go (t
it -> t -> t
forall a. Num a => a -> a -> a
+t
1) [Int]
ds (Int
dInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
acc)
  go t
n  []     [Int]
acc = t -> [Int] -> [t]
forall t. Num t => t -> [Int] -> [t]
finish t
n [Int]
acc 
  finish :: t -> [Int] -> [t]
finish !t
j (Int
k:[Int]
ks) = Int -> t -> [t]
forall a. Int -> a -> [a]
replicate Int
k t
j [t] -> [t] -> [t]
forall a. [a] -> [a] -> [a]
++ t -> [Int] -> [t]
finish (t
jt -> t -> t
forall a. Num a => a -> a -> a
-t
1) [Int]
ks
  finish t
_  []     = []

{-
-- more variations:

_dualPartition_b :: [Int] -> [Int]
_dualPartition_b [] = []
_dualPartition_b xs = go 1 (diffSequence xs) [] where
  go !i (d:ds) acc = go (i+1) ds ((d,i):acc)
  go _  []     acc = concatMap (\(d,i) -> replicate d i) acc

_dualPartition_c :: [Int] -> [Int]
_dualPartition_c [] = []
_dualPartition_c xs = reverse $ concat $ zipWith f [1..] (diffSequence xs) where
  f _ 0 = []
  f k d = replicate d k
-}

-- | A simpler, but bit slower (about twice?) implementation of dual partition
_dualPartitionNaive :: [Int] -> [Int]
_dualPartitionNaive :: [Int] -> [Int]
_dualPartitionNaive [] = []
_dualPartitionNaive xs :: [Int]
xs@(Int
k:[Int]
_) = [ [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
i) [Int]
xs | Int
i <- [Int
1..Int
k] ]

-- | From a sequence @[a1,a2,..,an]@ computes the sequence of differences
-- @[a1-a2,a2-a3,...,an-0]@
diffSequence :: [Int] -> [Int]
diffSequence :: [Int] -> [Int]
diffSequence = [Int] -> [Int]
forall a. Num a => [a] -> [a]
go where
  go :: [a] -> [a]
go (a
x:ys :: [a]
ys@(a
y:[a]
_)) = (a
xa -> a -> a
forall a. Num a => a -> a -> a
-a
y) a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
go [a]
ys 
  go [a
x] = [a
x]
  go []  = []

-- | Example:
--
-- > elements (toPartition [5,4,1]) ==
-- >   [ (1,1), (1,2), (1,3), (1,4), (1,5)
-- >   , (2,1), (2,2), (2,3), (2,4)
-- >   , (3,1)
-- >   ]
--
elements :: Partition -> [(Int,Int)]
elements :: Partition -> [(Int, Int)]
elements (Partition [Int]
part) = [Int] -> [(Int, Int)]
_elements [Int]
part

_elements :: [Int] -> [(Int,Int)]
_elements :: [Int] -> [(Int, Int)]
_elements [Int]
shape = [ (Int
i,Int
j) | (Int
i,Int
l) <- [Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [Int]
shape, Int
j<-[Int
1..Int
l] ] 

---------------------------------------------------------------------------------
-- * Exponential form

-- | We convert a partition to exponential form.
-- @(i,e)@ mean @(i^e)@; for example @[(1,4),(2,3)]@ corresponds to @(1^4)(2^3) = [2,2,2,1,1,1,1]@. Another example:
--
-- > toExponentialForm (Partition [5,5,3,2,2,2,2,1,1]) == [(1,2),(2,4),(3,1),(5,2)]
--
toExponentialForm :: Partition -> [(Int,Int)]
toExponentialForm :: Partition -> [(Int, Int)]
toExponentialForm = [Int] -> [(Int, Int)]
_toExponentialForm ([Int] -> [(Int, Int)])
-> (Partition -> [Int]) -> Partition -> [(Int, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Partition -> [Int]
fromPartition

_toExponentialForm :: [Int] -> [(Int,Int)]
_toExponentialForm :: [Int] -> [(Int, Int)]
_toExponentialForm = [(Int, Int)] -> [(Int, Int)]
forall a. [a] -> [a]
reverse ([(Int, Int)] -> [(Int, Int)])
-> ([Int] -> [(Int, Int)]) -> [Int] -> [(Int, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Int] -> (Int, Int)) -> [[Int]] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (\[Int]
xs -> ([Int] -> Int
forall a. [a] -> a
head [Int]
xs,[Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
xs)) ([[Int]] -> [(Int, Int)])
-> ([Int] -> [[Int]]) -> [Int] -> [(Int, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [[Int]]
forall a. Eq a => [a] -> [[a]]
group

fromExponentialFrom :: [(Int,Int)] -> Partition
fromExponentialFrom :: [(Int, Int)] -> Partition
fromExponentialFrom = [Int] -> Partition
Partition ([Int] -> Partition)
-> ([(Int, Int)] -> [Int]) -> [(Int, Int)] -> Partition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Ordering) -> [Int] -> [Int]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
reverseCompare ([Int] -> [Int])
-> ([(Int, Int)] -> [Int]) -> [(Int, Int)] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, Int)] -> [Int]
forall a. [(a, Int)] -> [a]
go where
  go :: [(a, Int)] -> [a]
go ((a
j,Int
e):[(a, Int)]
rest) = Int -> a -> [a]
forall a. Int -> a -> [a]
replicate Int
e a
j [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [(a, Int)] -> [a]
go [(a, Int)]
rest
  go []           = []   

---------------------------------------------------------------------------------
-- * Automorphisms 

-- | Computes the number of \"automorphisms\" of a given integer partition.
countAutomorphisms :: Partition -> Integer  
countAutomorphisms :: Partition -> Integer
countAutomorphisms = [Int] -> Integer
_countAutomorphisms ([Int] -> Integer) -> (Partition -> [Int]) -> Partition -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Partition -> [Int]
fromPartition

_countAutomorphisms :: [Int] -> Integer
_countAutomorphisms :: [Int] -> Integer
_countAutomorphisms = [Int] -> Integer
forall a. Integral a => [a] -> Integer
multinomial ([Int] -> Integer) -> ([Int] -> [Int]) -> [Int] -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Int] -> Int) -> [[Int]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[Int]] -> [Int]) -> ([Int] -> [[Int]]) -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [[Int]]
forall a. Eq a => [a] -> [[a]]
group

---------------------------------------------------------------------------------
-- * Generating partitions

-- | Partitions of @d@.
partitions :: Int -> [Partition]
partitions :: Int -> [Partition]
partitions = ([Int] -> Partition) -> [[Int]] -> [Partition]
forall a b. (a -> b) -> [a] -> [b]
map [Int] -> Partition
Partition ([[Int]] -> [Partition]) -> (Int -> [[Int]]) -> Int -> [Partition]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [[Int]]
_partitions

-- | Partitions of @d@, as lists
_partitions :: Int -> [[Int]]
_partitions :: Int -> [[Int]]
_partitions Int
d = Int -> Int -> [[Int]]
forall a. (Num a, Ord a, Enum a) => a -> a -> [[a]]
go Int
d Int
d where
  go :: a -> a -> [[a]]
go a
_  a
0  = [[]]
  go !a
h !a
n = [ a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
as | a
a<-[a
1..a -> a -> a
forall a. Ord a => a -> a -> a
min a
n a
h], [a]
as <- a -> a -> [[a]]
go a
a (a
na -> a -> a
forall a. Num a => a -> a -> a
-a
a) ]

-- | Number of partitions of @n@
countPartitions :: Int -> Integer
countPartitions :: Int -> Integer
countPartitions Int
n = [Integer]
partitionCountList [Integer] -> Int -> Integer
forall a. [a] -> Int -> a
!! Int
n

-- | This uses 'countPartitions'', and thus is slow
countPartitionsNaive :: Int -> Integer
countPartitionsNaive :: Int -> Integer
countPartitionsNaive Int
d = (Int, Int) -> Int -> Integer
countPartitions' (Int
d,Int
d) Int
d

--------------------------------------------------------------------------------

-- | Infinite list of number of partitions of @0,1,2,...@
--
-- This uses the infinite product formula the generating function of partitions, recursively
-- expanding it; it is quite fast.
--
-- > partitionCountList == map countPartitions [0..]
--
partitionCountList :: [Integer]
partitionCountList :: [Integer]
partitionCountList = [Integer]
final where

  final :: [Integer]
final = Int -> [Integer] -> [Integer]
go Int
1 (Integer
1Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
:Integer -> [Integer]
forall a. a -> [a]
repeat Integer
0) 

  go :: Int -> [Integer] -> [Integer]
go !Int
k (Integer
x:[Integer]
xs) = Integer
x Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: Int -> [Integer] -> [Integer]
go (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [Integer]
ys where
    ys :: [Integer]
ys = (Integer -> Integer -> Integer)
-> [Integer] -> [Integer] -> [Integer]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+) [Integer]
xs (Int -> [Integer] -> [Integer]
forall a. Int -> [a] -> [a]
take Int
k [Integer]
final [Integer] -> [Integer] -> [Integer]
forall a. [a] -> [a] -> [a]
++ [Integer]
ys)
    -- explanation:
    --   xs == drop k $ f (k-1)
    --   ys == drop k $ f (k  )  

{-

Full explanation of 'partitionCountList':
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

let f k = productPSeries $ map (:[]) [1..k]

f 0 = [1,0,0,0,0,0,0,0...]
f 1 = [1,1,1,1,1,1,1,1...]
f 2 = [1,1,2,2,3,3,4,4...]
f 3 = [1,1,2,3,4,5,7,8...]

observe: 

* take (k+1) (f k) == take (k+1) partitionCountList
* f (k+1) == zipWith (+) (f k) (replicate (k+1) 0 ++ f (k+1))

now apply (drop (k+1)) to the second one : 

* drop (k+1) (f (k+1)) == zipWith (+) (drop (k+1) $ f k) (f (k+1))
* f (k+1) = take (k+1) final ++ drop (k+1) (f (k+1))

-}

--------------------------------------------------------------------------------

-- | Naive infinite list of number of partitions of @0,1,2,...@
--
-- > partitionCountListNaive == map countPartitionsNaive [0..]
--
-- This is much slower than the power series expansion above.
--
partitionCountListNaive :: [Integer]
partitionCountListNaive :: [Integer]
partitionCountListNaive = (Int -> Integer) -> [Int] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Integer
countPartitionsNaive [Int
0..]

-- | All integer partitions up to a given degree (that is, all integer partitions whose sum is less or equal to @d@)
allPartitions :: Int -> [Partition]
allPartitions :: Int -> [Partition]
allPartitions Int
d = [[Partition]] -> [Partition]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ Int -> [Partition]
partitions Int
i | Int
i <- [Int
0..Int
d] ]

-- | All integer partitions up to a given degree (that is, all integer partitions whose sum is less or equal to @d@),
-- grouped by weight
allPartitionsGrouped :: Int -> [[Partition]]
allPartitionsGrouped :: Int -> [[Partition]]
allPartitionsGrouped Int
d = [ Int -> [Partition]
partitions Int
i | Int
i <- [Int
0..Int
d] ]

-- | All integer partitions fitting into a given rectangle.
allPartitions'  
  :: (Int,Int)        -- ^ (height,width)
  -> [Partition]
allPartitions' :: (Int, Int) -> [Partition]
allPartitions' (Int
h,Int
w) = [[Partition]] -> [Partition]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ (Int, Int) -> Int -> [Partition]
partitions' (Int
h,Int
w) Int
i | Int
i <- [Int
0..Int
d] ] where d :: Int
d = Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
w

-- | All integer partitions fitting into a given rectangle, grouped by weight.
allPartitionsGrouped'  
  :: (Int,Int)        -- ^ (height,width)
  -> [[Partition]]
allPartitionsGrouped' :: (Int, Int) -> [[Partition]]
allPartitionsGrouped' (Int
h,Int
w) = [ (Int, Int) -> Int -> [Partition]
partitions' (Int
h,Int
w) Int
i | Int
i <- [Int
0..Int
d] ] where d :: Int
d = Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
w

-- | # = \\binom { h+w } { h }
countAllPartitions' :: (Int,Int) -> Integer
countAllPartitions' :: (Int, Int) -> Integer
countAllPartitions' (Int
h,Int
w) = 
  Int -> Int -> Integer
forall a. Integral a => a -> a -> Integer
binomial (Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w) (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
h Int
w)
  --sum [ countPartitions' (h,w) i | i <- [0..d] ] where d = h*w

countAllPartitions :: Int -> Integer
countAllPartitions :: Int -> Integer
countAllPartitions Int
d = [Integer] -> Integer
forall a. Num a => [a] -> a
sum' [ Int -> Integer
countPartitions Int
i | Int
i <- [Int
0..Int
d] ]

-- | Integer partitions of @d@, fitting into a given rectangle, as lists.
_partitions' 
  :: (Int,Int)     -- ^ (height,width)
  -> Int           -- ^ d
  -> [[Int]]        
_partitions' :: (Int, Int) -> Int -> [[Int]]
_partitions' (Int, Int)
_ Int
0 = [[]] 
_partitions' ( Int
0 , Int
_) Int
d = if Int
dInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0 then [[]] else []
_partitions' ( Int
_ , Int
0) Int
d = if Int
dInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0 then [[]] else []
_partitions' (!Int
h ,!Int
w) Int
d = 
  [ Int
iInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
xs | Int
i <- [Int
1..Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
d Int
h] , [Int]
xs <- (Int, Int) -> Int -> [[Int]]
_partitions' (Int
i,Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i) ]

-- | Partitions of d, fitting into a given rectangle. The order is again lexicographic.
partitions'  
  :: (Int,Int)     -- ^ (height,width)
  -> Int           -- ^ d
  -> [Partition]
partitions' :: (Int, Int) -> Int -> [Partition]
partitions' (Int, Int)
hw Int
d = ([Int] -> Partition) -> [[Int]] -> [Partition]
forall a b. (a -> b) -> [a] -> [b]
map [Int] -> Partition
toPartitionUnsafe ([[Int]] -> [Partition]) -> [[Int]] -> [Partition]
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> Int -> [[Int]]
_partitions' (Int, Int)
hw Int
d        

countPartitions' :: (Int,Int) -> Int -> Integer
countPartitions' :: (Int, Int) -> Int -> Integer
countPartitions' (Int, Int)
_ Int
0 = Integer
1
countPartitions' (Int
0,Int
_) Int
d = if Int
dInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0 then Integer
1 else Integer
0
countPartitions' (Int
_,Int
0) Int
d = if Int
dInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0 then Integer
1 else Integer
0
countPartitions' (Int
h,Int
w) Int
d = [Integer] -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum
  [ (Int, Int) -> Int -> Integer
countPartitions' (Int
i,Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i) | Int
i <- [Int
1..Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
d Int
h] ] 


---------------------------------------------------------------------------------
-- * Random partitions

-- | Uniformly random partition of the given weight. 
--
-- NOTE: This algorithm is effective for small @n@-s (say @n@ up to a few hundred \/ one thousand it should work nicely),
-- and the first time it is executed may be slower (as it needs to build the table 'partitionCountList' first)
--
-- Algorithm of Nijenhuis and Wilf (1975); see
--
-- * Knuth Vol 4A, pre-fascicle 3B, exercise 47;
--
-- * Nijenhuis and Wilf: Combinatorial Algorithms for Computers and Calculators, chapter 10
--
randomPartition :: RandomGen g => Int -> g -> (Partition, g)
randomPartition :: Int -> g -> (Partition, g)
randomPartition Int
n g
g = (Partition
p, g
g') where
  ([Partition
p], g
g') = Int -> Int -> g -> ([Partition], g)
forall g. RandomGen g => Int -> Int -> g -> ([Partition], g)
randomPartitions Int
1 Int
n g
g

-- | Generates several uniformly random partitions of @n@ at the same time.
-- Should be a little bit faster then generating them individually.
--
randomPartitions 
  :: forall g. RandomGen g 
  => Int   -- ^ number of partitions to generate
  -> Int   -- ^ the weight of the partitions
  -> g -> ([Partition], g)
randomPartitions :: Int -> Int -> g -> ([Partition], g)
randomPartitions Int
howmany Int
n = Rand g [Partition] -> g -> ([Partition], g)
forall g a. Rand g a -> g -> (a, g)
runRand (Rand g [Partition] -> g -> ([Partition], g))
-> Rand g [Partition] -> g -> ([Partition], g)
forall a b. (a -> b) -> a -> b
$ Int -> RandT g Identity Partition -> Rand g [Partition]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
howmany (Int -> [(Int, Int)] -> RandT g Identity Partition
worker Int
n []) where

  table :: Array Int Integer
table = (Int, Int) -> [Integer] -> Array Int Integer
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
n) ([Integer] -> Array Int Integer) -> [Integer] -> Array Int Integer
forall a b. (a -> b) -> a -> b
$ Int -> [Integer] -> [Integer]
forall a. Int -> [a] -> [a]
take (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [Integer]
partitionCountList :: Array Int Integer
  cnt :: Int -> Integer
cnt Int
k = Array Int Integer
table Array Int Integer -> Int -> Integer
forall i e. Ix i => Array i e -> i -> e
! Int
k
 
  finish :: [(Int,Int)] -> Partition
  finish :: [(Int, Int)] -> Partition
finish = [Int] -> Partition
mkPartition ([Int] -> Partition)
-> ([(Int, Int)] -> [Int]) -> [(Int, Int)] -> Partition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int) -> [Int]) -> [(Int, Int)] -> [Int]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int, Int) -> [Int]
forall a. (Int, a) -> [a]
f where f :: (Int, a) -> [a]
f (Int
j,a
d) = Int -> a -> [a]
forall a. Int -> a -> [a]
replicate Int
j a
d

  fi :: Int -> Integer 
  fi :: Int -> Integer
fi = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral

  find_jd :: Int -> Integer -> (Int,Int)
  find_jd :: Int -> Integer -> (Int, Int)
find_jd Int
m Integer
capm = Integer -> [(Int, Int)] -> (Int, Int)
go Integer
0 [ (Int
j,Int
d) | Int
j<-[Int
1..Int
n], Int
d<-[Int
1..Int -> Int -> Int
forall a. Integral a => a -> a -> a
div Int
m Int
j] ] where
    go :: Integer -> [(Int,Int)] -> (Int,Int)
    go :: Integer -> [(Int, Int)] -> (Int, Int)
go !Integer
s []   = (Int
1,Int
1)       -- ??
    go !Integer
s [(Int, Int)
jd] = (Int, Int)
jd          -- ??
    go !Integer
s (jd :: (Int, Int)
jd@(Int
j,Int
d):[(Int, Int)]
rest) = 
      if Integer
s' Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
capm 
        then (Int, Int)
jd 
        else Integer -> [(Int, Int)] -> (Int, Int)
go Integer
s' [(Int, Int)]
rest
      where
        s' :: Integer
s' = Integer
s Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
fi Int
d Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Int -> Integer
cnt (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
d)

  worker :: Int -> [(Int,Int)] -> Rand g Partition
  worker :: Int -> [(Int, Int)] -> RandT g Identity Partition
worker  Int
0 [(Int, Int)]
acc = Partition -> RandT g Identity Partition
forall (m :: * -> *) a. Monad m => a -> m a
return (Partition -> RandT g Identity Partition)
-> Partition -> RandT g Identity Partition
forall a b. (a -> b) -> a -> b
$ [(Int, Int)] -> Partition
finish [(Int, Int)]
acc
  worker !Int
m [(Int, Int)]
acc = do
    Integer
capm <- (Integer, Integer) -> Rand g Integer
forall g a. (RandomGen g, Random a) => (a, a) -> Rand g a
randChoose (Integer
0, (Int -> Integer
fi Int
m) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Int -> Integer
cnt Int
m Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)
    let jd :: (Int, Int)
jd@(!Int
j,!Int
d) = Int -> Integer -> (Int, Int)
find_jd Int
m Integer
capm
    Int -> [(Int, Int)] -> RandT g Identity Partition
worker (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
d) ((Int, Int)
jd(Int, Int) -> [(Int, Int)] -> [(Int, Int)]
forall a. a -> [a] -> [a]
:[(Int, Int)]
acc)


---------------------------------------------------------------------------------
-- * Dominance order 

-- | @q \`dominates\` p@ returns @True@ if @q >= p@ in the dominance order of partitions
-- (this is partial ordering on the set of partitions of @n@).
--
-- See <http://en.wikipedia.org/wiki/Dominance_order>
--
dominates :: Partition -> Partition -> Bool
dominates :: Partition -> Partition -> Bool
dominates (Partition [Int]
qs) (Partition [Int]
ps) 
  = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Bool) -> [Int] -> [Int] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(>=) ([Int] -> [Int]
sums ([Int]
qs [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Int -> [Int]
forall a. a -> [a]
repeat Int
0)) ([Int] -> [Int]
sums [Int]
ps)
  where
    sums :: [Int] -> [Int]
sums = (Int -> Int -> Int) -> Int -> [Int] -> [Int]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
0


-- | Lists all partitions of the same weight as @lambda@ and also dominated by @lambda@
-- (that is, all partial sums are less or equal):
--
-- > dominatedPartitions lam == [ mu | mu <- partitions (weight lam), lam `dominates` mu ]
-- 
dominatedPartitions :: Partition -> [Partition]    
dominatedPartitions :: Partition -> [Partition]
dominatedPartitions (Partition [Int]
lambda) = ([Int] -> Partition) -> [[Int]] -> [Partition]
forall a b. (a -> b) -> [a] -> [b]
map [Int] -> Partition
Partition ([Int] -> [[Int]]
_dominatedPartitions [Int]
lambda)

_dominatedPartitions :: [Int] -> [[Int]]
_dominatedPartitions :: [Int] -> [[Int]]
_dominatedPartitions []     = [[]]
_dominatedPartitions [Int]
lambda = Int -> Int -> [Int] -> Int -> [[Int]]
forall a. (Num a, Ord a, Enum a) => a -> a -> [a] -> a -> [[a]]
go ([Int] -> Int
forall a. [a] -> a
head [Int]
lambda) Int
w [Int]
dsums Int
0 where

  n :: Int
n = [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
lambda
  w :: Int
w = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum    [Int]
lambda
  dsums :: [Int]
dsums = (Int -> Int -> Int) -> [Int] -> [Int]
forall a. (a -> a -> a) -> [a] -> [a]
scanl1 Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) ([Int]
lambda [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Int -> [Int]
forall a. a -> [a]
repeat Int
0)

  go :: a -> a -> [a] -> a -> [[a]]
go a
_   a
0 [a]
_       a
_  = [[]]
  go !a
h !a
w (!a
d:[a]
ds) !a
e  
    | a
w a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>  a
0  = [ (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
as) | a
a <- [a
1..a -> a -> a
forall a. Ord a => a -> a -> a
min a
h (a
da -> a -> a
forall a. Num a => a -> a -> a
-a
e)] , [a]
as <- a -> a -> [a] -> a -> [[a]]
go a
a (a
wa -> a -> a
forall a. Num a => a -> a -> a
-a
a) [a]
ds (a
ea -> a -> a
forall a. Num a => a -> a -> a
+a
a) ] 
    | a
w a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0  = [[]]
    | a
w a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<  a
0  = String -> [[a]]
forall a. HasCallStack => String -> a
error String
"_dominatedPartitions: fatal error; shouldn't happen"

-- | Lists all partitions of the sime weight as @mu@ and also dominating @mu@
-- (that is, all partial sums are greater or equal):
--
-- > dominatingPartitions mu == [ lam | lam <- partitions (weight mu), lam `dominates` mu ]
-- 
dominatingPartitions :: Partition -> [Partition]    
dominatingPartitions :: Partition -> [Partition]
dominatingPartitions (Partition [Int]
mu) = ([Int] -> Partition) -> [[Int]] -> [Partition]
forall a b. (a -> b) -> [a] -> [b]
map [Int] -> Partition
Partition ([Int] -> [[Int]]
_dominatingPartitions [Int]
mu)

_dominatingPartitions :: [Int] -> [[Int]]
_dominatingPartitions :: [Int] -> [[Int]]
_dominatingPartitions []     = [[]]
_dominatingPartitions [Int]
mu     = Int -> Int -> [Int] -> Int -> [[Int]]
forall a. (Num a, Ord a, Enum a) => a -> a -> [a] -> a -> [[a]]
go Int
w Int
w [Int]
dsums Int
0 where

  n :: Int
n = [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
mu
  w :: Int
w = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum    [Int]
mu
  dsums :: [Int]
dsums = (Int -> Int -> Int) -> [Int] -> [Int]
forall a. (a -> a -> a) -> [a] -> [a]
scanl1 Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) ([Int]
mu [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Int -> [Int]
forall a. a -> [a]
repeat Int
0)

  go :: a -> a -> [a] -> a -> [[a]]
go a
_   a
0 [a]
_       a
_  = [[]]
  go !a
h !a
w (!a
d:[a]
ds) !a
e  
    | a
w a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>  a
0  = [ (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
as) | a
a <- [a -> a -> a
forall a. Ord a => a -> a -> a
max a
0 (a
da -> a -> a
forall a. Num a => a -> a -> a
-a
e)..a -> a -> a
forall a. Ord a => a -> a -> a
min a
h a
w] , [a]
as <- a -> a -> [a] -> a -> [[a]]
go a
a (a
wa -> a -> a
forall a. Num a => a -> a -> a
-a
a) [a]
ds (a
ea -> a -> a
forall a. Num a => a -> a -> a
+a
a) ] 
    | a
w a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0  = [[]]
    | a
w a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<  a
0  = String -> [[a]]
forall a. HasCallStack => String -> a
error String
"_dominatingPartitions: fatal error; shouldn't happen"

--------------------------------------------------------------------------------
-- * Partitions with given number of parts

-- | Lists partitions of @n@ into @k@ parts.
--
-- > sort (partitionsWithKParts k n) == sort [ p | p <- partitions n , numberOfParts p == k ]
--
-- Naive recursive algorithm.
--
partitionsWithKParts 
  :: Int    -- ^ @k@ = number of parts
  -> Int    -- ^ @n@ = the integer we partition
  -> [Partition]
partitionsWithKParts :: Int -> Int -> [Partition]
partitionsWithKParts Int
k Int
n = ([Int] -> Partition) -> [[Int]] -> [Partition]
forall a b. (a -> b) -> [a] -> [b]
map [Int] -> Partition
Partition ([[Int]] -> [Partition]) -> [[Int]] -> [Partition]
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> [[Int]]
forall a. (Ord a, Num a, Enum a) => a -> a -> a -> [[a]]
go Int
n Int
k Int
n where
{-
  h = max height
  k = number of parts
  n = integer
-}
  go :: a -> a -> a -> [[a]]
go !a
h !a
k !a
n 
    | a
k a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<  a
0     = []
    | a
k a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0     = if a
ha -> a -> Bool
forall a. Ord a => a -> a -> Bool
>=a
0 Bool -> Bool -> Bool
&& a
na -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
0 then [[] ] else []
    | a
k a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
1     = if a
ha -> a -> Bool
forall a. Ord a => a -> a -> Bool
>=a
n Bool -> Bool -> Bool
&& a
na -> a -> Bool
forall a. Ord a => a -> a -> Bool
>=a
1 then [[a
n]] else []
    | Bool
otherwise  = [ a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
p | a
a <- [a
1..(a -> a -> a
forall a. Ord a => a -> a -> a
min a
h (a
na -> a -> a
forall a. Num a => a -> a -> a
-a
ka -> a -> a
forall a. Num a => a -> a -> a
+a
1))] , [a]
p <- a -> a -> a -> [[a]]
go a
a (a
ka -> a -> a
forall a. Num a => a -> a -> a
-a
1) (a
na -> a -> a
forall a. Num a => a -> a -> a
-a
a) ]

countPartitionsWithKParts 
  :: Int    -- ^ @k@ = number of parts
  -> Int    -- ^ @n@ = the integer we partition
  -> Integer
countPartitionsWithKParts :: Int -> Int -> Integer
countPartitionsWithKParts Int
k Int
n = Int -> Int -> Int -> Integer
forall t p. (Ord t, Num t, Num p, Enum t) => t -> t -> t -> p
go Int
n Int
k Int
n where
  go :: t -> t -> t -> p
go !t
h !t
k !t
n 
    | t
k t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<  t
0     = p
0
    | t
k t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0     = if t
ht -> t -> Bool
forall a. Ord a => a -> a -> Bool
>=t
0 Bool -> Bool -> Bool
&& t
nt -> t -> Bool
forall a. Eq a => a -> a -> Bool
==t
0 then p
1 else p
0
    | t
k t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
1     = if t
ht -> t -> Bool
forall a. Ord a => a -> a -> Bool
>=t
n Bool -> Bool -> Bool
&& t
nt -> t -> Bool
forall a. Ord a => a -> a -> Bool
>=t
1 then p
1 else p
0
    | Bool
otherwise  = [p] -> p
forall a. Num a => [a] -> a
sum' [ t -> t -> t -> p
go t
a (t
kt -> t -> t
forall a. Num a => a -> a -> a
-t
1) (t
nt -> t -> t
forall a. Num a => a -> a -> a
-t
a) | t
a<-[t
1..(t -> t -> t
forall a. Ord a => a -> a -> a
min t
h (t
nt -> t -> t
forall a. Num a => a -> a -> a
-t
kt -> t -> t
forall a. Num a => a -> a -> a
+t
1))] ]

--------------------------------------------------------------------------------
-- * Partitions with only odd\/distinct parts

-- | Partitions of @n@ with only odd parts
partitionsWithOddParts :: Int -> [Partition]
partitionsWithOddParts :: Int -> [Partition]
partitionsWithOddParts Int
d = ([Int] -> Partition) -> [[Int]] -> [Partition]
forall a b. (a -> b) -> [a] -> [b]
map [Int] -> Partition
Partition (Int -> Int -> [[Int]]
forall a. (Num a, Ord a, Enum a) => a -> a -> [[a]]
go Int
d Int
d) where
  go :: a -> a -> [[a]]
go a
_  a
0  = [[]]
  go !a
h !a
n = [ a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
as | a
a<-[a
1,a
3..a -> a -> a
forall a. Ord a => a -> a -> a
min a
n a
h], [a]
as <- a -> a -> [[a]]
go a
a (a
na -> a -> a
forall a. Num a => a -> a -> a
-a
a) ]

{-
-- | Partitions of @n@ with only even parts
--
-- Note: this is not very interesting, it's just @(map.map) (2*) $ _partitions (div n 2)@
--
partitionsWithEvenParts :: Int -> [Partition]
partitionsWithEvenParts d = map Partition (go d d) where
  go _  0  = [[]]
  go !h !n = [ a:as | a<-[2,4..min n h], as <- go a (n-a) ]
-}

-- | Partitions of @n@ with distinct parts.
-- 
-- Note:
--
-- > length (partitionsWithDistinctParts d) == length (partitionsWithOddParts d)
--
partitionsWithDistinctParts :: Int -> [Partition]
partitionsWithDistinctParts :: Int -> [Partition]
partitionsWithDistinctParts Int
d = ([Int] -> Partition) -> [[Int]] -> [Partition]
forall a b. (a -> b) -> [a] -> [b]
map [Int] -> Partition
Partition (Int -> Int -> [[Int]]
forall a. (Num a, Ord a, Enum a) => a -> a -> [[a]]
go Int
d Int
d) where
  go :: a -> a -> [[a]]
go a
_  a
0  = [[]]
  go !a
h !a
n = [ a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
as | a
a<-[a
1..a -> a -> a
forall a. Ord a => a -> a -> a
min a
n a
h], [a]
as <- a -> a -> [[a]]
go (a
aa -> a -> a
forall a. Num a => a -> a -> a
-a
1) (a
na -> a -> a
forall a. Num a => a -> a -> a
-a
a) ]

--------------------------------------------------------------------------------
-- * Sub- and super-partitions of a given partition

-- | Returns @True@ of the first partition is a subpartition (that is, fit inside) of the second.
-- This includes equality
isSubPartitionOf :: Partition -> Partition -> Bool
isSubPartitionOf :: Partition -> Partition -> Bool
isSubPartitionOf (Partition [Int]
ps) (Partition [Int]
qs) = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Bool) -> [Int] -> [Int] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(<=) [Int]
ps ([Int]
qs [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Int -> [Int]
forall a. a -> [a]
repeat Int
0)

-- | This is provided for convenience\/completeness only, as:
--
-- > isSuperPartitionOf q p == isSubPartitionOf p q
--
isSuperPartitionOf :: Partition -> Partition -> Bool
isSuperPartitionOf :: Partition -> Partition -> Bool
isSuperPartitionOf (Partition [Int]
qs) (Partition [Int]
ps) = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Bool) -> [Int] -> [Int] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(<=) [Int]
ps ([Int]
qs [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Int -> [Int]
forall a. a -> [a]
repeat Int
0)


-- | Sub-partitions of a given partition with the given weight:
--
-- > sort (subPartitions d q) == sort [ p | p <- partitions d, isSubPartitionOf p q ]
--
subPartitions :: Int -> Partition -> [Partition]
subPartitions :: Int -> Partition -> [Partition]
subPartitions Int
d (Partition [Int]
ps) = ([Int] -> Partition) -> [[Int]] -> [Partition]
forall a b. (a -> b) -> [a] -> [b]
map [Int] -> Partition
Partition (Int -> [Int] -> [[Int]]
_subPartitions Int
d [Int]
ps)

_subPartitions :: Int -> [Int] -> [[Int]]
_subPartitions :: Int -> [Int] -> [[Int]]
_subPartitions Int
d [Int]
big
  | [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
big       = if Int
dInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0 then [[]] else []
  | Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> [Int] -> Int
forall a. Num a => [a] -> a
sum' [Int]
big   = []
  | Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0          = []
  | Bool
otherwise      = Int -> Int -> [Int] -> [[Int]]
go Int
d ([Int] -> Int
forall a. [a] -> a
head [Int]
big) [Int]
big
  where
    go :: Int -> Int -> [Int] -> [[Int]]
    go :: Int -> Int -> [Int] -> [[Int]]
go !Int
k !Int
h []      = if Int
kInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0 then [[]] else []
    go !Int
k !Int
h (Int
b:[Int]
bs) 
      | Int
kInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
0 Bool -> Bool -> Bool
|| Int
hInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
0   = []
      | Int
kInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0         = [[]]
      | Int
hInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0         = []
      | Bool
otherwise    = [ Int
thisInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
rest | Int
this <- [Int
1..Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
h Int
b] , [Int]
rest <- Int -> Int -> [Int] -> [[Int]]
go (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
this) Int
this [Int]
bs ]

----------------------------------------

-- | All sub-partitions of a given partition
allSubPartitions :: Partition -> [Partition]
allSubPartitions :: Partition -> [Partition]
allSubPartitions (Partition [Int]
ps) = ([Int] -> Partition) -> [[Int]] -> [Partition]
forall a b. (a -> b) -> [a] -> [b]
map [Int] -> Partition
Partition ([Int] -> [[Int]]
_allSubPartitions [Int]
ps)

_allSubPartitions :: [Int] -> [[Int]]
_allSubPartitions :: [Int] -> [[Int]]
_allSubPartitions [Int]
big 
  | [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
big   = [[]]
  | Bool
otherwise  = Int -> [Int] -> [[Int]]
forall a. (Num a, Ord a, Enum a) => a -> [a] -> [[a]]
go ([Int] -> Int
forall a. [a] -> a
head [Int]
big) [Int]
big
  where
    go :: a -> [a] -> [[a]]
go a
_  [] = [[]]
    go !a
h (a
b:[a]
bs) 
      | a
ha -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
0         = []
      | Bool
otherwise    = [] [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [ a
thisa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
rest | a
this <- [a
1..a -> a -> a
forall a. Ord a => a -> a -> a
min a
h a
b] , [a]
rest <- a -> [a] -> [[a]]
go a
this [a]
bs ]

----------------------------------------

-- | Super-partitions of a given partition with the given weight:
--
-- > sort (superPartitions d p) == sort [ q | q <- partitions d, isSubPartitionOf p q ]
--
superPartitions :: Int -> Partition -> [Partition]
superPartitions :: Int -> Partition -> [Partition]
superPartitions Int
d (Partition [Int]
ps) = ([Int] -> Partition) -> [[Int]] -> [Partition]
forall a b. (a -> b) -> [a] -> [b]
map [Int] -> Partition
Partition (Int -> [Int] -> [[Int]]
_superPartitions Int
d [Int]
ps)

_superPartitions :: Int -> [Int] -> [[Int]]
_superPartitions :: Int -> [Int] -> [[Int]]
_superPartitions Int
dd [Int]
small
  | Int
dd Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
w0     = []
  | [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
small  = Int -> [[Int]]
_partitions Int
dd
  | Bool
otherwise   = Int -> Int -> Int -> [Int] -> [[Int]]
forall a. (Ord a, Num a, Enum a) => a -> a -> a -> [a] -> [[a]]
go Int
dd Int
w1 Int
dd ([Int]
small [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Int -> [Int]
forall a. a -> [a]
repeat Int
0)
  where
    w0 :: Int
w0 = [Int] -> Int
forall a. Num a => [a] -> a
sum' [Int]
small
    w1 :: Int
w1 = Int
w0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Int] -> Int
forall a. [a] -> a
head [Int]
small
    -- d = remaining weight of the outer partition we are constructing
    -- w = remaining weight of the inner partition (we need to reserve at least this amount)
    -- h = max height (decreasing)
    go :: a -> a -> a -> [a] -> [[a]]
go !a
d !a
w !a
h (!a
a:as :: [a]
as@(a
b:[a]
_)) 
      | a
d a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0     = []
      | a
d a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0    = if a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 then [[]] else []
      | Bool
otherwise = [ a
thisa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
rest | a
this <- [a -> a -> a
forall a. Ord a => a -> a -> a
max a
1 a
a .. a -> a -> a
forall a. Ord a => a -> a -> a
min a
h (a
da -> a -> a
forall a. Num a => a -> a -> a
-a
w)] , [a]
rest <- a -> a -> a -> [a] -> [[a]]
go (a
da -> a -> a
forall a. Num a => a -> a -> a
-a
this) (a
wa -> a -> a
forall a. Num a => a -> a -> a
-a
b) a
this [a]
as ]
    
--------------------------------------------------------------------------------
-- * The Pieri rule

-- | The Pieri rule computes @s[lambda]*h[n]@ as a sum of @s[mu]@-s (each with coefficient 1).
--
-- See for example <http://en.wikipedia.org/wiki/Pieri's_formula>
--
pieriRule :: Partition -> Int -> [Partition] 
pieriRule :: Partition -> Int -> [Partition]
pieriRule (Partition [Int]
lambda) Int
n = ([Int] -> Partition) -> [[Int]] -> [Partition]
forall a b. (a -> b) -> [a] -> [b]
map [Int] -> Partition
Partition ([Int] -> Int -> [[Int]]
_pieriRule [Int]
lambda Int
n) where

  -- | We assume here that @lambda@ is a partition (non-increasing sequence of /positive/ integers)! 
  _pieriRule :: [Int] -> Int -> [[Int]] 
  _pieriRule :: [Int] -> Int -> [[Int]]
_pieriRule [Int]
lambda Int
n
    | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0     = [[Int]
lambda]
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<  Int
0     = [] 
    | Bool
otherwise  = Int -> [Int] -> [Int] -> [Int] -> [[Int]]
forall a. (Ord a, Enum a, Num a) => a -> [a] -> [a] -> [a] -> [[a]]
go Int
n [Int]
diffs [Int]
dsums ([Int]
lambda[Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++[Int
0]) 
    where
      diffs :: [Int]
diffs = Int
n Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int] -> [Int]
diffSequence [Int]
lambda                 -- maximum we can add to a given row
      dsums :: [Int]
dsums = [Int] -> [Int]
forall a. [a] -> [a]
reverse ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int) -> [Int] -> [Int]
forall a. (a -> a -> a) -> [a] -> [a]
scanl1 Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) ([Int] -> [Int]
forall a. [a] -> [a]
reverse [Int]
diffs)    -- partial sums of remaining total we can add
      go :: a -> [a] -> [a] -> [a] -> [[a]]
go !a
k (a
d:[a]
ds) (a
p:ps :: [a]
ps@(a
q:[a]
_)) (a
l:[a]
ls) 
        | a
k a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
p     = []
        | Bool
otherwise = [ a
ha -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
tl | a
a <- [ a -> a -> a
forall a. Ord a => a -> a -> a
max a
0 (a
ka -> a -> a
forall a. Num a => a -> a -> a
-a
q) .. a -> a -> a
forall a. Ord a => a -> a -> a
min a
d a
k ] , let h :: a
h = a
la -> a -> a
forall a. Num a => a -> a -> a
+a
a , [a]
tl <- a -> [a] -> [a] -> [a] -> [[a]]
go (a
ka -> a -> a
forall a. Num a => a -> a -> a
-a
a) [a]
ds [a]
ps [a]
ls ]
      go !a
k [a
d]    [a]
_      [a
l]    = if a
k a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
d 
                                     then if a
la -> a -> a
forall a. Num a => a -> a -> a
+a
ka -> a -> Bool
forall a. Ord a => a -> a -> Bool
>a
0 then [[a
la -> a -> a
forall a. Num a => a -> a -> a
+a
k]] else [[]]
                                     else []
      go !a
k []     [a]
_      [a]
_      = if a
ka -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
0 then [[]] else []

-- | The dual Pieri rule computes @s[lambda]*e[n]@ as a sum of @s[mu]@-s (each with coefficient 1)
dualPieriRule :: Partition -> Int -> [Partition] 
dualPieriRule :: Partition -> Int -> [Partition]
dualPieriRule Partition
lam Int
n = (Partition -> Partition) -> [Partition] -> [Partition]
forall a b. (a -> b) -> [a] -> [b]
map Partition -> Partition
dualPartition ([Partition] -> [Partition]) -> [Partition] -> [Partition]
forall a b. (a -> b) -> a -> b
$ Partition -> Int -> [Partition]
pieriRule (Partition -> Partition
dualPartition Partition
lam) Int
n


{- 
-- moved to "Math.Combinat.Tableaux.GelfandTsetlin"

-- | Computes the Schur expansion of @h[n1]*h[n2]*h[n3]*...*h[nk]@ via iterating the Pieri rule
iteratedPieriRule :: Num coeff => [Int] -> Map Partition coeff
iteratedPieriRule = iteratedPieriRule' (Partition [])

-- | Iterating the Pieri rule, we can compute the Schur expansion of
-- @h[lambda]*h[n1]*h[n2]*h[n3]*...*h[nk]@
iteratedPieriRule' :: Num coeff => Partition -> [Int] -> Map Partition coeff
iteratedPieriRule' plambda ns = iteratedPieriRule'' (plambda,1) ns

{-# SPECIALIZE iteratedPieriRule'' :: (Partition,Int    ) -> [Int] -> Map Partition Int     #-}
{-# SPECIALIZE iteratedPieriRule'' :: (Partition,Integer) -> [Int] -> Map Partition Integer #-}
iteratedPieriRule'' :: Num coeff => (Partition,coeff) -> [Int] -> Map Partition coeff
iteratedPieriRule'' (plambda,coeff0) ns = worker (Map.singleton plambda coeff0) ns where
  worker old []     = old
  worker old (n:ns) = worker new ns where
    stuff = [ (coeff, pieriRule lam n) | (lam,coeff) <- Map.toList old ] 
    new   = foldl' f Map.empty stuff 
    f t0 (c,ps) = foldl' (\t p -> Map.insertWith (+) p c t) t0 ps  
-}

--------------------------------------------------------------------------------
-- * ASCII Ferrers diagrams

-- | Which orientation to draw the Ferrers diagrams.
-- For example, the partition [5,4,1] corrsponds to:
--
-- In standard English notation:
-- 
-- >  @@@@@
-- >  @@@@
-- >  @
--
--
-- In English notation rotated by 90 degrees counter-clockwise:
--
-- > @  
-- > @@
-- > @@
-- > @@
-- > @@@
--
--
-- And in French notation:
--
-- 
-- >  @
-- >  @@@@
-- >  @@@@@
--
--
data PartitionConvention
  = EnglishNotation          -- ^ English notation
  | EnglishNotationCCW       -- ^ English notation rotated by 90 degrees counterclockwise
  | FrenchNotation           -- ^ French notation (mirror of English notation to the x axis)
  deriving (PartitionConvention -> PartitionConvention -> Bool
(PartitionConvention -> PartitionConvention -> Bool)
-> (PartitionConvention -> PartitionConvention -> Bool)
-> Eq PartitionConvention
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PartitionConvention -> PartitionConvention -> Bool
$c/= :: PartitionConvention -> PartitionConvention -> Bool
== :: PartitionConvention -> PartitionConvention -> Bool
$c== :: PartitionConvention -> PartitionConvention -> Bool
Eq,Int -> PartitionConvention -> ShowS
[PartitionConvention] -> ShowS
PartitionConvention -> String
(Int -> PartitionConvention -> ShowS)
-> (PartitionConvention -> String)
-> ([PartitionConvention] -> ShowS)
-> Show PartitionConvention
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PartitionConvention] -> ShowS
$cshowList :: [PartitionConvention] -> ShowS
show :: PartitionConvention -> String
$cshow :: PartitionConvention -> String
showsPrec :: Int -> PartitionConvention -> ShowS
$cshowsPrec :: Int -> PartitionConvention -> ShowS
Show)

-- | Synonym for @asciiFerrersDiagram\' EnglishNotation \'\@\'@
--
-- Try for example:
--
-- > autoTabulate RowMajor (Right 8) (map asciiFerrersDiagram $ partitions 9)
--
asciiFerrersDiagram :: Partition -> ASCII
asciiFerrersDiagram :: Partition -> ASCII
asciiFerrersDiagram = PartitionConvention -> Char -> Partition -> ASCII
asciiFerrersDiagram' PartitionConvention
EnglishNotation Char
'@'

asciiFerrersDiagram' :: PartitionConvention -> Char -> Partition -> ASCII
asciiFerrersDiagram' :: PartitionConvention -> Char -> Partition -> ASCII
asciiFerrersDiagram' PartitionConvention
conv Char
ch Partition
part = [String] -> ASCII
ASCII.asciiFromLines ((Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Int -> String
f [Int]
ys) where
  f :: Int -> String
f Int
n = Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n Char
ch 
  ys :: [Int]
ys  = case PartitionConvention
conv of
          PartitionConvention
EnglishNotation    -> Partition -> [Int]
fromPartition Partition
part
          PartitionConvention
EnglishNotationCCW -> [Int] -> [Int]
forall a. [a] -> [a]
reverse ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ Partition -> [Int]
fromPartition (Partition -> [Int]) -> Partition -> [Int]
forall a b. (a -> b) -> a -> b
$ Partition -> Partition
dualPartition Partition
part
          PartitionConvention
FrenchNotation     -> [Int] -> [Int]
forall a. [a] -> [a]
reverse ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ Partition -> [Int]
fromPartition (Partition -> [Int]) -> Partition -> [Int]
forall a b. (a -> b) -> a -> b
$ Partition
part

instance DrawASCII Partition where
  ascii :: Partition -> ASCII
ascii = Partition -> ASCII
asciiFerrersDiagram

--------------------------------------------------------------------------------