-- | Skew tableaux are skew partitions filled with numbers.
--
-- For example:
--
-- <<svg/skew_tableau.svg>>
--

{-# LANGUAGE CPP, BangPatterns, ScopedTypeVariables, MultiParamTypeClasses #-}

module Math.Combinat.Tableaux.Skew where

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

import Data.List

import Math.Combinat.Classes
import Math.Combinat.Partitions.Integer
import Math.Combinat.Partitions.Integer.IntList ( _diffSequence )
import Math.Combinat.Partitions.Skew
import Math.Combinat.Tableaux
import Math.Combinat.ASCII
import Math.Combinat.Helper

import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map

--------------------------------------------------------------------------------
-- * Basics
-- | A skew tableau is represented by a list of offsets and entries
newtype SkewTableau a = SkewTableau [(Int,[a])] deriving (SkewTableau a -> SkewTableau a -> Bool
(SkewTableau a -> SkewTableau a -> Bool)
-> (SkewTableau a -> SkewTableau a -> Bool) -> Eq (SkewTableau a)
forall a. Eq a => SkewTableau a -> SkewTableau a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SkewTableau a -> SkewTableau a -> Bool
$c/= :: forall a. Eq a => SkewTableau a -> SkewTableau a -> Bool
== :: SkewTableau a -> SkewTableau a -> Bool
$c== :: forall a. Eq a => SkewTableau a -> SkewTableau a -> Bool
Eq,Eq (SkewTableau a)
Eq (SkewTableau a)
-> (SkewTableau a -> SkewTableau a -> Ordering)
-> (SkewTableau a -> SkewTableau a -> Bool)
-> (SkewTableau a -> SkewTableau a -> Bool)
-> (SkewTableau a -> SkewTableau a -> Bool)
-> (SkewTableau a -> SkewTableau a -> Bool)
-> (SkewTableau a -> SkewTableau a -> SkewTableau a)
-> (SkewTableau a -> SkewTableau a -> SkewTableau a)
-> Ord (SkewTableau a)
SkewTableau a -> SkewTableau a -> Bool
SkewTableau a -> SkewTableau a -> Ordering
SkewTableau a -> SkewTableau a -> SkewTableau a
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
forall a. Ord a => Eq (SkewTableau a)
forall a. Ord a => SkewTableau a -> SkewTableau a -> Bool
forall a. Ord a => SkewTableau a -> SkewTableau a -> Ordering
forall a. Ord a => SkewTableau a -> SkewTableau a -> SkewTableau a
min :: SkewTableau a -> SkewTableau a -> SkewTableau a
$cmin :: forall a. Ord a => SkewTableau a -> SkewTableau a -> SkewTableau a
max :: SkewTableau a -> SkewTableau a -> SkewTableau a
$cmax :: forall a. Ord a => SkewTableau a -> SkewTableau a -> SkewTableau a
>= :: SkewTableau a -> SkewTableau a -> Bool
$c>= :: forall a. Ord a => SkewTableau a -> SkewTableau a -> Bool
> :: SkewTableau a -> SkewTableau a -> Bool
$c> :: forall a. Ord a => SkewTableau a -> SkewTableau a -> Bool
<= :: SkewTableau a -> SkewTableau a -> Bool
$c<= :: forall a. Ord a => SkewTableau a -> SkewTableau a -> Bool
< :: SkewTableau a -> SkewTableau a -> Bool
$c< :: forall a. Ord a => SkewTableau a -> SkewTableau a -> Bool
compare :: SkewTableau a -> SkewTableau a -> Ordering
$ccompare :: forall a. Ord a => SkewTableau a -> SkewTableau a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (SkewTableau a)
Ord,Int -> SkewTableau a -> ShowS
[SkewTableau a] -> ShowS
SkewTableau a -> String
(Int -> SkewTableau a -> ShowS)
-> (SkewTableau a -> String)
-> ([SkewTableau a] -> ShowS)
-> Show (SkewTableau a)
forall a. Show a => Int -> SkewTableau a -> ShowS
forall a. Show a => [SkewTableau a] -> ShowS
forall a. Show a => SkewTableau a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SkewTableau a] -> ShowS
$cshowList :: forall a. Show a => [SkewTableau a] -> ShowS
show :: SkewTableau a -> String
$cshow :: forall a. Show a => SkewTableau a -> String
showsPrec :: Int -> SkewTableau a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> SkewTableau a -> ShowS
Show)

