module Math.Combinat.Diagrams.Partitions.Integer where
import Math.Combinat.Partitions.Integer
import Linear.Vector
import Data.Colour
import Diagrams.Core
import Diagrams.Prelude
partitionConventionTransformation :: PartitionConvention -> QDiagram b V2 Double Any -> QDiagram b V2 Double Any
partitionConventionTransformation conv what =
case conv of
EnglishNotation -> what
EnglishNotationCCW -> rotate (90 @@ deg) what
FrenchNotation -> scaleY (1) what
drawFerrersDiagram :: Renderable (Path V2 Double) b => Partition -> QDiagram b V2 Double Any
drawFerrersDiagram = drawFerrersDiagram' EnglishNotation black False
drawFerrersDiagram'
:: Renderable (Path V2 Double) b
=> PartitionConvention
-> Colour Double
-> Bool
-> Partition
-> QDiagram b V2 Double Any
drawFerrersDiagram' convention color hasgrid part =
if hasgrid
then balls <> boxes
else balls
where
ps = fromPartition part :: [Int]
n = length ps
balls = partitionConventionTransformation convention balls0
balls0 = mconcat [ ball j i | i<-[0..n1], j<-[0..(ps!!i)1] ]
# lc color
ball x y = translate (r2 (0.5 + fromIntegral x, 0.5 fromIntegral y))
$ circle ballradius # lwL linewidth # lc black # fc color
ballradius = 0.30
linewidth = 0.025
boxes = drawPartitionBoxes convention part
drawPartitionBoxes :: Renderable (Path V2 Double) b => PartitionConvention -> Partition -> QDiagram b V2 Double Any
drawPartitionBoxes conv part = partitionConventionTransformation conv boxes
where
linewidth = 0.05
boxes = boxes0 # lwL linewidth
boxes0
| null ps = mempty
| otherwise = horiz <> vert
ps = fromPartition $ part :: [Int]
qs = fromPartition $ dualPartition part :: [Int]
f xs = head xs : xs
horiz = mconcat [ translateY (fromIntegral (i)) (hline j) | (i,j) <- zip [(0::Int)..] (f ps) ]
vert = mconcat [ translateX (fromIntegral j ) (vline i) | (i,j) <- zip (f qs) [(0::Int)..] ]
hline x = fromOffsets [ (fromIntegral x) *^ unitX ]
vline y = fromOffsets [ (fromIntegral y) *^ unit_Y ]