```
-- | 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 :: Partition -> [(Int, Int)]
outerCorners = Partition -> [(Int, Int)]
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 -> [(Int, Int)]
extendedInnerCorners (Partition_ [Int]
ps) = (Int
0, [Int] -> Int
forall a. [a] -> a
ps') (Int, Int) -> [(Int, Int)] -> [(Int, Int)]
forall a. a -> [a] -> [a]
: [Maybe (Int, Int)] -> [(Int, Int)]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (Int, Int)]
mbCorners where
ps' :: [Int]
ps' = [Int]
ps [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
0]
mbCorners :: [Maybe (Int, Int)]
mbCorners = (Int -> Int -> Int -> Maybe (Int, Int))
-> [Int] -> [Int] -> [Int] -> [Maybe (Int, Int)]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 Int -> Int -> Int -> Maybe (Int, Int)
forall a a b. (Ord a, Num a) => a -> b -> a -> Maybe (a, b)
f [Int
1..] ([Int] -> [Int]
forall a. [a] -> [a]
tail [Int]
ps') ([Int] -> [Int]
_diffSequence [Int]
ps')
f :: a -> b -> a -> Maybe (a, b)
f !a
y !b
x !a
k = if a
k a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0 then (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
y,b
x) else Maybe (a, b)
forall a. Maybe a
Nothing

-- | Sequence of all the (extended) corners
extendedCornerSequence :: Partition -> [(Int,Int)]
extendedCornerSequence :: Partition -> [(Int, Int)]
extendedCornerSequence (Partition_ [Int]
ps) = {- if null ps then [(0,0)] else -} [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
forall a. [a] -> [a] -> [a]
interleave [(Int, Int)]
inner [(Int, Int)]
outer where
inner :: [(Int, Int)]
inner = (Int
0, [Int] -> Int
forall a. [a] -> a
ps') (Int, Int) -> [(Int, Int)] -> [(Int, Int)]
forall a. a -> [a] -> [a]
: [ (Int
y,Int
x) | (Int
y,Int
x,Int
k) <- [Int] -> [Int] -> [Int] -> [(Int, Int, Int)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int
1..] ([Int] -> [Int]
forall a. [a] -> [a]
tail [Int]
ps') [Int]
diff , Int
kInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0 ]
outer :: [(Int, Int)]
outer =                 [ (Int
y,Int
x) | (Int
y,Int
x,Int
k) <- [Int] -> [Int] -> [Int] -> [(Int, Int, Int)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int
1..] [Int]
ps'        [Int]
diff , Int
kInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0 ]
diff :: [Int]
diff = [Int] -> [Int]
_diffSequence [Int]
ps'
ps' :: [Int]
ps' = [Int]
ps [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
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 -> [(Int, Int)]
innerCornerBoxes (Partition_ [Int]
ps) =
case [Int]
ps of
[]  -> []
[Int]
_   -> [Maybe (Int, Int)] -> [(Int, Int)]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (Int, Int)]
mbCorners
where
mbCorners :: [Maybe (Int, Int)]
mbCorners = (Int -> Int -> Int -> Maybe (Int, Int))
-> [Int] -> [Int] -> [Int] -> [Maybe (Int, Int)]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 Int -> Int -> Int -> Maybe (Int, Int)
forall a a b. (Ord a, Num a) => a -> b -> a -> Maybe (a, b)
f [Int
1..] ([Int] -> [Int]
forall a. [a] -> [a]
tail [Int]
ps) ([Int] -> [Int]
_diffSequence [Int]
ps)
f :: a -> b -> a -> Maybe (a, b)
f !a
y !b
x !a
k = if a
k a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0 then (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
y,b
x) else Maybe (a, b)
forall a. Maybe a
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 -> [(Int, Int)]
outerCornerBoxes (Partition_ [Int]
ps) = [Maybe (Int, Int)] -> [(Int, Int)]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (Int, Int)]
mbCorners where
mbCorners :: [Maybe (Int, Int)]
mbCorners = (Int -> Int -> Int -> Maybe (Int, Int))
-> [Int] -> [Int] -> [Int] -> [Maybe (Int, Int)]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 Int -> Int -> Int -> Maybe (Int, Int)
forall a a b. (Ord a, Num a) => a -> b -> a -> Maybe (a, b)
f [Int
1..] [Int]
ps ([Int] -> [Int]
_diffSequence [Int]
ps)
f :: a -> b -> a -> Maybe (a, b)
f !a
y !b
x !a
k = if a
k a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0 then (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
y,b
x) else Maybe (a, b)
forall a. Maybe a
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 -> [(Int, Int)]
cornerBoxSequence (Partition_ [Int]
ps) = if [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
ps then [] else [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
forall a. [a] -> [a] -> [a]
interleave [(Int, Int)]
outer [(Int, Int)]
inner where
inner :: [(Int, Int)]
inner = [ (Int
y,Int
x) | (Int
y,Int
x,Int
k) <- [Int] -> [Int] -> [Int] -> [(Int, Int, Int)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int
1..] [Int]
tailps [Int]
diff , Int
kInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0 ]
outer :: [(Int, Int)]
outer = [ (Int
y,Int
x) | (Int
y,Int
x,Int
k) <- [Int] -> [Int] -> [Int] -> [(Int, Int, Int)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int
1..] [Int]
ps     [Int]
diff , Int
kInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0 ]
diff :: [Int]
diff = [Int] -> [Int]
_diffSequence [Int]
ps
tailps :: [Int]
tailps = case [Int]
ps of { [] -> [] ; [Int]
_-> [Int] -> [Int]
forall a. [a] -> [a]
tail [Int]
ps }

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

-- | Naive (and very slow) implementation of @innerCornerBoxes@, for testing purposes
innerCornerBoxesNaive :: Partition -> [(Int,Int)]
innerCornerBoxesNaive :: Partition -> [(Int, Int)]
innerCornerBoxesNaive Partition
part = ((Int, Int) -> Bool) -> [(Int, Int)] -> [(Int, Int)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int, Int) -> Bool
f [(Int, Int)]
boxes where
boxes :: [(Int, Int)]
boxes = Partition -> [(Int, Int)]
elements Partition
part
f :: (Int, Int) -> Bool
f (Int
y,Int
x) =       (Int, Int) -> [(Int, Int)] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1,Int
x  ) [(Int, Int)]
boxes
Bool -> Bool -> Bool
&&      (Int, Int) -> [(Int, Int)] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Int
y  ,Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [(Int, Int)]
boxes
Bool -> Bool -> Bool
&& Bool -> Bool
not ((Int, Int) -> [(Int, Int)] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1,Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [(Int, Int)]
boxes)

-- | Naive (and very slow) implementation of @outerCornerBoxes@, for testing purposes
outerCornerBoxesNaive :: Partition -> [(Int,Int)]
outerCornerBoxesNaive :: Partition -> [(Int, Int)]
outerCornerBoxesNaive Partition
part = ((Int, Int) -> Bool) -> [(Int, Int)] -> [(Int, Int)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int, Int) -> Bool
f [(Int, Int)]
boxes where
boxes :: [(Int, Int)]
boxes = Partition -> [(Int, Int)]
elements Partition
part
f :: (Int, Int) -> Bool
f (Int
y,Int
x) =  Bool -> Bool
not ((Int, Int) -> [(Int, Int)] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1,Int
x  ) [(Int, Int)]
boxes)
Bool -> Bool -> Bool
&& Bool -> Bool
not ((Int, Int) -> [(Int, Int)] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Int
y  ,Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [(Int, Int)]
boxes)
Bool -> Bool -> Bool
&& Bool -> Bool
not ((Int, Int) -> [(Int, Int)] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1,Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [(Int, Int)]
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 :: SkewPartition -> Bool
isRibbon SkewPartition
skewp = Maybe Int -> [(Int, Integer)] -> Bool
forall a a.
(Eq a, Eq a, Num a, Num a) =>
Maybe a -> [(a, a)] -> Bool
go Maybe Int
forall a. Maybe a
Nothing [(Int, Integer)]
proj where
proj :: [(Int, Integer)]
proj = Map Int Integer -> [(Int, Integer)]
forall k a. Map k a -> [(k, a)]
Map.toList
(Map Int Integer -> [(Int, Integer)])
-> Map Int Integer -> [(Int, Integer)]
forall a b. (a -> b) -> a -> b
\$ (Integer -> Integer -> Integer)
-> [(Int, Integer)] -> Map Int Integer
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+) [ (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
y , Integer
1) | (Int
y,Int
x) <- SkewPartition -> [(Int, Int)]
skewPartitionElements SkewPartition
skewp ]
go :: Maybe a -> [(a, a)] -> Bool
go Maybe a
Nothing   []            = Bool
False
go (Just a
_)  []            = Bool
True
go Maybe a
Nothing   ((a
a,a
h):[(a, a)]
rest)  = (a
h a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
1) Bool -> Bool -> Bool
&&               Maybe a -> [(a, a)] -> Bool
go (a -> Maybe a
forall a. a -> Maybe a
Just a
a) [(a, a)]
rest
go (Just a
b)  ((a
a,a
h):[(a, a)]
rest)  = (a
h a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
1) Bool -> Bool -> Bool
&& (a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
ba -> a -> a
forall a. Num a => a -> a -> a
+a
1) Bool -> Bool -> Bool
&& Maybe a -> [(a, a)] -> Bool
go (a -> Maybe a
forall a. a -> Maybe a
Just a
a) [(a, 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 :: SkewPartition -> Maybe Ribbon
toRibbon SkewPartition
skew =
if Bool -> Bool
not (SkewPartition -> Bool
isRibbon SkewPartition
skew)
then Maybe Ribbon
forall a. Maybe a
Nothing
else Ribbon -> Maybe Ribbon
forall a. a -> Maybe a
Just Ribbon
ribbon
where
ribbon :: Ribbon
ribbon =  Ribbon :: SkewPartition -> Int -> Int -> Int -> Ribbon
Ribbon
{ rbShape :: SkewPartition
rbShape  = SkewPartition
skew
, rbLength :: Int
rbLength = SkewPartition -> Int
skewPartitionWeight SkewPartition
skew
, rbHeight :: Int
rbHeight = Int
height
, rbWidth :: Int
rbWidth  = Int
width
}
elems :: [(Int, Int)]
elems  = SkewPartition -> [(Int, Int)]
skewPartitionElements SkewPartition
skew
height :: Int
height = ([[Int]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[Int]] -> Int) -> [[Int]] -> Int
forall a b. (a -> b) -> a -> b
\$ [Int] -> [[Int]]
forall a. Eq a => [a] -> [[a]]
group ([Int] -> [[Int]]) -> [Int] -> [[Int]]
forall a b. (a -> b) -> a -> b
\$ [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sort ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
\$ ((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Int
forall a b. (a, b) -> a
fst [(Int, Int)]
elems) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1    -- TODO: optimize these
width :: Int
width  = ([[Int]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[Int]] -> Int) -> [[Int]] -> Int
forall a b. (a -> b) -> a -> b
\$ [Int] -> [[Int]]
forall a. Eq a => [a] -> [[a]]
group ([Int] -> [[Int]]) -> [Int] -> [[Int]]
forall a b. (a -> b) -> a -> b
\$ [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sort ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
\$ ((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Int
forall a b. (a, b) -> b
snd [(Int, Int)]
elems) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
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
{ Ribbon -> SkewPartition
rbShape  :: SkewPartition
, Ribbon -> Int
rbLength :: Int
, Ribbon -> Int
rbHeight :: Int
, Ribbon -> Int
rbWidth  :: Int
}
deriving (Ribbon -> Ribbon -> Bool
(Ribbon -> Ribbon -> Bool)
-> (Ribbon -> Ribbon -> Bool) -> Eq Ribbon
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ribbon -> Ribbon -> Bool
\$c/= :: Ribbon -> Ribbon -> Bool
== :: Ribbon -> Ribbon -> Bool
\$c== :: Ribbon -> Ribbon -> Bool
Eq,Eq Ribbon
Eq Ribbon
-> (Ribbon -> Ribbon -> Ordering)
-> (Ribbon -> Ribbon -> Bool)
-> (Ribbon -> Ribbon -> Bool)
-> (Ribbon -> Ribbon -> Bool)
-> (Ribbon -> Ribbon -> Bool)
-> (Ribbon -> Ribbon -> Ribbon)
-> (Ribbon -> Ribbon -> Ribbon)
-> Ord Ribbon
Ribbon -> Ribbon -> Bool
Ribbon -> Ribbon -> Ordering
Ribbon -> Ribbon -> Ribbon
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 :: Ribbon -> Ribbon -> Ribbon
\$cmin :: Ribbon -> Ribbon -> Ribbon
max :: Ribbon -> Ribbon -> Ribbon
\$cmax :: Ribbon -> Ribbon -> Ribbon
>= :: Ribbon -> Ribbon -> Bool
\$c>= :: Ribbon -> Ribbon -> Bool
> :: Ribbon -> Ribbon -> Bool
\$c> :: Ribbon -> Ribbon -> Bool
<= :: Ribbon -> Ribbon -> Bool
\$c<= :: Ribbon -> Ribbon -> Bool
< :: Ribbon -> Ribbon -> Bool
\$c< :: Ribbon -> Ribbon -> Bool
compare :: Ribbon -> Ribbon -> Ordering
\$ccompare :: Ribbon -> Ribbon -> Ordering
\$cp1Ord :: Eq Ribbon
Ord,Int -> Ribbon -> ShowS
[Ribbon] -> ShowS
Ribbon -> String
(Int -> Ribbon -> ShowS)
-> (Ribbon -> String) -> ([Ribbon] -> ShowS) -> Show Ribbon
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ribbon] -> ShowS
\$cshowList :: [Ribbon] -> ShowS
show :: Ribbon -> String
\$cshow :: Ribbon -> String
showsPrec :: Int -> Ribbon -> ShowS
\$cshowsPrec :: Int -> Ribbon -> ShowS
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 :: Partition -> [Ribbon]
innerRibbons part :: Partition
part@(Partition [Int]
ps) = if [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
ps then [] else [Ribbon]
strips where

strips :: [Ribbon]
strips  = [ Int -> Int -> Ribbon
mkStrip Int
i Int
j
| Int
i<-[Int
1..Int
n] , BorderBox -> Bool
_canStartStrip (Array Int BorderBox
annArrArray Int BorderBox -> Int -> BorderBox
forall i e. Ix i => Array i e -> i -> e
!Int
i)
, Int
j<-[Int
i..Int
n] , BorderBox -> Bool
_canEndStrip   (Array Int BorderBox
annArrArray Int BorderBox -> Int -> BorderBox
forall i e. Ix i => Array i e -> i -> e
!Int
j)
]

n :: Int
n       = [BorderBox] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [BorderBox]
annList
annList :: [BorderBox]
annList = Partition -> [BorderBox]
annotatedInnerBorderStrip Partition
part
annArr :: Array Int BorderBox
annArr  = (Int, Int) -> [BorderBox] -> Array Int BorderBox
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
1,Int
n) [BorderBox]
annList

mkStrip :: Int -> Int -> Ribbon
mkStrip !Int
i1 !Int
i2 = SkewPartition -> Int -> Int -> Int -> Ribbon
Ribbon SkewPartition
shape Int
len Int
height Int
width where
ps' :: [Int]
ps'   = [Int]
ps [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
0]
shape :: SkewPartition
shape = [(Int, Int)] -> SkewPartition
SkewPartition [ (Int
pInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
k,Int
k) | (Int
i,Int
p,Int
q) <- [Int] -> [Int] -> [Int] -> [(Int, Int, Int)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int
1..] [Int]
ps ([Int] -> [Int]
forall a. [a] -> [a]
tail [Int]
ps') , let k :: Int
k = Int -> Int -> Int -> Int
indent Int
i Int
p Int
q ]
indent :: Int -> Int -> Int -> Int
indent !Int
i !Int
p !Int
q
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<  Int
y1    = Int
0
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>  Int
y2    = Int
0
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
y2    = Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1     -- the order is important here !!!
| Bool
otherwise  = Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
q  Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1     -- because of the case y1 == y2 == i

len :: Int
len    = Int
i2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
height :: Int
height = Int
y2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
y1
width :: Int
width  = Int
x1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x2
BorderBox Bool
_ Bool
_ Int
y1 Int
x1 = Array Int BorderBox
annArr Array Int BorderBox -> Int -> BorderBox
forall i e. Ix i => Array i e -> i -> e
! Int
i1
BorderBox Bool
_ Bool
_ Int
y2 Int
x2 = Array Int BorderBox
annArr Array Int BorderBox -> Int -> BorderBox
forall i e. Ix i => Array i e -> i -> e
! Int
i2

-- | Inner border strips (or ribbons) of the given length
innerRibbonsOfLength :: Partition -> Int -> [Ribbon]
innerRibbonsOfLength :: Partition -> Int -> [Ribbon]
innerRibbonsOfLength part :: Partition
part@(Partition [Int]
ps) Int
givenLength = if [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
ps then [] else [Ribbon]
strips where

strips :: [Ribbon]
strips  = [ Int -> Int -> Ribbon
mkStrip Int
i Int
j
| Int
i<-[Int
1..Int
n] , BorderBox -> Bool
_canStartStrip (Array Int BorderBox
annArrArray Int BorderBox -> Int -> BorderBox
forall i e. Ix i => Array i e -> i -> e
!Int
i)
, Int
j<-[Int
i..Int
n] , BorderBox -> Bool
_canEndStrip   (Array Int BorderBox
annArrArray Int BorderBox -> Int -> BorderBox
forall i e. Ix i => Array i e -> i -> e
!Int
j)
, Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
givenLength
]

n :: Int
n       = [BorderBox] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [BorderBox]
annList
annList :: [BorderBox]
annList = Partition -> [BorderBox]
annotatedInnerBorderStrip Partition
part
annArr :: Array Int BorderBox
annArr  = (Int, Int) -> [BorderBox] -> Array Int BorderBox
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
1,Int
n) [BorderBox]
annList

mkStrip :: Int -> Int -> Ribbon
mkStrip !Int
i1 !Int
i2 = SkewPartition -> Int -> Int -> Int -> Ribbon
Ribbon SkewPartition
shape Int
givenLength Int
height Int
width where
ps' :: [Int]
ps'   = [Int]
ps [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
0]
shape :: SkewPartition
shape = [(Int, Int)] -> SkewPartition
SkewPartition [ (Int
pInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
k,Int
k) | (Int
i,Int
p,Int
q) <- [Int] -> [Int] -> [Int] -> [(Int, Int, Int)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int
1..] [Int]
ps ([Int] -> [Int]
forall a. [a] -> [a]
tail [Int]
ps') , let k :: Int
k = Int -> Int -> Int -> Int
indent Int
i Int
p Int
q ]
indent :: Int -> Int -> Int -> Int
indent !Int
i !Int
p !Int
q
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<  Int
y1    = Int
0
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>  Int
y2    = Int
0
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
y2    = Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1     -- the order is important here !!!
| Bool
otherwise  = Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
q  Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1     -- because of the case y1 == y2 == i

height :: Int
height = Int
y2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
y1
width :: Int
width  = Int
x1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x2
BorderBox Bool
_ Bool
_ Int
y1 Int
x1 = Array Int BorderBox
annArr Array Int BorderBox -> Int -> BorderBox
forall i e. Ix i => Array i e -> i -> e
! Int
i1
BorderBox Bool
_ Bool
_ Int
y2 Int
x2 = Array Int BorderBox
annArr Array Int BorderBox -> Int -> BorderBox
forall i e. Ix i => Array i e -> i -> e
! Int
i2

--------------------------------------------------------------------------------
-- * Outer border strips

-- | Hooks of length @n@ (TODO: move to the partition module)
listHooks :: Int -> [Partition]
listHooks :: Int -> [Partition]
listHooks Int
0 = []
listHooks Int
1 = [ [Int] -> Partition
Partition [Int
1] ]
listHooks Int
n = [ [Int] -> Partition
Partition (Int
k Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
k) Int
1) | Int
k<-[Int
1..Int
n] ]

-- | Outer border strips (or ribbons) of the given length
outerRibbonsOfLength :: Partition -> Int -> [Ribbon]
outerRibbonsOfLength :: Partition -> Int -> [Ribbon]
outerRibbonsOfLength part :: Partition
part@(Partition [Int]
ps) Int
givenLength = [Ribbon]
result where

result :: [Ribbon]
result = if [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
ps
then [ SkewPartition -> Int -> Int -> Int -> Ribbon
Ribbon SkewPartition
shape Int
givenLength Int
ht Int
wd
| Partition
p <- Int -> [Partition]
listHooks Int
givenLength
, let shape :: SkewPartition
shape = (Partition, Partition) -> SkewPartition
mkSkewPartition (Partition
p,Partition
part)
, let ht :: Int
ht = Partition -> Int
partitionWidth  Partition
p Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1        -- pretty inconsistent names here :(((
, let wd :: Int
wd = Partition -> Int
partitionHeight Partition
p Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
]
else [Ribbon]
strips

strips :: [Ribbon]
strips  = [ Int -> Int -> Ribbon
mkStrip Int
i Int
j
| Int
i<-[Int
1..Int
n] , BorderBox -> Bool
_canStartStrip (Array Int BorderBox
annArrArray Int BorderBox -> Int -> BorderBox
forall i e. Ix i => Array i e -> i -> e
!Int
i)
, Int
j<-[Int
i..Int
n] , BorderBox -> Bool
_canEndStrip   (Array Int BorderBox
annArrArray Int BorderBox -> Int -> BorderBox
forall i e. Ix i => Array i e -> i -> e
!Int
j)
, Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
givenLength
]

ysize :: Int
ysize = Partition -> Int
partitionWidth  Partition
part
xsize :: Int
xsize = Partition -> Int
partitionHeight Partition
part

annList :: [BorderBox]
annList  =  [ Bool -> Bool -> Int -> Int -> BorderBox
BorderBox Bool
True Bool
False Int
1 Int
x | Int
x <- [Int] -> [Int]
forall a. [a] -> [a]
reverse [Int
xsizeInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2 .. Int
xsizeInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
givenLength ] ]
[BorderBox] -> [BorderBox] -> [BorderBox]
forall a. [a] -> [a] -> [a]
++ [BorderBox]
annList0
[BorderBox] -> [BorderBox] -> [BorderBox]
forall a. [a] -> [a] -> [a]
++ [ Bool -> Bool -> Int -> Int -> BorderBox
BorderBox Bool
False Bool
True Int
y Int
1 | Int
y <-         [Int
ysizeInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2 .. Int
ysizeInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
givenLength ] ]

n :: Int
n        = [BorderBox] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [BorderBox]
annList
annList0 :: [BorderBox]
annList0 = Partition -> [BorderBox]
annotatedOuterBorderStrip Partition
part
annArr :: Array Int BorderBox
annArr   = (Int, Int) -> [BorderBox] -> Array Int BorderBox
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
1,Int
n) [BorderBox]
annList

mkStrip :: Int -> Int -> Ribbon
mkStrip !Int
i1 !Int
i2 = SkewPartition -> Int -> Int -> Int -> Ribbon
Ribbon SkewPartition
shape Int
len Int
height Int
width where
ps' :: [Int]
ps'   = (-Int
666) Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
ps [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate (Int
givenLength) Int
0
shape :: SkewPartition
shape = [(Int, Int)] -> SkewPartition
SkewPartition [ (Int
p,Int
k) | (Int
i,Int
p,Int
q) <- [Int] -> [Int] -> [Int] -> [(Int, Int, Int)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int
1..Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
ysize Int
y2] ([Int] -> [Int]
forall a. [a] -> [a]
tail [Int]
ps') [Int]
ps' , let k :: Int
k = Int -> Int -> Int -> Int
indent Int
i Int
p Int
q ]
indent :: Int -> Int -> Int -> Int
indent !Int
i !Int
p !Int
q
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<  Int
y1    = Int
0
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>  Int
y2    = Int
0
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
y1    = Int
x1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
p    -- the order is important here !!!
--      | i == y2    = x2 - p
| Bool
otherwise  = Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
p  Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

len :: Int
len    = Int
i2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
height :: Int
height = Int
y2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
y1
width :: Int
width  = Int
x1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x2
BorderBox Bool
_ Bool
_ Int
y1 Int
x1 = Array Int BorderBox
annArr Array Int BorderBox -> Int -> BorderBox
forall i e. Ix i => Array i e -> i -> e
! Int
i1
BorderBox Bool
_ Bool
_ Int
y2 Int
x2 = Array Int BorderBox
annArr Array Int BorderBox -> Int -> BorderBox
forall i e. Ix i => Array i e -> i -> e
! Int
i2

--------------------------------------------------------------------------------
-- * Naive implementations (for testing)

-- | Naive (and slow) implementation listing all inner border strips
innerRibbonsNaive :: Partition -> [Ribbon]
innerRibbonsNaive :: Partition -> [Ribbon]
innerRibbonsNaive Partition
outer = [Ribbon]
list where
list :: [Ribbon]
list = [ SkewPartition -> Int -> Int -> Int -> Ribbon
Ribbon SkewPartition
skew (SkewPartition -> Int
len SkewPartition
skew) (SkewPartition -> Int
ht SkewPartition
skew) (SkewPartition -> Int
wt SkewPartition
skew)
| SkewPartition
skew <- Partition -> [SkewPartition]
allSkewPartitionsWithOuterShape Partition
outer
, SkewPartition -> Bool
isRibbon SkewPartition
skew
]
len :: SkewPartition -> Int
len SkewPartition
skew = [(Int, Int)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (SkewPartition -> [(Int, Int)]
skewPartitionElements SkewPartition
skew)
ht :: SkewPartition -> Int
ht  SkewPartition
skew = ([[Int]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[Int]] -> Int) -> [[Int]] -> Int
forall a b. (a -> b) -> a -> b
\$ [Int] -> [[Int]]
forall a. Eq a => [a] -> [[a]]
group ([Int] -> [[Int]]) -> [Int] -> [[Int]]
forall a b. (a -> b) -> a -> b
\$ [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sort ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
\$ ((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Int
forall a b. (a, b) -> a
fst ([(Int, Int)] -> [Int]) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> a -> b
\$ SkewPartition -> [(Int, Int)]
skewPartitionElements SkewPartition
skew) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
wt :: SkewPartition -> Int
wt  SkewPartition
skew = ([[Int]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[Int]] -> Int) -> [[Int]] -> Int
forall a b. (a -> b) -> a -> b
\$ [Int] -> [[Int]]
forall a. Eq a => [a] -> [[a]]
group ([Int] -> [[Int]]) -> [Int] -> [[Int]]
forall a b. (a -> b) -> a -> b
\$ [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sort ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
\$ ((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Int
forall a b. (a, b) -> b
snd ([(Int, Int)] -> [Int]) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> a -> b
\$ SkewPartition -> [(Int, Int)]
skewPartitionElements SkewPartition
skew) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

-- | Naive (and slow) implementation listing all inner border strips of the given length
innerRibbonsOfLengthNaive :: Partition -> Int -> [Ribbon]
innerRibbonsOfLengthNaive :: Partition -> Int -> [Ribbon]
innerRibbonsOfLengthNaive Partition
outer Int
givenLength = [Ribbon]
list where
pweight :: Int
pweight = Partition -> Int
partitionWeight Partition
outer
list :: [Ribbon]
list = [ SkewPartition -> Int -> Int -> Int -> Ribbon
Ribbon SkewPartition
skew (SkewPartition -> Int
len SkewPartition
skew) (SkewPartition -> Int
ht SkewPartition
skew) (SkewPartition -> Int
wt SkewPartition
skew)
| SkewPartition
skew <- Partition -> Int -> [SkewPartition]
skewPartitionsWithOuterShape Partition
outer Int
givenLength
, SkewPartition -> Bool
isRibbon SkewPartition
skew
]
len :: SkewPartition -> Int
len SkewPartition
skew = [(Int, Int)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (SkewPartition -> [(Int, Int)]
skewPartitionElements SkewPartition
skew)
ht :: SkewPartition -> Int
ht  SkewPartition
skew = ([[Int]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[Int]] -> Int) -> [[Int]] -> Int
forall a b. (a -> b) -> a -> b
\$ [Int] -> [[Int]]
forall a. Eq a => [a] -> [[a]]
group ([Int] -> [[Int]]) -> [Int] -> [[Int]]
forall a b. (a -> b) -> a -> b
\$ [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sort ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
\$ ((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Int
forall a b. (a, b) -> a
fst ([(Int, Int)] -> [Int]) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> a -> b
\$ SkewPartition -> [(Int, Int)]
skewPartitionElements SkewPartition
skew) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
wt :: SkewPartition -> Int
wt  SkewPartition
skew = ([[Int]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[Int]] -> Int) -> [[Int]] -> Int
forall a b. (a -> b) -> a -> b
\$ [Int] -> [[Int]]
forall a. Eq a => [a] -> [[a]]
group ([Int] -> [[Int]]) -> [Int] -> [[Int]]
forall a b. (a -> b) -> a -> b
\$ [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sort ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
\$ ((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Int
forall a b. (a, b) -> b
snd ([(Int, Int)] -> [Int]) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> a -> b
\$ SkewPartition -> [(Int, Int)]
skewPartitionElements SkewPartition
skew) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

-- | Naive (and slow) implementation listing all outer border strips of the given length
outerRibbonsOfLengthNaive :: Partition -> Int -> [Ribbon]
outerRibbonsOfLengthNaive :: Partition -> Int -> [Ribbon]
outerRibbonsOfLengthNaive Partition
inner Int
givenLength = [Ribbon]
list where
pweight :: Int
pweight = Partition -> Int
partitionWeight Partition
inner
list :: [Ribbon]
list = [ SkewPartition -> Int -> Int -> Int -> Ribbon
Ribbon SkewPartition
skew (SkewPartition -> Int
len SkewPartition
skew) (SkewPartition -> Int
ht SkewPartition
skew) (SkewPartition -> Int
wt SkewPartition
skew)
| SkewPartition
skew <- Partition -> Int -> [SkewPartition]
skewPartitionsWithInnerShape Partition
inner Int
givenLength
, SkewPartition -> Bool
isRibbon SkewPartition
skew
]
len :: SkewPartition -> Int
len SkewPartition
skew = [(Int, Int)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (SkewPartition -> [(Int, Int)]
skewPartitionElements SkewPartition
skew)
ht :: SkewPartition -> Int
ht  SkewPartition
skew = ([[Int]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[Int]] -> Int) -> [[Int]] -> Int
forall a b. (a -> b) -> a -> b
\$ [Int] -> [[Int]]
forall a. Eq a => [a] -> [[a]]
group ([Int] -> [[Int]]) -> [Int] -> [[Int]]
forall a b. (a -> b) -> a -> b
\$ [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sort ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
\$ ((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Int
forall a b. (a, b) -> a
fst ([(Int, Int)] -> [Int]) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> a -> b
\$ SkewPartition -> [(Int, Int)]
skewPartitionElements SkewPartition
skew) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
wt :: SkewPartition -> Int
wt  SkewPartition
skew = ([[Int]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[Int]] -> Int) -> [[Int]] -> Int
forall a b. (a -> b) -> a -> b
\$ [Int] -> [[Int]]
forall a. Eq a => [a] -> [[a]]
group ([Int] -> [[Int]]) -> [Int] -> [[Int]]
forall a b. (a -> b) -> a -> b
\$ [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sort ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
\$ ((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Int
forall a b. (a, b) -> b
snd ([(Int, Int)] -> [Int]) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> a -> b
\$ SkewPartition -> [(Int, Int)]
skewPartitionElements SkewPartition
skew) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

--------------------------------------------------------------------------------
-- * Annotated borders

-- | A box on the border of a partition
data BorderBox = BorderBox
{ BorderBox -> Bool
_canStartStrip :: !Bool
, BorderBox -> Bool
_canEndStrip   :: !Bool
, BorderBox -> Int
_yCoord :: !Int
, BorderBox -> Int
_xCoord :: !Int
}
deriving Int -> BorderBox -> ShowS
[BorderBox] -> ShowS
BorderBox -> String
(Int -> BorderBox -> ShowS)
-> (BorderBox -> String)
-> ([BorderBox] -> ShowS)
-> Show BorderBox
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BorderBox] -> ShowS
\$cshowList :: [BorderBox] -> ShowS
show :: BorderBox -> String
\$cshow :: BorderBox -> String
showsPrec :: Int -> BorderBox -> ShowS
\$cshowsPrec :: Int -> BorderBox -> ShowS
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 -> [BorderBox]
annotatedInnerBorderStrip Partition
partition = if Partition -> Bool
isEmptyPartition Partition
partition then [] else [BorderBox]
list where
list :: [BorderBox]
list    = (Int, Int) -> [(Int, Int)] -> [BorderBox]
goVert ([(Int, Int)] -> (Int, Int)
forall a. [a] -> a
corners) ([(Int, Int)] -> [(Int, Int)]
forall a. [a] -> [a]
tail [(Int, Int)]
corners)
corners :: [(Int, Int)]
corners = Partition -> [(Int, Int)]
extendedCornerSequence Partition
partition

goVert :: (Int, Int) -> [(Int, Int)] -> [BorderBox]
goVert  (Int
y1,Int
x ) ((Int
y2,Int
_ ):[(Int, Int)]
rest) = [ Bool -> Bool -> Int -> Int -> BorderBox
BorderBox Bool
True (Int
yInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
y2) Int
y Int
x | Int
y<-[Int
y1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1..Int
y2] ] [BorderBox] -> [BorderBox] -> [BorderBox]
forall a. [a] -> [a] -> [a]
++ (Int, Int) -> [(Int, Int)] -> [BorderBox]
goHoriz (Int
y2,Int
x) [(Int, Int)]
rest
goVert  (Int, Int)
_       []             = []

goHoriz :: (Int, Int) -> [(Int, Int)] -> [BorderBox]
goHoriz (Int
y ,Int
x1) ((Int
_, Int
x2):[(Int, Int)]
rest) = case [(Int, Int)]
rest of
[] -> [ Bool -> Bool -> Int -> Int -> BorderBox
BorderBox Bool
False Bool
True    Int
y Int
x | Int
x<-[Int
x1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1,Int
x1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2..Int
x2Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1] ]
[(Int, Int)]
_  -> [ Bool -> Bool -> Int -> Int -> BorderBox
BorderBox Bool
False (Int
xInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/=Int
x2) Int
y Int
x | Int
x<-[Int
x1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1,Int
x1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2..Int
x2  ] ] [BorderBox] -> [BorderBox] -> [BorderBox]
forall a. [a] -> [a] -> [a]
++ (Int, Int) -> [(Int, Int)] -> [BorderBox]
goVert (Int
y,Int
x2) [(Int, Int)]
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 -> [BorderBox]
annotatedOuterBorderStrip Partition
partition = if Partition -> Bool
isEmptyPartition Partition
partition then [] else [BorderBox]
list where
list :: [BorderBox]
list    = (Int, Int) -> [(Int, Int)] -> [BorderBox]
goVert ([(Int, Int)] -> (Int, Int)
forall a. [a] -> a
corners) ([(Int, Int)] -> [(Int, Int)]
forall a. [a] -> [a]
tail [(Int, Int)]
corners)
corners :: [(Int, Int)]
corners = Partition -> [(Int, Int)]
extendedCornerSequence Partition
partition

goVert :: (Int, Int) -> [(Int, Int)] -> [BorderBox]
goVert  (Int
y1,Int
x ) ((Int
y2,Int
_ ):[(Int, Int)]
rest) = [ Bool -> Bool -> Int -> Int -> BorderBox
BorderBox (Int
yInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
y1) (Int
yInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/=Int
y2) (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) | Int
y<-[Int
y1..Int
y2] ] [BorderBox] -> [BorderBox] -> [BorderBox]
forall a. [a] -> [a] -> [a]
++ (Int, Int) -> [(Int, Int)] -> [BorderBox]
goHoriz (Int
y2,Int
x) [(Int, Int)]
rest
goVert  (Int, Int)
_       []             = []

goHoriz :: (Int, Int) -> [(Int, Int)] -> [BorderBox]
goHoriz (Int
y ,Int
x1) ((Int
_, Int
x2):[(Int, Int)]
rest) = case [(Int, Int)]
rest of
[] -> [ Bool -> Bool -> Int -> Int -> BorderBox
BorderBox Bool
True (Int
xInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0) (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) | Int
x<-[Int
x1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1,Int
x1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2..Int
x2  ] ]
[(Int, Int)]
_  -> [ Bool -> Bool -> Int -> Int -> BorderBox
BorderBox Bool
True Bool
False  (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) | Int
x<-[Int
x1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1,Int
x1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2..Int
x2Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1] ] [BorderBox] -> [BorderBox] -> [BorderBox]
forall a. [a] -> [a] -> [a]
++ (Int, Int) -> [(Int, Int)] -> [BorderBox]
goVert (Int
y,Int
x2) [(Int, Int)]
rest

--------------------------------------------------------------------------------
```