{-# 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
outerCorners :: Partition -> [(Int,Int)]
outerCorners :: Partition -> [(Int, Int)]
outerCorners = Partition -> [(Int, Int)]
outerCornerBoxes
extendedInnerCorners:: Partition -> [(Int,Int)]
extendedInnerCorners :: Partition -> [(Int, Int)]
extendedInnerCorners (Partition_ [Int]
ps) = (Int
0, [Int] -> Int
forall a. [a] -> a
head [Int]
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
extendedCornerSequence :: Partition -> [(Int,Int)]
extendedCornerSequence :: Partition -> [(Int, Int)]
extendedCornerSequence (Partition_ [Int]
ps) = [(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
head [Int]
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]
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
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
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 }
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)
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)
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
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
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
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)
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
| 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
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
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
| 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
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
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] ]
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
, 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
| 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
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
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
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
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
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
head [(Int, Int)]
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
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
head [(Int, Int)]
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