module Math.Combinat.Diagrams.Partitions.Skew where
import Math.Combinat.Partitions.Integer
import Math.Combinat.Partitions.Skew
import Math.Combinat.Diagrams.Partitions.Integer
import Linear.Vector
import Data.Colour
import Diagrams.Core
import Diagrams.Prelude
drawSkewFerrersDiagram :: Renderable (Path V2 Double) b => SkewPartition -> QDiagram b V2 Double Any
drawSkewFerrersDiagram = drawSkewFerrersDiagram' EnglishNotation black True (True,False)
drawSkewFerrersDiagram'
:: forall b. Renderable (Path V2 Double) b
=> PartitionConvention
-> Colour Double
-> Bool
-> (Bool,Bool)
-> SkewPartition
-> QDiagram b V2 Double Any
drawSkewFerrersDiagram' convention color cornerGrid (outerGrid,innerGrid) skewPart = diag where
diag = (if outerGrid then outerBoxes else mempty)
<> (if innerGrid then innerBoxes else mempty)
<> (if cornerGrid && not innerGrid then cornerLines else mempty)
<> balls
innerCol = lightgray
outerCol = black
linewidth = 0.05
cornerLines = (lines # lwL linewidth # lc innerCol) where
(x,y) = heightWidth $ outerPartition skewPart
lines = fromOffsets [ (fromIntegral x) *^ unitX ] <>
fromOffsets [ (fromIntegral y) *^ unit_Y ]
innerBoxes = drawPartitionBoxes convention (innerPartition skewPart) # lc innerCol
outerBoxes = drawSkewPartitionBoxes convention skewPart # lc outerCol
pps :: [(Int,Int)]
SkewPartition pps = skewPart
n = length pps
balls = partitionConventionTransformation convention balls0
balls0 = mconcat [ ball j i | i<-[0..n1], let (x,w) = pps!!i , j <-[x..x+w1] ]
# lc color
ball x y = translate (r2 (0.5 + fromIntegral x, 0.5 fromIntegral y))
$ circle ballRadius # lwL ballLinewidth # lc black # fc color
ballRadius = 0.30
ballLinewidth = 0.025
drawSkewPartitionBoxesWithInner
:: forall b. Renderable (Path V2 Double) b
=> (Colour Double, Colour Double)
-> PartitionConvention -> SkewPartition
-> QDiagram b V2 Double Any
drawSkewPartitionBoxesWithInner (innerCol,outerCol) conv skew = outer <> inner where
inner = drawPartitionBoxes conv (innerPartition skew) # lc innerCol
outer = drawSkewPartitionBoxes conv skew # lc outerCol
drawSkewPartitionBoxes
:: forall b. Renderable (Path V2 Double) b
=> PartitionConvention
-> SkewPartition
-> QDiagram b V2 Double Any
drawSkewPartitionBoxes conv skewPart = partitionConventionTransformation conv boxes
where
linewidth = 0.05
boxes = boxes0 # lwL linewidth
boxes0
| null pps = mempty
| otherwise = horiz <> vert
pps, qqs :: [(Int,Int)]
SkewPartition pps = skewPart
SkewPartition qqs = dualSkewPartition skewPart
union (a,b) (c,d) = (min a c , max (a+b) (c+d) min a c)
f xs = head xs : zipWith union xs (tail xs) ++ [last xs]
fi :: Int -> Double
fi = fromIntegral
horiz = mconcat [ translateY (fi (i)) (hline x w) | (i,(x,w)) <- zip [(0::Int)..] (f pps) , w>0 ]
vert = mconcat [ translateX (fi j ) (vline y h) | (j,(y,h)) <- zip [(0::Int)..] (f qqs) , h>0 ]
hline, vline :: Int -> Int -> QDiagram b V2 Double Any
hline x w = translateX (fi x ) $ fromOffsets [ (fi w) *^ unitX ]
vline y h = translateY (fi (y)) $ fromOffsets [ (fi h) *^ unit_Y ]