-- | Partitions of a multiset
module Math.Combinat.Partitions.Multiset where

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

import Data.Array.Unboxed
import Data.List

import Math.Combinat.Partitions.Vector

--------------------------------------------------------------------------------
                              
-- | Partitions of a multiset. Internally, this uses the vector partition algorithm
partitionMultiset :: (Eq a, Ord a) => [a] -> [[[a]]]
partitionMultiset :: [a] -> [[[a]]]
partitionMultiset [a]
xs = [[[a]]]
parts where
  parts :: [[[a]]]
parts = (([UArray Int Int] -> [[a]]) -> [[UArray Int Int]] -> [[[a]]]
forall a b. (a -> b) -> [a] -> [b]
map (([UArray Int Int] -> [[a]]) -> [[UArray Int Int]] -> [[[a]]])
-> ((UArray Int Int -> [a]) -> [UArray Int Int] -> [[a]])
-> (UArray Int Int -> [a])
-> [[UArray Int Int]]
-> [[[a]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UArray Int Int -> [a]) -> [UArray Int Int] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map) ([Int] -> [a]
f ([Int] -> [a])
-> (UArray Int Int -> [Int]) -> UArray Int Int -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UArray Int Int -> [Int]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
elems) [[UArray Int Int]]
temp
  f :: [Int] -> [a]
f [Int]
ns = [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((Int -> a -> [a]) -> [Int] -> [a] -> [[a]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> a -> [a]
forall a. Int -> a -> [a]
replicate [Int]
ns [a]
zs)
  temp :: [[UArray Int Int]]
temp = [Int] -> [[UArray Int Int]]
fasc3B_algorithm_M [Int]
counts
  counts :: [Int]
counts = ([a] -> Int) -> [[a]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[a]]
ys
  ys :: [[a]]
ys = [a] -> [[a]]
forall a. Eq a => [a] -> [[a]]
group ([a] -> [a]
forall a. Ord a => [a] -> [a]
sort [a]
xs) 
  zs :: [a]
zs = ([a] -> a) -> [[a]] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> a
forall a. [a] -> a
head [[a]]
ys

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