LatticePaths.hs

-- | Lattice path diagrams

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

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

import Math.Combinat.LatticePaths

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

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

-- | Which orientation to draw the lattice paths 
data LatticeConvention
  = Hilly                -- ^ the steps are @(1,1)@ and @(1,-1)@
  | UpRight              -- ^ the steps are @(0,1)@ and @(0,1)@
  deriving (Eq,Show)

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

-- | Draws a lattice path with the default settings
drawLatticePath :: Renderable (Path R2) b => LatticePath -> Diagram b R2
drawLatticePath = drawLatticePath' Hilly red True

drawLatticePath' 
  :: Renderable (Path R2) b
  => LatticeConvention        -- ^ orientation
  -> Colour Double            -- ^ color
  -> Bool                     -- ^ whether to draw a grid
  -> LatticePath              -- ^ whether to draw a grid
  -> Diagram b R2
drawLatticePath' convention color hasgrid xs = 
  if hasgrid 
    then path <> grid 
    else path 

  where
{-
    path = go 0 0 ps where
      go !x !y []     = mempty
      go !x !y (p:ps) = case p of
        UpStep   -> translate (r2 x y) up  <> go (x+1) (y+1) ps
        DownStep -> translate (r2 x y) dn  <> go (x+1) (y-1) ps
-}

    linewidth = 0.025

    path = path0 # lwL (linewidth*2) # lc color 
    grid = grid0 # lwL (linewidth  ) 

    path0 = fromOffsets [ case p of { UpStep -> up ; DownStep -> dn } | p <- xs ]
    grid0 = case convention of
      Hilly    -> drawRectangularGrid (length xs, pathHeight xs)
      UpRight  -> drawRectangularGrid (b,a) 

    (a,b) = pathNumberOfUpDownSteps xs

    (up,dn) = case convention of 
      Hilly    -> ( r2 (1,1) , r2 (1,-1) )
      UpRight  -> ( r2 (0,1) , r2 (1, 0) )

--------------------------------------------------------------------------------
   
-- | Draws a rectangular grid of the given size
drawRectangularGrid :: Renderable (Path R2) b => (Int,Int) -> Diagram b R2
drawRectangularGrid (x,y) = grid # lc grey where
  grid = horiz <> vert 

  horiz = mconcat [ translateY (fromIntegral i) hline | i<-[0..y] ]
  vert  = mconcat [ translateX (fromIntegral j) vline | j<-[0..x] ]

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

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