-- | Young and Ferrers diagrams for skew partitions. -- -- For example, the code -- -- > skew = mkSkewPartition ( Partition [9,7,3,2,2,1] , Partition [5,3,2,1] ) -- > drawSkewFerrersDiagram skew -- -- produces -- -- <> -- {-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-} 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 -------------------------------------------------------------------------------- -- | Draws a Ferrers diagram with the default settings (English notation, no inner boxes) drawSkewFerrersDiagram :: Renderable (Path V2 Double) b => SkewPartition -> QDiagram b V2 Double Any drawSkewFerrersDiagram = drawSkewFerrersDiagram' EnglishNotation black True (True,False) -- | Example: -- -- <> -- drawSkewFerrersDiagram' :: forall b. Renderable (Path V2 Double) b => PartitionConvention -- ^ orientation -> Colour Double -- ^ color -> Bool -- ^ whether to draw the corner -> (Bool,Bool) -- ^ whether to draw the outer resp. inner boxes -> 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..n-1], let (x,w) = pps!!i , j <-[x..x+w-1] ] # 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 -------------------------------------------------------------------------------- -- | Draws a skew partition as a grid of boxes (sometimes also called Young diagram). -- We draw the both the inner and the outer partition, in different colors. drawSkewPartitionBoxesWithInner :: forall b. Renderable (Path V2 Double) b => (Colour Double, Colour Double) -- ^ colors of the outer resp. inner partitions -> 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 -------------------------------------------------------------------------------- -- | Draws a skew partition as a grid of boxes (sometimes also called Young diagram). -- We only draw the boxes of the difference! -- -- Example: -- -- <> -- 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 -- lc black 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 ] --------------------------------------------------------------------------------