-- | Naive implementation of partitions of integers, encoded as list of @Int@-s.
--
-- Integer partitions are nonincreasing sequences of positive integers.
--
-- This is an internal module, you are not supposed to import it directly.
--
 

{-# LANGUAGE CPP, BangPatterns, ScopedTypeVariables, PatternSynonyms, ViewPatterns #-}
module Math.Combinat.Partitions.Integer.Naive 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.IntList
import Math.Combinat.Partitions.Integer.Count ( countPartitions )

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

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

toList :: Partition -> [Int]
toList :: Partition -> [Int]
toList (Partition [Int]
xs) = [Int]
xs

fromList :: [Int] -> Partition 
fromList :: [Int] -> Partition
fromList = [Int] -> Partition
mkPartition where
  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

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

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

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

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

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

--------------------------------------------------------------------------------
-- * Pattern synonyms 

-- | Pattern sysnonyms allows us to use existing code with minimal modifications
pattern Nil :: Partition
pattern $bNil :: Partition
$mNil :: forall r. Partition -> (Void# -> r) -> (Void# -> r) -> r
Nil <- (isEmpty -> True) where
        Nil =  Partition
forall a. CanBeEmpty a => a
empty

pattern Cons :: Int -> Partition -> Partition
pattern $bCons :: Int -> Partition -> Partition
$mCons :: forall r. Partition -> (Int -> Partition -> r) -> (Void# -> r) -> r
Cons x xs  <- (unconsPartition -> Just (x,xs)) where
        Cons Int
x (Partition [Int]
xs) = [Int] -> Partition
Partition (Int
xInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
xs)

-- | Simulated newtype constructor 
pattern Partition_ :: [Int] -> Partition
pattern $bPartition_ :: [Int] -> Partition
$mPartition_ :: forall r. Partition -> ([Int] -> r) -> (Void# -> r) -> r
Partition_ xs = Partition xs

pattern Head :: Int -> Partition 
pattern $mHead :: forall r. Partition -> (Int -> r) -> (Void# -> r) -> r
Head h <- (head . toDescList -> h)

pattern Tail :: Partition -> Partition
pattern $mTail :: forall r. Partition -> (Partition -> r) -> (Void# -> r) -> r
Tail xs <- (Partition . tail . toDescList -> xs)

pattern Length :: Int -> Partition 
pattern $mLength :: forall r. Partition -> (Int -> r) -> (Void# -> r) -> r
Length n <- (partitionWidth -> n)        
 
---------------------------------------------------------------------------------
-- * 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]
toDescList

fromExponentialForm :: [(Int,Int)] -> Partition
fromExponentialForm :: [(Int, Int)] -> Partition
fromExponentialForm = [Int] -> Partition
Partition ([Int] -> Partition)
-> ([(Int, Int)] -> [Int]) -> [(Int, Int)] -> Partition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, Int)] -> [Int]
_fromExponentialForm where

--------------------------------------------------------------------------------
-- * List-like operations

-- | From a sequence @[a1,a2,..,an]@ computes the sequence of differences
-- @[a1-a2,a2-a3,...,an-0]@
diffSequence :: Partition -> [Int]
diffSequence :: Partition -> [Int]
diffSequence = [Int] -> [Int]
forall a. Num a => [a] -> [a]
go ([Int] -> [Int]) -> (Partition -> [Int]) -> Partition -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Partition -> [Int]
toDescList 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 []  = []

unconsPartition :: Partition -> Maybe (Int,Partition)
unconsPartition :: Partition -> Maybe (Int, Partition)
unconsPartition (Partition [Int]
xs) = case [Int]
xs of
  (Int
y:[Int]
ys) -> (Int, Partition) -> Maybe (Int, Partition)
forall a. a -> Maybe a
Just (Int
y, [Int] -> Partition
Partition [Int]
ys)
  []     -> Maybe (Int, Partition)
forall a. Maybe a
Nothing

toDescList :: Partition -> [Int]
toDescList :: Partition -> [Int]
toDescList (Partition [Int]
xs) = [Int]
xs

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

--------------------------------------------------------------------------------
-- * Containment partial ordering

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

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

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