```
-- | 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
( -- module Math.Combinat.Partitions.Integer.Count
module Math.Combinat.Partitions.Integer.Naive
-- * Types and basic stuff
, Partition
-- * Conversion to\/from lists
, fromPartition
, mkPartition
, toPartition
, toPartitionUnsafe
, isPartition
-- * Conversion to\/from exponent vectors
, toExponentVector
, fromExponentVector
, dropTailingZeros
-- * Union and sum
, unionOfPartitions
, sumOfPartitions
-- * Generating partitions
, partitions
, partitions'
, allPartitions
, allPartitionsGrouped
, allPartitions'
, allPartitionsGrouped'
-- * Counting partitions
, countPartitions
, countPartitions'
, countAllPartitions
, countAllPartitions'
, countPartitionsWithKParts
-- * Random partitions
, randomPartition
, randomPartitions
-- * Dominating \/ dominated partitions
, dominanceCompare
, dominatedPartitions
, dominatingPartitions
-- * Conjugate lexicographic ordering
, conjugateLexicographicCompare
, ConjLex (..) , fromConjLex
-- * Partitions with given number of parts
, partitionsWithKParts
-- * Partitions with only odd\/distinct parts
, partitionsWithOddParts
, partitionsWithDistinctParts
-- * Sub- and super-partitions of a given partition
, subPartitions
, allSubPartitions
, superPartitions
-- * ASCII Ferrers diagrams
, PartitionConvention(..)
, asciiFerrersDiagram
, asciiFerrersDiagram'
)
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

import Math.Combinat.Partitions.Integer.Naive hiding ()    -- this is for haddock!
import Math.Combinat.Partitions.Integer.IntList
import Math.Combinat.Partitions.Integer.Count

---------------------------------------------------------------------------------
-- * Conversion to\/from lists

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

-- | Sorts the input, and cuts the nonpositive elements.
mkPartition :: [Int] -> Partition
mkPartition :: [Int] -> Partition
mkPartition [Int]
xs = [Int] -> Partition
toPartitionUnsafe ([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

-- | 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 [Char] -> Partition
forall a. HasCallStack => [Char] -> a
error [Char]
"toPartition: not a partition"

-- | Assumes that the input is decreasing.
toPartitionUnsafe :: [Int] -> Partition
toPartitionUnsafe :: [Int] -> Partition
toPartitionUnsafe = [Int] -> Partition
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

--------------------------------------------------------------------------------
-- * Conversion to\/from exponent vectors

-- | Converts a partition to an exponent vector.
--
-- For example,
--
-- > toExponentVector (Partition [4,4,2,2,2,1]) == [1,3,0,2]
--
-- meaning @(1^1,2^3,3^0,4^2)@.
--
toExponentVector :: Partition -> [Int]
toExponentVector :: Partition -> [Int]
toExponentVector Partition
part = Int -> [[Int]] -> [Int]
fun Int
1 ([[Int]] -> [Int]) -> [[Int]] -> [Int]
forall a b. (a -> b) -> a -> b
\$ [[Int]] -> [[Int]]
forall a. [a] -> [a]
reverse ([[Int]] -> [[Int]]) -> [[Int]] -> [[Int]]
forall a b. (a -> b) -> a -> b
\$ [Int] -> [[Int]]
forall a. Eq a => [a] -> [[a]]
group (Partition -> [Int]
fromPartition Partition
part) where
fun :: Int -> [[Int]] -> [Int]
fun Int
_  [] = []
fun !Int
k gs :: [[Int]]
gs@(this :: [Int]
this@(Int
i:[Int]
_):[[Int]]
rest)
| Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
i      = Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
k) Int
0 [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Int -> [[Int]] -> [Int]
fun Int
i [[Int]]
gs
| Bool
otherwise  = [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
this Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Int -> [[Int]] -> [Int]
fun (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [[Int]]
rest

fromExponentVector :: [Int] -> Partition
fromExponentVector :: [Int] -> Partition
fromExponentVector [Int]
expos = [Int] -> Partition
Partition ([Int] -> Partition) -> [Int] -> Partition
forall a b. (a -> b) -> a -> b
\$ [[Int]] -> [Int]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Int]] -> [Int]) -> [[Int]] -> [Int]
forall a b. (a -> b) -> a -> b
\$ [[Int]] -> [[Int]]
forall a. [a] -> [a]
reverse ([[Int]] -> [[Int]]) -> [[Int]] -> [[Int]]
forall a b. (a -> b) -> a -> b
\$ (Int -> Int -> [Int]) -> [Int] -> [Int] -> [[Int]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Int -> [Int]
forall a. a -> Int -> [a]
f [Int
1..] [Int]
expos where
f :: a -> Int -> [a]
f !a
i !Int
e = Int -> a -> [a]
forall a. Int -> a -> [a]
replicate Int
e a
i

dropTailingZeros :: [Int] -> [Int]
dropTailingZeros :: [Int] -> [Int]
dropTailingZeros = [Int] -> [Int]
forall a. [a] -> [a]
reverse ([Int] -> [Int]) -> ([Int] -> [Int]) -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0) ([Int] -> [Int]) -> ([Int] -> [Int]) -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Int]
forall a. [a] -> [a]
reverse

{-
-- alternative implementation
toExponentialVector2 :: Partition -> [Int]
toExponentialVector2 p = go 1 (toExponentialForm p) where
go _  []              = []
go !i ef@((j,e):rest) = if i<j
then 0 : go (i+1) ef
else e : go (i+1) rest
-}

--------------------------------------------------------------------------------
-- * Union and sum

-- | This is simply the union of parts. For example
--
-- > Partition [4,2,1] `unionOfPartitions` Partition [4,3,1] == Partition [4,4,3,2,1,1]
--
-- Note: This is the dual of pointwise sum, 'sumOfPartitions'
--
unionOfPartitions :: Partition -> Partition -> Partition
unionOfPartitions :: Partition -> Partition -> Partition
unionOfPartitions (Partition_ [Int]
xs) (Partition_ [Int]
ys) = [Int] -> Partition
mkPartition ([Int]
xs [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
ys)

-- | Pointwise sum of the parts. For example:
--
-- > Partition [3,2,1,1] `sumOfPartitions` Partition [4,3,1] == Partition [7,5,2,1]
--
-- Note: This is the dual of 'unionOfPartitions'
--
sumOfPartitions :: Partition -> Partition -> Partition
sumOfPartitions :: Partition -> Partition -> Partition
sumOfPartitions (Partition_ [Int]
xs) (Partition_ [Int]
ys) = [Int] -> Partition
Partition_ (Int -> Int -> (Int -> Int -> Int) -> [Int] -> [Int] -> [Int]
forall a b c. a -> b -> (a -> b -> c) -> [a] -> [b] -> [c]
longZipWith Int
0 Int
0 Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) [Int]
xs [Int]
ys)

--------------------------------------------------------------------------------
-- * 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
toPartitionUnsafe ([[Int]] -> [Partition]) -> (Int -> [[Int]]) -> Int -> [Partition]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [[Int]]
_partitions

-- | 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

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

-- | 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

---------------------------------------------------------------------------------
-- * 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 of partitions counts 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

cnt :: Int -> Integer
cnt = Int -> Integer
countPartitions

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)

--------------------------------------------------------------------------------
-- * Dominating \/ dominated partitions

-- | Dominance partial ordering as a partial ordering.
dominanceCompare :: Partition -> Partition -> Maybe Ordering
dominanceCompare :: Partition -> Partition -> Maybe Ordering
dominanceCompare Partition
p Partition
q
| Partition
pPartition -> Partition -> Bool
forall a. Eq a => a -> a -> Bool
==Partition
q             = Ordering -> Maybe Ordering
forall a. a -> Maybe a
Just Ordering
EQ
| Partition
p Partition -> Partition -> Bool
`dominates` Partition
q  = Ordering -> Maybe Ordering
forall a. a -> Maybe a
Just Ordering
GT
| Partition
q Partition -> Partition -> Bool
`dominates` Partition
p  = Ordering -> Maybe Ordering
forall a. a -> Maybe a
Just Ordering
LT
| Bool
otherwise        = Maybe Ordering
forall a. Maybe a
Nothing

-- | 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)

-- | 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)

--------------------------------------------------------------------------------
-- * Conjugate lexicographic ordering

conjugateLexicographicCompare :: Partition -> Partition -> Ordering
conjugateLexicographicCompare :: Partition -> Partition -> Ordering
conjugateLexicographicCompare Partition
p Partition
q = Partition -> Partition -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Partition -> Partition
dualPartition Partition
q) (Partition -> Partition
dualPartition Partition
p)

newtype ConjLex = ConjLex Partition deriving (ConjLex -> ConjLex -> Bool
(ConjLex -> ConjLex -> Bool)
-> (ConjLex -> ConjLex -> Bool) -> Eq ConjLex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConjLex -> ConjLex -> Bool
\$c/= :: ConjLex -> ConjLex -> Bool
== :: ConjLex -> ConjLex -> Bool
\$c== :: ConjLex -> ConjLex -> Bool
Eq,Int -> ConjLex -> ShowS
[ConjLex] -> ShowS
ConjLex -> [Char]
(Int -> ConjLex -> ShowS)
-> (ConjLex -> [Char]) -> ([ConjLex] -> ShowS) -> Show ConjLex
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ConjLex] -> ShowS
\$cshowList :: [ConjLex] -> ShowS
show :: ConjLex -> [Char]
\$cshow :: ConjLex -> [Char]
showsPrec :: Int -> ConjLex -> ShowS
\$cshowsPrec :: Int -> ConjLex -> ShowS
Show)

fromConjLex :: ConjLex -> Partition
fromConjLex :: ConjLex -> Partition
fromConjLex (ConjLex Partition
p) = Partition
p

instance Ord ConjLex where
compare :: ConjLex -> ConjLex -> Ordering
compare (ConjLex Partition
p) (ConjLex Partition
q) = Partition -> Partition -> Ordering
conjugateLexicographicCompare Partition
p Partition
q

-- {- CONJUGATE LEXICOGRAPHIC ordering is a refinement of dominance partial ordering -}
-- let test n = [ ConjLex p >= ConjLex q | p <- partitions n , q <-partitions n ,  p `dominates` q ]
-- and (test 20)

-- {- LEXICOGRAPHIC ordering is a refinement of dominance partial ordering -}
-- let test n = [ p >= q | p <- partitions n , q <-partitions n ,  p `dominates` q ]
-- and (test 20)

--------------------------------------------------------------------------------
-- * 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) ]

--------------------------------------------------------------------------------
-- * 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

-- | 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)

-- | 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)

-- | 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
toPartitionUnsafe (Int -> [Int] -> [[Int]]
_superPartitions Int
d [Int]
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 -> [Char]
(Int -> PartitionConvention -> ShowS)
-> (PartitionConvention -> [Char])
-> ([PartitionConvention] -> ShowS)
-> Show PartitionConvention
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [PartitionConvention] -> ShowS
\$cshowList :: [PartitionConvention] -> ShowS
show :: PartitionConvention -> [Char]
\$cshow :: PartitionConvention -> [Char]
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 = [[Char]] -> ASCII
ASCII.asciiFromLines ((Int -> [Char]) -> [Int] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Int -> [Char]
f [Int]
ys) where
f :: Int -> [Char]
f Int
n = Int -> Char -> [Char]
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

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

```