module Math.Combinat.Partitions.Integer where
import Data.List
import Math.Combinat.Helper
import Math.Combinat.ASCII as ASCII
import Math.Combinat.Numbers (factorial,binomial,multinomial)
newtype Partition = Partition [Int] deriving (Eq,Ord,Show,Read)
class HasNumberOfParts p where
numberOfParts :: p -> Int
instance HasNumberOfParts Partition where
numberOfParts (Partition p) = length p
mkPartition :: [Int] -> Partition
mkPartition xs = Partition $ sortBy (reverseCompare) $ filter (>0) xs
toPartitionUnsafe :: [Int] -> Partition
toPartitionUnsafe = Partition
toPartition :: [Int] -> Partition
toPartition xs = if isPartition xs
then toPartitionUnsafe xs
else error "toPartition: not a partition"
isPartition :: [Int] -> Bool
isPartition [] = True
isPartition [_] = True
isPartition (x:xs@(y:_)) = (x >= y) && isPartition xs
fromPartition :: Partition -> [Int]
fromPartition (Partition part) = part
height :: Partition -> Int
height (Partition part) = case part of
(p:_) -> p
[] -> 0
width :: Partition -> Int
width (Partition part) = length part
heightWidth :: Partition -> (Int,Int)
heightWidth part = (height part, width part)
weight :: Partition -> Int
weight (Partition part) = sum' part
dualPartition :: Partition -> Partition
dualPartition (Partition part) = Partition (_dualPartition part)
_dualPartition :: [Int] -> [Int]
_dualPartition [] = []
_dualPartition xs@(k:_) = [ length $ filter (>=i) xs | i <- [1..k] ]
elements :: Partition -> [(Int,Int)]
elements (Partition part) = _elements part
_elements :: [Int] -> [(Int,Int)]
_elements shape = [ (i,j) | (i,l) <- zip [1..] shape, j<-[1..l] ]
countAutomorphisms :: Partition -> Integer
countAutomorphisms = _countAutomorphisms . fromPartition
_countAutomorphisms :: [Int] -> Integer
_countAutomorphisms = multinomial . map length . group
dominates :: Partition -> Partition -> Bool
dominates (Partition qs) (Partition ps)
= and $ zipWith (>=) (sums (qs ++ repeat 0)) (sums ps)
where
sums = scanl (+) 0
_partitions'
:: (Int,Int)
-> Int
-> [[Int]]
_partitions' _ 0 = [[]]
_partitions' ( 0 , _) d = if d==0 then [[]] else []
_partitions' ( _ , 0) d = if d==0 then [[]] else []
_partitions' (!h ,!w) d =
[ i:xs | i <- [1..min d h] , xs <- _partitions' (i,w1) (di) ]
partitions'
:: (Int,Int)
-> Int
-> [Partition]
partitions' hw d = map toPartitionUnsafe $ _partitions' hw d
countPartitions' :: (Int,Int) -> Int -> Integer
countPartitions' _ 0 = 1
countPartitions' (0,_) d = if d==0 then 1 else 0
countPartitions' (_,0) d = if d==0 then 1 else 0
countPartitions' (h,w) d = sum
[ countPartitions' (i,w1) (di) | i <- [1..min d h] ]
_partitions :: Int -> [[Int]]
_partitions d = _partitions' (d,d) d
partitions :: Int -> [Partition]
partitions d = partitions' (d,d) d
countPartitions :: Int -> Integer
countPartitions d = countPartitions' (d,d) d
allPartitions'
:: (Int,Int)
-> [[Partition]]
allPartitions' (h,w) = [ partitions' (h,w) i | i <- [0..d] ] where d = h*w
allPartitions :: Int -> [[Partition]]
allPartitions d = [ partitions i | i <- [0..d] ]
countAllPartitions' :: (Int,Int) -> Integer
countAllPartitions' (h,w) =
binomial (h+w) (min h w)
countAllPartitions :: Int -> Integer
countAllPartitions d = sum' [ countPartitions i | i <- [0..d] ]
partitionsWithKParts
:: Int
-> Int
-> [Partition]
partitionsWithKParts k n = map Partition $ go n k n where
go !h !k !n
| k < 0 = []
| k == 0 = if h>=0 && n==0 then [[] ] else []
| k == 1 = if h>=n && n>=1 then [[n]] else []
| otherwise = [ a:p | a <- [1..(min h (nk+1))] , p <- go a (k1) (na) ]
countPartitionsWithKParts
:: Int
-> Int
-> Integer
countPartitionsWithKParts k n = go n k n where
go !h !k !n
| k < 0 = 0
| k == 0 = if h>=0 && n==0 then 1 else 0
| k == 1 = if h>=n && n>=1 then 1 else 0
| otherwise = sum' [ go a (k1) (na) | a<-[1..(min h (nk+1))] ]
isSubPartitionOf :: Partition -> Partition -> Bool
isSubPartitionOf (Partition ps) (Partition qs) = and $ zipWith (<=) ps (qs ++ repeat 0)
subPartitions :: Int -> Partition -> [Partition]
subPartitions d (Partition ps) = map Partition (_subPartitions d ps)
_subPartitions :: Int -> [Int] -> [[Int]]
_subPartitions d big
| null big = if d==0 then [[]] else []
| d > sum' big = []
| d < 0 = []
| otherwise = go d (head big) big
where
go :: Int -> Int -> [Int] -> [[Int]]
go !k !h [] = if k==0 then [[]] else []
go !k !h (b:bs)
| k<0 || h<0 = []
| k==0 = [[]]
| h==0 = []
| otherwise = [ this:rest | this <- [1..min h b] , rest <- go (kthis) this bs ]
allSubPartitions :: Partition -> [Partition]
allSubPartitions (Partition ps) = map Partition (_allSubPartitions ps)
_allSubPartitions :: [Int] -> [[Int]]
_allSubPartitions big
| null big = [[]]
| otherwise = go (head big) big
where
go _ [] = [[]]
go !h (b:bs)
| h==0 = []
| otherwise = [] : [ this:rest | this <- [1..min h b] , rest <- go this bs ]
data PartitionConvention
= EnglishNotation
| EnglishNotationCCW
| FrenchNotation
deriving (Eq,Show)
asciiFerrersDiagram :: Partition -> ASCII
asciiFerrersDiagram = asciiFerrersDiagram' EnglishNotation '@'
asciiFerrersDiagram' :: PartitionConvention -> Char -> Partition -> ASCII
asciiFerrersDiagram' conv ch part = ASCII.asciiFromLines (map f ys) where
f n = replicate n ch
ys = case conv of
EnglishNotation -> fromPartition part
EnglishNotationCCW -> reverse $ fromPartition $ dualPartition part
FrenchNotation -> reverse $ fromPartition $ part