-- | Young and Ferrers diagrams for integer partitions

{-# LANGUAGE FlexibleContexts #-}
module Math.Combinat.Diagrams.Partitions.Integer where

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

import Math.Combinat.Partitions.Integer

-- import Data.Monoid
import Data.VectorSpace
import Data.Colour
import Diagrams.Core
import Diagrams.Prelude

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

{-
-- this is now specified in the combinat library already

-- | Which orientation to draw the Ferrers diagrams
data PartitionConvention
  = EnglishNotation          -- ^ English notation
  | EnglishNotationCCW       -- ^ English notation rotated by 90 degrees counterclockwise
  | FrenchNotation           -- ^ French notation (mirror of English notation to the x axis)
  deriving (Eq,Show)
-}

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

partitionConventionTransformation :: PartitionConvention -> Diagram b R2 -> Diagram b R2
partitionConventionTransformation conv what = 
  case conv of
    EnglishNotation    ->                    what
    EnglishNotationCCW -> rotate (90 @@ deg) what
    FrenchNotation     -> scaleY (-1)        what

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

-- | Draws a Ferrers diagram with the default settings (English notation, no boxes)
drawFerrersDiagram :: Renderable (Path R2) b => Partition -> Diagram b R2
drawFerrersDiagram = drawFerrersDiagram' EnglishNotation black False 


drawFerrersDiagram' 
  :: Renderable (Path R2) b
  => PartitionConvention      -- ^ orientation
  -> Colour Double            -- ^ color
  -> Bool                     -- ^ whether to draw the boxes
  -> Partition
  -> Diagram b R2
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..n-1], 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

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

-- | Draws a partition as a grid of boxes (sometimes also called Young diagram)
drawPartitionBoxes :: Renderable (Path R2) b => PartitionConvention -> Partition -> Diagram b R2
drawPartitionBoxes conv part = partitionConventionTransformation conv boxes

  where

    linewidth = 0.05

    boxes = boxes0 # lc black # 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..]  (f ps) ]
    vert  = mconcat [ translateX (fromIntegral   j ) (vline i) | (i,j) <- zip (f qs) [0..]  ]

    hline x = fromOffsets [ (fromIntegral x) *^ unitX  ]
    vline y = fromOffsets [ (fromIntegral y) *^ unit_Y ]

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