-- | Set partitions.
--
-- See eg. <http://en.wikipedia.org/wiki/Partition_of_a_set>
-- 

{-# LANGUAGE BangPatterns #-}
module Math.Combinat.Partitions.Set where

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

import Data.List
import Data.Ord

import System.Random

import Math.Combinat.Sets
import Math.Combinat.Numbers
import Math.Combinat.Helper
import Math.Combinat.Classes
import Math.Combinat.Partitions.Integer

--------------------------------------------------------------------------------
-- * The type of set partitions

-- | A partition of the set @[1..n]@ (in standard order)
newtype SetPartition = SetPartition [[Int]] deriving (SetPartition -> SetPartition -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetPartition -> SetPartition -> Bool
$c/= :: SetPartition -> SetPartition -> Bool
== :: SetPartition -> SetPartition -> Bool
$c== :: SetPartition -> SetPartition -> Bool
Eq,Eq SetPartition
SetPartition -> SetPartition -> Bool
SetPartition -> SetPartition -> Ordering
SetPartition -> SetPartition -> SetPartition
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 :: SetPartition -> SetPartition -> SetPartition
$cmin :: SetPartition -> SetPartition -> SetPartition
max :: SetPartition -> SetPartition -> SetPartition
$cmax :: SetPartition -> SetPartition -> SetPartition
>= :: SetPartition -> SetPartition -> Bool
$c>= :: SetPartition -> SetPartition -> Bool
> :: SetPartition -> SetPartition -> Bool
$c> :: SetPartition -> SetPartition -> Bool
<= :: SetPartition -> SetPartition -> Bool
$c<= :: SetPartition -> SetPartition -> Bool
< :: SetPartition -> SetPartition -> Bool
$c< :: SetPartition -> SetPartition -> Bool
compare :: SetPartition -> SetPartition -> Ordering
$ccompare :: SetPartition -> SetPartition -> Ordering
Ord,Int -> SetPartition -> ShowS
[SetPartition] -> ShowS
SetPartition -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetPartition] -> ShowS
$cshowList :: [SetPartition] -> ShowS
show :: SetPartition -> String
$cshow :: SetPartition -> String
showsPrec :: Int -> SetPartition -> ShowS
$cshowsPrec :: Int -> SetPartition -> ShowS
Show,ReadPrec [SetPartition]
ReadPrec SetPartition
Int -> ReadS SetPartition
ReadS [SetPartition]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SetPartition]
$creadListPrec :: ReadPrec [SetPartition]
readPrec :: ReadPrec SetPartition
$creadPrec :: ReadPrec SetPartition
readList :: ReadS [SetPartition]
$creadList :: ReadS [SetPartition]
readsPrec :: Int -> ReadS SetPartition
$creadsPrec :: Int -> ReadS SetPartition
Read)

_standardizeSetPartition :: [[Int]] -> [[Int]]
_standardizeSetPartition :: [[Int]] -> [[Int]]
_standardizeSetPartition = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall {a}. [a] -> a
myhead) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Ord a => [a] -> [a]
sort where
  myhead :: [a] -> a
myhead [a]
xs = case [a]
xs of
    (a
x:[a]
xs) -> a
x
    []     -> forall a. HasCallStack => String -> a
error String
"_standardizeSetPartition: empty subset"

fromSetPartition :: SetPartition -> [[Int]]
fromSetPartition :: SetPartition -> [[Int]]
fromSetPartition (SetPartition [[Int]]
zzs) = [[Int]]
zzs

toSetPartitionUnsafe :: [[Int]] -> SetPartition
toSetPartitionUnsafe :: [[Int]] -> SetPartition
toSetPartitionUnsafe = [[Int]] -> SetPartition
SetPartition

toSetPartition :: [[Int]] -> SetPartition
toSetPartition :: [[Int]] -> SetPartition
toSetPartition [[Int]]
zzs = if [[Int]] -> Bool
_isSetPartition [[Int]]
zzs
  then [[Int]] -> SetPartition
SetPartition ([[Int]] -> [[Int]]
_standardizeSetPartition [[Int]]
zzs)
  else forall a. HasCallStack => String -> a
error String
"toSetPartition: not a set partition"

_isSetPartition :: [[Int]] -> Bool
_isSetPartition :: [[Int]] -> Bool
_isSetPartition [[Int]]
zzs = forall a. Ord a => [a] -> [a]
sort (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Int]]
zzs) forall a. Eq a => a -> a -> Bool
== [Int
1..Int
n] where 
  n :: Int
n = forall a. Num a => [a] -> a
sum' (forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Int]]
zzs)

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

--------------------------------------------------------------------------------
-- * Forgetting the set structure

