Skew.hs

-- | 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
--
-- <<svg/skew.svg>>
--

{-# 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:
--
-- <<svg/skew2.svg>>
--
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:
--
-- <<svg/skew3.svg>>
--

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 ]

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