-- unSkewTableau :: SkewTableau a -> [(Int,[a])]
-- unSkewTableau (SkewTableau a) = a

instance Functor SkewTableau where
  fmap :: (a -> b) -> SkewTableau a -> SkewTableau b
fmap a -> b
f (SkewTableau [(Int, [a])]
t) = [(Int, [b])] -> SkewTableau b
forall a. [(Int, [a])] -> SkewTableau a
SkewTableau [ (Int
a, (a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f [a]
xs) | (Int
a,[a]
xs) <- [(Int, [a])]
t ]

-- | The shape of a skew tableau 
skewTableauShape :: SkewTableau a -> SkewPartition
skewTableauShape :: SkewTableau a -> SkewPartition
skewTableauShape (SkewTableau [(Int, [a])]
list) = [(Int, Int)] -> SkewPartition
SkewPartition [ (Int
o,[a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs) | (Int
o,[a]
xs) <- [(Int, [a])]
list ]

instance HasShape (SkewTableau a) SkewPartition where
  shape :: SkewTableau a -> SkewPartition
shape = SkewTableau a -> SkewPartition
forall a. SkewTableau a -> SkewPartition
skewTableauShape

-- | The weight of a tableau is the weight of its shape, or the number of entries
skewTableauWeight :: SkewTableau a -> Int
skewTableauWeight :: SkewTableau a -> Int
skewTableauWeight = SkewPartition -> Int
skewPartitionWeight (SkewPartition -> Int)
-> (SkewTableau a -> SkewPartition) -> SkewTableau a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SkewTableau a -> SkewPartition
forall a. SkewTableau a -> SkewPartition
skewTableauShape

instance HasWeight (SkewTableau a) where
  weight :: SkewTableau a -> Int
weight = SkewTableau a -> Int
forall a. SkewTableau a -> Int
skewTableauWeight

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

-- | The dual of a skew tableau, that is, its mirror image to the main diagonal
dualSkewTableau :: forall a. SkewTableau a -> SkewTableau a
dualSkewTableau :: SkewTableau a -> SkewTableau a
dualSkewTableau (SkewTableau [(Int, [a])]
axs) = [(Int, [a])] -> SkewTableau a
forall a. [(Int, [a])] -> SkewTableau a
SkewTableau ([(Int, [a])] -> [(Int, [a])]
go [(Int, [a])]
axs) where

  go :: [(Int, [a])] -> [(Int, [a])]
go []  = []  
  go [(Int, [a])]
axs = case Int -> [(Int, [a])] -> (Int, [a])
sub Int
0 [(Int, [a])]
axs of
    (Int
0,[]) -> []
    (Int, [a])
this   -> (Int, [a])
this (Int, [a]) -> [(Int, [a])] -> [(Int, [a])]
forall a. a -> [a] -> [a]
: [(Int, [a])] -> [(Int, [a])]
go ([(Int, [a])] -> [(Int, [a])]
strip [(Int, [a])]
axs)

  strip :: [(Int,[a])] -> [(Int,[a])]
  strip :: [(Int, [a])] -> [(Int, [a])]
strip []            = []
  strip ((Int
a,[a]
xs):[(Int, [a])]
rest) = if Int
aInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0 
    then (Int
aInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1,[a]
xs) (Int, [a]) -> [(Int, [a])] -> [(Int, [a])]
forall a. a -> [a] -> [a]
: [(Int, [a])] -> [(Int, [a])]
strip [(Int, [a])]
rest
    else case [a]
xs of
      []     -> []
      (a
z:[a]
zs) -> case [a]
zs of
        []      -> []
        [a]
_       -> (Int
0,[a]
zs) (Int, [a]) -> [(Int, [a])] -> [(Int, [a])]
forall a. a -> [a] -> [a]
: [(Int, [a])] -> [(Int, [a])]
strip [(Int, [a])]
rest

  sub :: Int -> [(Int,[a])] -> (Int,[a])
  sub :: Int -> [(Int, [a])] -> (Int, [a])
sub !Int
b [] = (Int
b,[])
  sub !Int
b ((Int
a,[a]
this):[(Int, [a])]
rest) = if Int
aInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0 
    then Int -> [(Int, [a])] -> (Int, [a])
sub (Int
bInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [(Int, [a])]
rest  
    else (Int
b,[a]
ys) where      
      ys :: [a]
ys = ([a] -> a) -> [[a]] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> a
forall a. [a] -> a
head ([[a]] -> [a]) -> [[a]] -> [a]
forall a b. (a -> b) -> a -> b
$ ([a] -> Bool) -> [[a]] -> [[a]]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> ([a] -> Bool) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([a]
this [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: ((Int, [a]) -> [a]) -> [(Int, [a])] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (Int, [a]) -> [a]
forall a b. (a, b) -> b
snd [(Int, [a])]
rest)

{-
test_dualSkewTableau :: [SkewTableau Int]
test_dualSkewTableau = bad where 
  ps = allPartitions 11
  bad = [ st 
        | p<-ps , q<-ps 
        , (q `isSubPartitionOf` p) 
        , let sp = mkSkewPartition (p,q) 
        , let st = fillSkewPartitionWithRowWord sp [1..] 
        , dualSkewTableau (dualSkewTableau st) /= st
        ]
-}

instance HasDuality (SkewTableau a) where
  dual :: SkewTableau a -> SkewTableau a
dual = SkewTableau a -> SkewTableau a
forall a. SkewTableau a -> SkewTableau a
dualSkewTableau

--------------------------------------------------------------------------------
-- * Semistandard tableau

-- | A tableau is /semistandard/ if its entries are weekly increasing horizontally
-- and strictly increasing vertically
isSemiStandardSkewTableau :: SkewTableau Int -> Bool
isSemiStandardSkewTableau :: SkewTableau Int -> Bool
isSemiStandardSkewTableau st :: SkewTableau Int
st@(SkewTableau [(Int, [Int])]
axs) = Bool
weak Bool -> Bool -> Bool
&& Bool
strict where
  weak :: Bool
weak   = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ [Int] -> Bool
forall a. Ord a => [a] -> Bool
isWeaklyIncreasing   [Int]
xs | (Int
a,[Int]
xs) <- [(Int, [Int])]
axs ]
  strict :: Bool
strict = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ [Int] -> Bool
forall a. Ord a => [a] -> Bool
isStrictlyIncreasing [Int]
ys | (Int
b,[Int]
ys) <- [(Int, [Int])]
bys ]
  SkewTableau [(Int, [Int])]
bys = SkewTableau Int -> SkewTableau Int
forall a. SkewTableau a -> SkewTableau a
dualSkewTableau SkewTableau Int
st

-- | A tableau is /standard/ if it is semistandard and its content is exactly @[1..n]@,
-- where @n@ is the weight.
isStandardSkewTableau :: SkewTableau Int -> Bool
isStandardSkewTableau :: SkewTableau Int -> Bool
isStandardSkewTableau SkewTableau Int
st = SkewTableau Int -> Bool
isSemiStandardSkewTableau SkewTableau Int
st Bool -> Bool -> Bool
&& [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sort (SkewTableau Int -> [Int]
forall a. SkewTableau a -> [a]
skewTableauRowWord SkewTableau Int
st) [Int] -> [Int] -> Bool
forall a. Eq a => a -> a -> Bool
== [Int
1..Int
n] where
  n :: Int
n = SkewTableau Int -> Int
forall a. SkewTableau a -> Int
skewTableauWeight SkewTableau Int
st
  
--------------------------------------------------------------------------------

-- | All semi-standard skew tableaux filled with the numbers @[1..n]@
semiStandardSkewTableaux :: Int -> SkewPartition -> [SkewTableau Int]
semiStandardSkewTableaux :: Int -> SkewPartition -> [SkewTableau Int]
semiStandardSkewTableaux Int
n (SkewPartition [(Int, Int)]
abs) = ([(Int, [Int])] -> SkewTableau Int)
-> [[(Int, [Int])]] -> [SkewTableau Int]
forall a b. (a -> b) -> [a] -> [b]
map [(Int, [Int])] -> SkewTableau Int
forall a. [(Int, [a])] -> SkewTableau a
SkewTableau [[(Int, [Int])]]
stuff where

  stuff :: [[(Int, [Int])]]
stuff = [Int] -> [Int] -> [Int] -> [Int] -> [[(Int, [Int])]]
worker [Int]
as [Int]
bs [Int]
ds (Int -> [Int]
forall a. a -> [a]
repeat Int
1) 
  ([Int]
as,[Int]
bs) = [(Int, Int)] -> ([Int], [Int])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Int, Int)]
abs
  ds :: [Int]
ds = [Int] -> [Int]
_diffSequence [Int]
as
  
  -- | @worker inner outerMinusInner innerdiffs lowerbound
  worker :: [Int] -> [Int] -> [Int] -> [Int] -> [[(Int,[Int])]]
  worker :: [Int] -> [Int] -> [Int] -> [Int] -> [[(Int, [Int])]]
worker (Int
a:[Int]
as) (Int
b:[Int]
bs) (Int
d:[Int]
ds) [Int]
lb = [ (Int
a,[Int]
this)(Int, [Int]) -> [(Int, [Int])] -> [(Int, [Int])]
forall a. a -> [a] -> [a]
:[(Int, [Int])]
rest 
                                   | [Int]
this <- Int -> Int -> [Int] -> [[Int]]
forall t. (Eq t, Num t) => t -> Int -> [Int] -> [[Int]]
row Int
b Int
1 [Int]
lb 
                                   , let lb' :: [Int]
lb' = (Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate Int
d Int
1 [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [Int]
this) 
                                   , [(Int, [Int])]
rest <- [Int] -> [Int] -> [Int] -> [Int] -> [[(Int, [Int])]]
worker [Int]
as [Int]
bs [Int]
ds [Int]
lb' ] 
  worker []     [Int]
_      [Int]
_      [Int]
_  = [ [] ]

  -- @row length minimum lowerbound@
  row :: t -> Int -> [Int] -> [[Int]]
row t
0  Int
_  [Int]
_       = [[]]
  row t
_  Int
_  []      = []
  row !t
k !Int
m (!Int
a:[Int]
as) = [ Int
xInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
xs | Int
x <- [(Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
a Int
m)..Int
n] , [Int]
xs <- t -> Int -> [Int] -> [[Int]]
row (t
kt -> t -> t
forall a. Num a => a -> a -> a
-t
1) Int
x [Int]
as ] 

{-
-- | from a sequence @[a1,a2,..,an]@ computes the sequence of differences
-- @[a1-a2,a2-a3,...,an-0]@
diffSequence :: [Int] -> [Int]
diffSequence = go where
  go (x:ys@(y:_)) = (x-y) : go ys 
  go [x] = [x]
  go []  = []
-}

--------------------------------------------------------------------------------
-- * ASCII

-- | ASCII drawing of a skew tableau (using the English notation)
asciiSkewTableau :: Show a => SkewTableau a -> ASCII
asciiSkewTableau :: SkewTableau a -> ASCII
asciiSkewTableau = String -> PartitionConvention -> SkewTableau a -> ASCII
forall a.
Show a =>
String -> PartitionConvention -> SkewTableau a -> ASCII
asciiSkewTableau' String
"." PartitionConvention
EnglishNotation

asciiSkewTableau' 
  :: Show a
  => String               -- ^ string representing the elements of the inner (unfilled) partition
  -> PartitionConvention  -- ^ orientation
  -> SkewTableau a 
  -> ASCII
asciiSkewTableau' :: String -> PartitionConvention -> SkewTableau a -> ASCII
asciiSkewTableau' String
innerstr PartitionConvention
orient (SkewTableau [(Int, [a])]
axs) = (HAlign, VAlign) -> (HSep, VSep) -> [[ASCII]] -> ASCII
tabulate (HAlign
HRight,VAlign
VTop) (Int -> HSep
HSepSpaces Int
1, VSep
VSepEmpty) [[ASCII]]
stuff where
  stuff :: [[ASCII]]
stuff = case PartitionConvention
orient of
    PartitionConvention
EnglishNotation    -> [[ASCII]]
es
    PartitionConvention
EnglishNotationCCW -> [[ASCII]] -> [[ASCII]]
forall a. [a] -> [a]
reverse ([[ASCII]] -> [[ASCII]]
forall a. [[a]] -> [[a]]
transpose [[ASCII]]
es)
    PartitionConvention
FrenchNotation     -> [[ASCII]] -> [[ASCII]]
forall a. [a] -> [a]
reverse [[ASCII]]
es
  inner :: ASCII
inner = String -> ASCII
asciiFromString String
innerstr
  es :: [[ASCII]]
es = [ Int -> ASCII -> [ASCII]
forall a. Int -> a -> [a]
replicate Int
a ASCII
inner [ASCII] -> [ASCII] -> [ASCII]
forall a. [a] -> [a] -> [a]
++ (a -> ASCII) -> [a] -> [ASCII]
forall a b. (a -> b) -> [a] -> [b]
map a -> ASCII
forall a. Show a => a -> ASCII
asciiShow [a]
xs | (Int
a,[a]
xs) <- [(Int, [a])]
axs ]

instance Show a => DrawASCII (SkewTableau a) where
  ascii :: SkewTableau a -> ASCII
ascii = SkewTableau a -> ASCII
forall a. Show a => SkewTableau a -> ASCII
asciiSkewTableau

--------------------------------------------------------------------------------
-- * Row \/ column words

-- | The reversed (right-to-left) rows, concatenated
skewTableauRowWord :: SkewTableau a -> [a]
skewTableauRowWord :: SkewTableau a -> [a]
skewTableauRowWord (SkewTableau [(Int, [a])]
axs) = ((Int, [a]) -> [a]) -> [(Int, [a])] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> ((Int, [a]) -> [a]) -> (Int, [a]) -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, [a]) -> [a]
forall a b. (a, b) -> b
snd) [(Int, [a])]
axs

