combinat-0.2.9.0: Math/Combinat/Partitions/Skew/Ribbon.hs
-- | Ribbons (also called border strips, skew hooks, skew rim hooks, etc...).
--
-- Ribbons are skew partitions that are 1) connected, 2) do not contain
-- 2x2 blocks. Intuitively, they are 1-box wide continuous strips on
-- the boundary.
--
-- An alternative definition that they are skew partitions whose projection
-- to the diagonal line is a continuous segment of width 1.
{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}
module Math.Combinat.Partitions.Skew.Ribbon where
--------------------------------------------------------------------------------
import Data.Array
import Data.List
import Data.Maybe
import qualified Data.Map as Map
import Math.Combinat.Sets
import Math.Combinat.Partitions.Integer
import Math.Combinat.Partitions.Integer.IntList ( _diffSequence )
import Math.Combinat.Partitions.Skew
import Math.Combinat.Tableaux
import Math.Combinat.Tableaux.LittlewoodRichardson
import Math.Combinat.Tableaux.GelfandTsetlin
import Math.Combinat.Helper
--------------------------------------------------------------------------------
-- * Corners (TODO: move to Partitions - but we also want to refactor that)
-- | The coordinates of the outer corners
outerCorners :: Partition -> [(Int,Int)]
outerCorners = outerCornerBoxes
-- | The coordinates of the inner corners, including the two on the two coordinate
-- axes. For the partition @[5,4,1]@ the result should be @[(0,5),(1,4),(2,1),(3,0)]@
extendedInnerCorners:: Partition -> [(Int,Int)]
extendedInnerCorners (Partition_ ps) = (0, head ps') : catMaybes mbCorners where
ps' = ps ++ [0]
mbCorners = zipWith3 f [1..] (tail ps') (_diffSequence ps')
f !y !x !k = if k > 0 then Just (y,x) else Nothing
-- | Sequence of all the (extended) corners
extendedCornerSequence :: Partition -> [(Int,Int)]
extendedCornerSequence (Partition_ ps) = {- if null ps then [(0,0)] else -} interleave inner outer where
inner = (0, head ps') : [ (y,x) | (y,x,k) <- zip3 [1..] (tail ps') diff , k>0 ]
outer = [ (y,x) | (y,x,k) <- zip3 [1..] ps' diff , k>0 ]
diff = _diffSequence ps'
ps' = ps ++ [0]
-- | The inner corner /boxes/ of the partition. Coordinates are counted from 1
-- (cf.the 'elements' function), and the first coordinate is the row, the second
-- the column (in English notation).
--
-- For the partition @[5,4,1]@ the result should be @[(1,4),(2,1)]@
--
-- > innerCornerBoxes lambda == (tail $ init $ extendedInnerCorners lambda)
--
innerCornerBoxes :: Partition -> [(Int,Int)]
innerCornerBoxes (Partition_ ps) =
case ps of
[] -> []
_ -> catMaybes mbCorners
where
mbCorners = zipWith3 f [1..] (tail ps) (_diffSequence ps)
f !y !x !k = if k > 0 then Just (y,x) else Nothing
-- | The outer corner /boxes/ of the partition. Coordinates are counted from 1
-- (cf.the 'elements' function), and the first coordinate is the row, the second
-- the column (in English notation).
--
-- For the partition @[5,4,1]@ the result should be @[(1,5),(2,4),(3,1)]@
outerCornerBoxes :: Partition -> [(Int,Int)]
outerCornerBoxes (Partition_ ps) = catMaybes mbCorners where
mbCorners = zipWith3 f [1..] ps (_diffSequence ps)
f !y !x !k = if k > 0 then Just (y,x) else Nothing
-- | The outer and inner corner boxes interleaved, so together they form
-- the turning points of the full border strip
cornerBoxSequence :: Partition -> [(Int,Int)]
cornerBoxSequence (Partition_ ps) = if null ps then [] else interleave outer inner where
inner = [ (y,x) | (y,x,k) <- zip3 [1..] tailps diff , k>0 ]
outer = [ (y,x) | (y,x,k) <- zip3 [1..] ps diff , k>0 ]
diff = _diffSequence ps
tailps = case ps of { [] -> [] ; _-> tail ps }
--------------------------------------------------------------------------------
-- | Naive (and very slow) implementation of @innerCornerBoxes@, for testing purposes
innerCornerBoxesNaive :: Partition -> [(Int,Int)]
innerCornerBoxesNaive part = filter f boxes where
boxes = elements part
f (y,x) = elem (y+1,x ) boxes
&& elem (y ,x+1) boxes
&& not (elem (y+1,x+1) boxes)
-- | Naive (and very slow) implementation of @outerCornerBoxes@, for testing purposes
outerCornerBoxesNaive :: Partition -> [(Int,Int)]
outerCornerBoxesNaive part = filter f boxes where
boxes = elements part
f (y,x) = not (elem (y+1,x ) boxes)
&& not (elem (y ,x+1) boxes)
&& not (elem (y+1,x+1) boxes)
--------------------------------------------------------------------------------
-- * Ribbon
-- | A skew partition is a a ribbon (or border strip) if and only if projected
-- to the diagonals the result is an interval.
isRibbon :: SkewPartition -> Bool
isRibbon skewp = go Nothing proj where
proj = Map.toList
$ Map.fromListWith (+) [ (x-y , 1) | (y,x) <- skewPartitionElements skewp ]
go Nothing [] = False
go (Just _) [] = True
go Nothing ((a,h):rest) = (h == 1) && go (Just a) rest
go (Just b) ((a,h):rest) = (h == 1) && (a == b+1) && go (Just a) rest
{-
-- | Naive (and slow) reference implementation of "isRibbon"
isRibbonNaive :: SkewPartition -> Bool
isRibbonNaive skewp = isConnectedSkewPartition skewp && no2x2 where
boxes = skewPartitionElements skewp
no2x2 = and
[ not ( elem (y+1,x ) boxes &&
elem (y ,x+1) boxes &&
elem (y+1,x+1) boxes ) -- no 2x2 blocks
| (y,x) <- boxes
]
-}
toRibbon :: SkewPartition -> Maybe Ribbon
toRibbon skew =
if not (isRibbon skew)
then Nothing
else Just ribbon
where
ribbon = Ribbon
{ rbShape = skew
, rbLength = skewPartitionWeight skew
, rbHeight = height
, rbWidth = width
}
elems = skewPartitionElements skew
height = (length $ group $ sort $ map fst elems) - 1 -- TODO: optimize these
width = (length $ group $ sort $ map snd elems) - 1
-- | Border strips (or ribbons) are defined to be skew partitions which are
-- connected and do not contain 2x2 blocks.
--
-- The /length/ of a border strip is the number of boxes it contains,
-- and its /height/ is defined to be one less than the number of rows
-- (in English notation) it occupies. The /width/ is defined symmetrically to
-- be one less than the number of columns it occupies.
--
data Ribbon = Ribbon
{ rbShape :: SkewPartition
, rbLength :: Int
, rbHeight :: Int
, rbWidth :: Int
}
deriving (Eq,Ord,Show)
--------------------------------------------------------------------------------
-- * Inner border strips
-- | Ribbons (or border strips) are defined to be skew partitions which are
-- connected and do not contain 2x2 blocks. This function returns the
-- border strips whose outer partition is the given one.
innerRibbons :: Partition -> [Ribbon]
innerRibbons part@(Partition ps) = if null ps then [] else strips where
strips = [ mkStrip i j
| i<-[1..n] , _canStartStrip (annArr!i)
, j<-[i..n] , _canEndStrip (annArr!j)
]
n = length annList
annList = annotatedInnerBorderStrip part
annArr = listArray (1,n) annList
mkStrip !i1 !i2 = Ribbon shape len height width where
ps' = ps ++ [0]
shape = SkewPartition [ (p-k,k) | (i,p,q) <- zip3 [1..] ps (tail ps') , let k = indent i p q ]
indent !i !p !q
| i < y1 = 0
| i > y2 = 0
| i == y2 = p - x2 + 1 -- the order is important here !!!
| otherwise = p - q + 1 -- because of the case y1 == y2 == i
len = i2 - i1 + 1
height = y2 - y1
width = x1 - x2
BorderBox _ _ y1 x1 = annArr ! i1
BorderBox _ _ y2 x2 = annArr ! i2
-- | Inner border strips (or ribbons) of the given length
innerRibbonsOfLength :: Partition -> Int -> [Ribbon]
innerRibbonsOfLength part@(Partition ps) givenLength = if null ps then [] else strips where
strips = [ mkStrip i j
| i<-[1..n] , _canStartStrip (annArr!i)
, j<-[i..n] , _canEndStrip (annArr!j)
, j-i+1 == givenLength
]
n = length annList
annList = annotatedInnerBorderStrip part
annArr = listArray (1,n) annList
mkStrip !i1 !i2 = Ribbon shape givenLength height width where
ps' = ps ++ [0]
shape = SkewPartition [ (p-k,k) | (i,p,q) <- zip3 [1..] ps (tail ps') , let k = indent i p q ]
indent !i !p !q
| i < y1 = 0
| i > y2 = 0
| i == y2 = p - x2 + 1 -- the order is important here !!!
| otherwise = p - q + 1 -- because of the case y1 == y2 == i
height = y2 - y1
width = x1 - x2
BorderBox _ _ y1 x1 = annArr ! i1
BorderBox _ _ y2 x2 = annArr ! i2
--------------------------------------------------------------------------------
-- * Outer border strips
-- | Hooks of length @n@ (TODO: move to the partition module)
listHooks :: Int -> [Partition]
listHooks 0 = []
listHooks 1 = [ Partition [1] ]
listHooks n = [ Partition (k : replicate (n-k) 1) | k<-[1..n] ]
-- | Outer border strips (or ribbons) of the given length
outerRibbonsOfLength :: Partition -> Int -> [Ribbon]
outerRibbonsOfLength part@(Partition ps) givenLength = result where
result = if null ps
then [ Ribbon shape givenLength ht wd
| p <- listHooks givenLength
, let shape = mkSkewPartition (p,part)
, let ht = partitionWidth p - 1 -- pretty inconsistent names here :(((
, let wd = partitionHeight p - 1
]
else strips
strips = [ mkStrip i j
| i<-[1..n] , _canStartStrip (annArr!i)
, j<-[i..n] , _canEndStrip (annArr!j)
, j-i+1 == givenLength
]
ysize = partitionWidth part
xsize = partitionHeight part
annList = [ BorderBox True False 1 x | x <- reverse [xsize+2 .. xsize+givenLength ] ]
++ annList0
++ [ BorderBox False True y 1 | y <- [ysize+2 .. ysize+givenLength ] ]
n = length annList
annList0 = annotatedOuterBorderStrip part
annArr = listArray (1,n) annList
mkStrip !i1 !i2 = Ribbon shape len height width where
ps' = (-666) : ps ++ replicate (givenLength) 0
shape = SkewPartition [ (p,k) | (i,p,q) <- zip3 [1..max ysize y2] (tail ps') ps' , let k = indent i p q ]
indent !i !p !q
| i < y1 = 0
| i > y2 = 0
| i == y1 = x1 - p -- the order is important here !!!
-- | i == y2 = x2 - p
| otherwise = q - p + 1
len = i2 - i1 + 1
height = y2 - y1
width = x1 - x2
BorderBox _ _ y1 x1 = annArr ! i1
BorderBox _ _ y2 x2 = annArr ! i2
--------------------------------------------------------------------------------
-- * Naive implementations (for testing)
-- | Naive (and slow) implementation listing all inner border strips
innerRibbonsNaive :: Partition -> [Ribbon]
innerRibbonsNaive outer = list where
list = [ Ribbon skew (len skew) (ht skew) (wt skew)
| skew <- allSkewPartitionsWithOuterShape outer
, isRibbon skew
]
len skew = length (skewPartitionElements skew)
ht skew = (length $ group $ sort $ map fst $ skewPartitionElements skew) - 1
wt skew = (length $ group $ sort $ map snd $ skewPartitionElements skew) - 1
-- | Naive (and slow) implementation listing all inner border strips of the given length
innerRibbonsOfLengthNaive :: Partition -> Int -> [Ribbon]
innerRibbonsOfLengthNaive outer givenLength = list where
pweight = partitionWeight outer
list = [ Ribbon skew (len skew) (ht skew) (wt skew)
| skew <- skewPartitionsWithOuterShape outer givenLength
, isRibbon skew
]
len skew = length (skewPartitionElements skew)
ht skew = (length $ group $ sort $ map fst $ skewPartitionElements skew) - 1
wt skew = (length $ group $ sort $ map snd $ skewPartitionElements skew) - 1
-- | Naive (and slow) implementation listing all outer border strips of the given length
outerRibbonsOfLengthNaive :: Partition -> Int -> [Ribbon]
outerRibbonsOfLengthNaive inner givenLength = list where
pweight = partitionWeight inner
list = [ Ribbon skew (len skew) (ht skew) (wt skew)
| skew <- skewPartitionsWithInnerShape inner givenLength
, isRibbon skew
]
len skew = length (skewPartitionElements skew)
ht skew = (length $ group $ sort $ map fst $ skewPartitionElements skew) - 1
wt skew = (length $ group $ sort $ map snd $ skewPartitionElements skew) - 1
--------------------------------------------------------------------------------
-- * Annotated borders
-- | A box on the border of a partition
data BorderBox = BorderBox
{ _canStartStrip :: !Bool
, _canEndStrip :: !Bool
, _yCoord :: !Int
, _xCoord :: !Int
}
deriving Show
-- | The boxes of the full inner border strip, annotated with whether a border strip
-- can start or end there.
annotatedInnerBorderStrip :: Partition -> [BorderBox]
annotatedInnerBorderStrip partition = if isEmptyPartition partition then [] else list where
list = goVert (head corners) (tail corners)
corners = extendedCornerSequence partition
goVert (y1,x ) ((y2,_ ):rest) = [ BorderBox True (y==y2) y x | y<-[y1+1..y2] ] ++ goHoriz (y2,x) rest
goVert _ [] = []
goHoriz (y ,x1) ((_, x2):rest) = case rest of
[] -> [ BorderBox False True y x | x<-[x1-1,x1-2..x2+1] ]
_ -> [ BorderBox False (x/=x2) y x | x<-[x1-1,x1-2..x2 ] ] ++ goVert (y,x2) rest
-- | The boxes of the full outer border strip, annotated with whether a border strip
-- can start or end there.
annotatedOuterBorderStrip :: Partition -> [BorderBox]
annotatedOuterBorderStrip partition = if isEmptyPartition partition then [] else list where
list = goVert (head corners) (tail corners)
corners = extendedCornerSequence partition
goVert (y1,x ) ((y2,_ ):rest) = [ BorderBox (y==y1) (y/=y2) (y+1) (x+1) | y<-[y1..y2] ] ++ goHoriz (y2,x) rest
goVert _ [] = []
goHoriz (y ,x1) ((_, x2):rest) = case rest of
[] -> [ BorderBox True (x==0) (y+1) (x+1) | x<-[x1-1,x1-2..x2 ] ]
_ -> [ BorderBox True False (y+1) (x+1) | x<-[x1-1,x1-2..x2+1] ] ++ goVert (y,x2) rest
--------------------------------------------------------------------------------