{-# LANGUAGE BangPatterns, PatternSynonyms, ViewPatterns #-}
module Math.Combinat.Partitions.Integer.Compact where
import Data.Bits
import Data.Word
import Data.Ord
import Data.List ( intercalate , group , sort , sortBy , foldl' , scanl' )
import Data.Vector.Compact.WordVec ( WordVec , Shape(..) )
import qualified Data.Vector.Compact.WordVec as V
import Math.Combinat.Compositions ( compositions' )
newtype Partition
= Partition WordVec
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
instance Show Partition where
showsPrec :: Int -> Partition -> ShowS
showsPrec = Int -> Partition -> ShowS
showsPrecPartition
showsPrecPartition :: Int -> Partition -> ShowS
showsPrecPartition :: Int -> Partition -> ShowS
showsPrecPartition Int
prec (Partition WordVec
vec)
= Bool -> ShowS -> ShowS
showParen (Int
prec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10)
(ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"Partition"
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word] -> ShowS
forall a. Show a => a -> ShowS
shows (WordVec -> [Word]
V.toList WordVec
vec)
instance Ord Partition where
compare :: Partition -> Partition -> Ordering
compare = Partition -> Partition -> Ordering
cmpLexico
pattern Nil :: Partition
pattern $bNil :: Partition
$mNil :: forall r. Partition -> (Void# -> r) -> (Void# -> r) -> r
Nil <- (isEmpty -> True) where
Nil = Partition
empty
pattern Cons :: Int -> Partition -> Partition
pattern $bCons :: Int -> Partition -> Partition
$mCons :: forall r. Partition -> (Int -> Partition -> r) -> (Void# -> r) -> r
Cons x xs <- (uncons -> Just (x,xs)) where
Cons Int
x Partition
xs = Int -> Partition -> Partition
cons Int
x Partition
xs
pattern Partition_ :: [Int] -> Partition
pattern $bPartition_ :: [Int] -> Partition
$mPartition_ :: forall r. Partition -> ([Int] -> r) -> (Void# -> r) -> r
Partition_ xs <- (toList -> xs) where
Partition_ [Int]
xs = [Int] -> Partition
fromDescList [Int]
xs
pattern Head :: Int -> Partition
pattern $mHead :: forall r. Partition -> (Int -> r) -> (Void# -> r) -> r
Head h <- (height -> h)
pattern Tail :: Partition -> Partition
pattern $mTail :: forall r. Partition -> (Partition -> r) -> (Void# -> r) -> r
Tail xs <- (partitionTail -> xs)
pattern Length :: Int -> Partition
pattern $mLength :: forall r. Partition -> (Int -> r) -> (Void# -> r) -> r
Length n <- (width -> n)
cmpLexico :: Partition -> Partition -> Ordering
cmpLexico :: Partition -> Partition -> Ordering
cmpLexico (Partition WordVec
vec1) (Partition WordVec
vec2) = [Word] -> [Word] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (WordVec -> [Word]
V.toList WordVec
vec1) (WordVec -> [Word]
V.toList WordVec
vec2)
empty :: Partition
empty :: Partition
empty = WordVec -> Partition
Partition (WordVec
V.empty)
isEmpty :: Partition -> Bool
isEmpty :: Partition -> Bool
isEmpty (Partition WordVec
vec) = WordVec -> Bool
V.null WordVec
vec
singleton :: Int -> Partition
singleton :: Int -> Partition
singleton Int
x
| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = WordVec -> Partition
Partition (Word -> WordVec
V.singleton (Word -> WordVec) -> Word -> WordVec
forall a b. (a -> b) -> a -> b
$ Int -> Word
i2w Int
x)
| Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Partition
empty
| Bool
otherwise = String -> Partition
forall a. HasCallStack => String -> a
error String
"Parittion/singleton: negative input"
uncons :: Partition -> Maybe (Int,Partition)
uncons :: Partition -> Maybe (Int, Partition)
uncons (Partition WordVec
vec) = case WordVec -> Maybe (Word, WordVec)
V.uncons WordVec
vec of
Maybe (Word, WordVec)
Nothing -> Maybe (Int, Partition)
forall a. Maybe a
Nothing
Just (Word
h,WordVec
tl) -> (Int, Partition) -> Maybe (Int, Partition)
forall a. a -> Maybe a
Just (Word -> Int
w2i Word
h, WordVec -> Partition
Partition WordVec
tl)
partitionTail :: Partition -> Partition
partitionTail :: Partition -> Partition
partitionTail (Partition WordVec
vec) = WordVec -> Partition
Partition (WordVec -> WordVec
V.tail WordVec
vec)
cons :: Int -> Partition -> Partition
cons :: Int -> Partition -> Partition
cons !Int
x (Partition !WordVec
vec)
| WordVec -> Bool
V.null WordVec
vec = WordVec -> Partition
Partition (if Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Word -> WordVec
V.singleton Word
y else WordVec
V.empty)
| Word
y Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
>= Word
h = WordVec -> Partition
Partition (Word -> WordVec -> WordVec
V.cons Word
y WordVec
vec)
| Bool
otherwise = String -> Partition
forall a. HasCallStack => String -> a
error String
"Partition/cons: invalid element to cons"
where
y :: Word
y = Int -> Word
i2w Int
x
h :: Word
h = WordVec -> Word
V.head WordVec
vec
snoc :: Partition -> Int -> Partition
snoc :: Partition -> Int -> Partition
snoc (Partition !WordVec
vec) !Int
x
| Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = WordVec -> Partition
Partition WordVec
vec
| WordVec -> Bool
V.null WordVec
vec = WordVec -> Partition
Partition (Word -> WordVec
V.singleton Word
y)
| Word
y Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= WordVec -> Word
V.last WordVec
vec = WordVec -> Partition
Partition (WordVec -> Word -> WordVec
V.snoc WordVec
vec Word
y)
| Bool
otherwise = String -> Partition
forall a. HasCallStack => String -> a
error String
"Partition/snoc: invalid element to snoc"
where
y :: Word
y = Int -> Word
i2w Int
x
toExponentialForm :: Partition -> [(Int,Int)]
toExponentialForm :: Partition -> [(Int, Int)]
toExponentialForm = ([Int] -> (Int, Int)) -> [[Int]] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (\[Int]
xs -> ([Int] -> Int
forall a. [a] -> a
head [Int]
xs,[Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
xs)) ([[Int]] -> [(Int, Int)])
-> (Partition -> [[Int]]) -> Partition -> [(Int, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [[Int]]
forall a. Eq a => [a] -> [[a]]
group ([Int] -> [[Int]]) -> (Partition -> [Int]) -> Partition -> [[Int]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Partition -> [Int]
toAscList
fromExponentialForm :: [(Int,Int)] -> Partition
fromExponentialForm :: [(Int, Int)] -> Partition
fromExponentialForm = [Int] -> Partition
fromDescList ([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. (a, Int) -> [a]
f ([(Int, Int)] -> [Int])
-> ([(Int, Int)] -> [(Int, Int)]) -> [(Int, Int)] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int) -> (Int, Int) -> Ordering)
-> [(Int, Int)] -> [(Int, Int)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Int, Int) -> (Int, Int) -> Ordering
forall a b b. Ord a => (a, b) -> (a, b) -> Ordering
g where
f :: (a, Int) -> [a]
f (!a
i,!Int
e) = Int -> a -> [a]
forall a. Int -> a -> [a]
replicate Int
e a
i
g :: (a, b) -> (a, b) -> Ordering
g (!a
i, b
_) (!a
j,b
_) = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
j a
i
width :: Partition -> Int
width :: Partition -> Int
width (Partition WordVec
vec) = WordVec -> Int
V.vecLen WordVec
vec
height :: Partition -> Int
height :: Partition -> Int
height (Partition WordVec
vec) = Word -> Int
w2i (WordVec -> Word
V.head WordVec
vec)
widthHeight :: Partition -> (Int,Int)
widthHeight :: Partition -> (Int, Int)
widthHeight (Partition WordVec
vec) = (WordVec -> Int
V.vecLen WordVec
vec , Word -> Int
w2i (WordVec -> Word
V.head WordVec
vec))
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 [] = []
reverseDiffSequence :: Partition -> [Int]
reverseDiffSequence :: Partition -> [Int]
reverseDiffSequence Partition
p = [Int] -> [Int]
forall a. Num a => [a] -> [a]
go (Int
0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Partition -> [Int]
toAscList Partition
p) where
go :: [a] -> [a]
go (a
x:ys :: [a]
ys@(a
y:[a]
_)) = (a
ya -> a -> a
forall a. Num a => a -> a -> a
-a
x) a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
go [a]
ys
go [a
x] = []
go [] = []
dualPartition :: Partition -> Partition
dualPartition :: Partition -> Partition
dualPartition compact :: Partition
compact@(Partition WordVec
vec)
| WordVec -> Bool
V.null WordVec
vec = WordVec -> Partition
Partition WordVec
V.empty
| Bool
otherwise = WordVec -> Partition
Partition (Shape -> [Word] -> WordVec
V.fromList' Shape
shape ([Word] -> WordVec) -> [Word] -> WordVec
forall a b. (a -> b) -> a -> b
$ (Int -> Word) -> [Int] -> [Word]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Word
i2w [Int]
dual)
where
height :: Word
height = WordVec -> Word
V.head WordVec
vec
len :: Int
len = WordVec -> Int
V.vecLen WordVec
vec
shape :: Shape
shape = Int -> Int -> Shape
Shape (Word -> Int
w2i Word
height) (Word -> Int
V.bitsNeededFor (Word -> Int) -> Word -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Word
i2w Int
len)
dual :: [Int]
dual = [[Int]] -> [Int]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate Int
d Int
j
| (Int
j,Int
d) <- [Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Int -> [Int]
descendToOne Int
len) (Partition -> [Int]
reverseDiffSequence Partition
compact)
]
toList :: Partition -> [Int]
toList :: Partition -> [Int]
toList = Partition -> [Int]
toDescList
toDescList :: Partition -> [Int]
toDescList :: Partition -> [Int]
toDescList (Partition WordVec
vec) = (Word -> Int) -> [Word] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Word -> Int
w2i (WordVec -> [Word]
V.toList WordVec
vec)
toAscList :: Partition -> [Int]
toAscList :: Partition -> [Int]
toAscList (Partition WordVec
vec) = (Word -> Int) -> [Word] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Word -> Int
w2i (WordVec -> [Word]
V.toRevList WordVec
vec)
fromDescList :: [Int] -> Partition
fromDescList :: [Int] -> Partition
fromDescList [Int]
list = Int -> [Int] -> Partition
fromDescList' ([Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
list) [Int]
list
fromDescList'
:: Int
-> [Int]
-> Partition
fromDescList' :: Int -> [Int] -> Partition
fromDescList' !Int
len ![Int]
list = WordVec -> Partition
Partition (Shape -> [Word] -> WordVec
V.fromList' (Int -> Int -> Shape
Shape Int
len Int
bits) ([Word] -> WordVec) -> [Word] -> WordVec
forall a b. (a -> b) -> a -> b
$ (Int -> Word) -> [Int] -> [Word]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Word
i2w [Int]
list) where
bits :: Int
bits = case [Int]
list of
[] -> Int
4
(Int
x:[Int]
xs) -> Word -> Int
V.bitsNeededFor (Int -> Word
i2w Int
x)
isSubPartitionOf :: Partition -> Partition -> Bool
isSubPartitionOf :: Partition -> Partition -> Bool
isSubPartitionOf Partition
p Partition
q = [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
(<=) (Partition -> [Int]
toList Partition
p) (Partition -> [Int]
toList Partition
q [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Int -> [Int]
forall a. a -> [a]
repeat Int
0)
dominates :: Partition -> Partition -> Bool
dominates :: Partition -> Partition -> Bool
dominates (Partition WordVec
vec_q) (Partition WordVec
vec_p) = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (Word -> Word -> Bool) -> [Word] -> [Word] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
(>=) ([Word] -> [Word]
sums ([Word]
qs [Word] -> [Word] -> [Word]
forall a. [a] -> [a] -> [a]
++ Word -> [Word]
forall a. a -> [a]
repeat Word
0)) ([Word] -> [Word]
sums [Word]
ps) where
sums :: [Word] -> [Word]
sums = [Word] -> [Word]
forall a. [a] -> [a]
tail ([Word] -> [Word]) -> ([Word] -> [Word]) -> [Word] -> [Word]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word -> Word -> Word) -> Word -> [Word] -> [Word]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl' Word -> Word -> Word
forall a. Num a => a -> a -> a
(+) Word
0
ps :: [Word]
ps = WordVec -> [Word]
V.toList WordVec
vec_p
qs :: [Word]
qs = WordVec -> [Word]
V.toList WordVec
vec_q
pieriRule :: Partition -> Int -> [Partition]
pieriRule :: Partition -> Int -> [Partition]
pieriRule = String -> Partition -> Int -> [Partition]
forall a. HasCallStack => String -> a
error String
"Partitions/Integer/Compact: pieriRule not implemented yet"
{-# INLINE i2w #-}
i2w :: Int -> Word
i2w :: Int -> Word
i2w = Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE w2i #-}
w2i :: Word -> Int
w2i :: Word -> Int
w2i = Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE sum' #-}
sum' :: [Word] -> Word
sum' :: [Word] -> Word
sum' = (Word -> Word -> Word) -> Word -> [Word] -> Word
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Word -> Word -> Word
forall a. Num a => a -> a -> a
(+) Word
0
{-# INLINE safeTail #-}
safeTail :: [Int] -> [Int]
safeTail :: [Int] -> [Int]
safeTail [Int]
xs = case [Int]
xs of { [] -> [] ; [Int]
_ -> [Int] -> [Int]
forall a. [a] -> [a]
tail [Int]
xs }
{-# INLINE descendToZero #-}
descendToZero :: Int -> [Int]
descendToZero :: Int -> [Int]
descendToZero !Int
n
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Int
n Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Int -> [Int]
descendToZero (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
| Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = [Int
0]
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = []
{-# INLINE descendToOne #-}
descendToOne :: Int -> [Int]
descendToOne :: Int -> [Int]
descendToOne !Int
n
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 = Int
n Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Int -> [Int]
descendToOne (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
| Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = [Int
1]
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 = []