-- | The reversed (bottom-to-top) columns, concatenated
skewTableauColumnWord :: SkewTableau a -> [a]
skewTableauColumnWord :: SkewTableau a -> [a]
skewTableauColumnWord = SkewTableau a -> [a]
forall a. SkewTableau a -> [a]
skewTableauRowWord (SkewTableau a -> [a])
-> (SkewTableau a -> SkewTableau a) -> SkewTableau a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SkewTableau a -> SkewTableau a
forall a. SkewTableau a -> SkewTableau a
dualSkewTableau

-- | Fills a skew partition with content, in row word order 
fillSkewPartitionWithRowWord :: SkewPartition -> [a] -> SkewTableau a
fillSkewPartitionWithRowWord :: SkewPartition -> [a] -> SkewTableau a
fillSkewPartitionWithRowWord (SkewPartition [(Int, Int)]
abs) [a]
xs = [(Int, [a])] -> SkewTableau a
forall a. [(Int, [a])] -> SkewTableau a
SkewTableau ([(Int, [a])] -> SkewTableau a) -> [(Int, [a])] -> SkewTableau a
forall a b. (a -> b) -> a -> b
$ [(Int, Int)] -> [a] -> [(Int, [a])]
forall a a. [(a, Int)] -> [a] -> [(a, [a])]
go [(Int, Int)]
abs [a]
xs where
  go :: [(a, Int)] -> [a] -> [(a, [a])]