-- | The \"shape\" of a set partition is the partition we get when we forget the
-- set structure, keeping only the cardinalities.
--
setPartitionShape :: SetPartition -> Partition
setPartitionShape :: SetPartition -> Partition
setPartitionShape (SetPartition [[Int]]
pps) = [Int] -> Partition
mkPartition (forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Int]]
pps)

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

-- | Synonym for 'setPartitionsNaive'
setPartitions :: Int -> [SetPartition]
setPartitions :: Int -> [SetPartition]
setPartitions = Int -> [SetPartition]
setPartitionsNaive

-- | Synonym for 'setPartitionsWithKPartsNaive'
--
-- > sort (setPartitionsWithKParts k n) == sort [ p | p <- setPartitions n , numberOfParts p == k ]
-- 
setPartitionsWithKParts   
  :: Int    -- ^ @k@ = number of parts
  -> Int    -- ^ @n@ = size of the set
  -> [SetPartition]
setPartitionsWithKParts :: Int -> Int -> [SetPartition]
setPartitionsWithKParts = Int -> Int -> [SetPartition]
setPartitionsWithKPartsNaive

-- | List all set partitions of @[1..n]@, naive algorithm
setPartitionsNaive :: Int -> [SetPartition]
setPartitionsNaive :: Int -> [SetPartition]
setPartitionsNaive Int
n = forall a b. (a -> b) -> [a] -> [b]
map ([[Int]] -> SetPartition
SetPartition forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Int]] -> [[Int]]
_standardizeSetPartition) forall a b. (a -> b) -> a -> b
$ [Int] -> [[[Int]]]
go [Int
1..Int
n] where
  go :: [Int] -> [[[Int]]]
  go :: [Int] -> [[[Int]]]
go []     = [[]]
  go (Int
z:[Int]
zs) = [ [Int]
s forall a. a -> [a] -> [a]
: [[Int]]
rest | Int
k <- [Int
1..Int
n] , [Int]
s0 <- forall a. Int -> [a] -> [[a]]
choose (Int
kforall a. Num a => a -> a -> a
-Int
1) [Int]
zs , let s :: [Int]
s = Int
zforall a. a -> [a] -> [a]
:[Int]
s0 , [[Int]]
rest <- [Int] -> [[[Int]]]
go ([Int]
zs forall a. Eq a => [a] -> [a] -> [a]
\\ [Int]
s) ]

-- | Set partitions of the set @[1..n]@ into @k@ parts
setPartitionsWithKPartsNaive 
  :: Int    -- ^ @k@ = number of parts
  -> Int    -- ^ @n@ = size of the set
  -> [SetPartition]
setPartitionsWithKPartsNaive :: Int -> Int -> [SetPartition]
setPartitionsWithKPartsNaive Int
k Int
n = forall a b. (a -> b) -> [a] -> [b]
map ([[Int]] -> SetPartition
SetPartition forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Int]] -> [[Int]]
_standardizeSetPartition) forall a b. (a -> b) -> a -> b
$ Int -> [Int] -> [[[Int]]]
go Int
k [Int
1..Int
n] where
  go :: Int -> [Int] -> [[[Int]]]
  go :: Int -> [Int] -> [[[Int]]]
go !Int
k []     = if Int
kforall a. Eq a => a -> a -> Bool
==Int
0 then [[]] else []
  go  Int
1 [Int]
zs     = [[[Int]
zs]]
  go !Int
k (Int
z:[Int]
zs) = [ [Int]
s forall a. a -> [a] -> [a]
: [[Int]]
rest | Int
l <- [Int
1..Int
n] , [Int]
s0 <- forall a. Int -> [a] -> [[a]]
choose (Int
lforall a. Num a => a -> a -> a
-Int
1) [Int]
zs , let s :: [Int]
s = Int
zforall a. a -> [a] -> [a]
:[Int]
s0 , [[Int]]
rest <- Int -> [Int] -> [[[Int]]]
go (Int
kforall a. Num a => a -> a -> a
-Int
1) ([Int]
zs forall a. Eq a => [a] -> [a] -> [a]
\\ [Int]
s) ]


-- | Set partitions are counted by the Bell numbers
countSetPartitions :: Int -> Integer
countSetPartitions :: Int -> Integer
countSetPartitions = forall a. Integral a => a -> Integer
bellNumber 

-- | Set partitions of size @k@ are counted by the Stirling numbers of second kind
countSetPartitionsWithKParts 
  :: Int    -- ^ @k@ = number of parts
  -> Int    -- ^ @n@ = size of the set
  -> Integer
countSetPartitionsWithKParts :: Int -> Int -> Integer
countSetPartitionsWithKParts Int
k Int
n = forall a. Integral a => a -> a -> Integer
stirling2nd Int
n Int
k

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