go ((a
b,Int
a):[(a, Int)]
rest) [a]
xs = let ([a]
ys,[a]
zs) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
a [a]
xs in (a
b,[a] -> [a]
forall a. [a] -> [a]
reverse [a]
ys) (a, [a]) -> [(a, [a])] -> [(a, [a])]
forall a. a -> [a] -> [a]
: [(a, Int)] -> [a] -> [(a, [a])]
go [(a, Int)]
rest [a]
zs
  go []           [a]
xs = []

-- | Fills a skew partition with content, in column word order 
fillSkewPartitionWithColumnWord :: SkewPartition -> [a] -> SkewTableau a
fillSkewPartitionWithColumnWord :: SkewPartition -> [a] -> SkewTableau a
fillSkewPartitionWithColumnWord SkewPartition
shape [a]
content 
  = SkewTableau a -> SkewTableau a
forall a. SkewTableau a -> SkewTableau a
dualSkewTableau 
  (SkewTableau a -> SkewTableau a) -> SkewTableau a -> SkewTableau a
forall a b. (a -> b) -> a -> b
$ SkewPartition -> [a] -> SkewTableau a
forall a. SkewPartition -> [a] -> SkewTableau a
fillSkewPartitionWithRowWord (SkewPartition -> SkewPartition
dualSkewPartition SkewPartition
shape) [a]
content

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

-- | If the skew tableau's row word is a lattice word, we can make a partition from its content
skewTableauRowContent :: SkewTableau Int -> Maybe Partition
skewTableauRowContent :: SkewTableau Int -> Maybe Partition
skewTableauRowContent (SkewTableau [(Int, [Int])]
axs) = Map Int Int -> [Int] -> Maybe Partition
go Map Int Int
forall k a. Map k a
Map.empty [Int]
rowword where

  rowword :: [Int]
rowword = ((Int, [Int]) -> [Int]) -> [(Int, [Int])] -> [Int]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Int] -> [Int]
forall a. [a] -> [a]
reverse ([Int] -> [Int])
-> ((Int, [Int]) -> [Int]) -> (Int, [Int]) -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, [Int]) -> [Int]
forall a b. (a, b) -> b
snd) [(Int, [Int])]
axs

  finish :: Map k Int -> Partition
finish Map k Int
table = [Int] -> Partition
Partition (k -> [Int]
f k
1) where
    f :: k -> [Int]
f !k
i = case k -> Int
lkp k
i of
      Int
0 -> []
      Int
y -> Int
y Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: k -> [Int]
f (k
ik -> k -> k
forall a. Num a => a -> a -> a
+k
1) 
    lkp :: k -> Int
lkp k
j = case k -> Map k Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
j Map k Int
table of
      Just Int
k  -> Int
k
      Maybe Int
Nothing -> Int
0

  go :: Map Int Int -> [Int] -> Maybe Partition
  go :: Map Int Int -> [Int] -> Maybe Partition
go !Map Int Int
table []     = Partition -> Maybe Partition
forall a. a -> Maybe a
Just (Map Int Int -> Partition
forall k. (Ord k, Num k) => Map k Int -> Partition
finish Map Int Int
table)
  go !Map Int Int
table (Int
i:[Int]
is) =
    if Int -> Bool
check Int
i
      then Map Int Int -> [Int] -> Maybe Partition
go Map Int Int
table' [Int]
is
      else Maybe Partition
forall a. Maybe a
Nothing
    where
      table' :: Map Int Int
table'  = (Int -> Int -> Int) -> Int -> Int -> Map Int Int -> Map Int Int
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
i Int
1 Map Int Int
table
      check :: Int -> Bool
check Int
j = Int
jInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
1 Bool -> Bool -> Bool
|| Int -> Int
cnt (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int -> Int
cnt Int
j
      cnt :: Int -> Int
cnt Int
j   = case Int -> Map Int Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
j Map Int Int
table' of
        Just Int
k  -> Int
k
        Maybe Int
Nothing -> Int
0

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