diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2014, Balazs Komuves +Copyright (c) 2014-2015, Balazs Komuves All rights reserved. Redistribution and use in source and binary forms, with or without diff --git a/Math/Combinat/Diagrams.hs b/Math/Combinat/Diagrams.hs --- a/Math/Combinat/Diagrams.hs +++ b/Math/Combinat/Diagrams.hs @@ -5,7 +5,9 @@ , module Math.Combinat.Diagrams.Partitions.Integer , module Math.Combinat.Diagrams.Partitions.NonCrossing , module Math.Combinat.Diagrams.Partitions.Plane + , module Math.Combinat.Diagrams.Partitions.Skew , module Math.Combinat.Diagrams.Tableaux + , module Math.Combinat.Diagrams.Tableaux.Skew , module Math.Combinat.Diagrams.Trees.Binary ) where @@ -16,7 +18,9 @@ import Math.Combinat.Diagrams.Partitions.Integer import Math.Combinat.Diagrams.Partitions.NonCrossing import Math.Combinat.Diagrams.Partitions.Plane +import Math.Combinat.Diagrams.Partitions.Skew import Math.Combinat.Diagrams.Tableaux +import Math.Combinat.Diagrams.Tableaux.Skew import Math.Combinat.Diagrams.Trees.Binary -------------------------------------------------------------------------------- diff --git a/Math/Combinat/Diagrams/LatticePaths.hs b/Math/Combinat/Diagrams/LatticePaths.hs --- a/Math/Combinat/Diagrams/LatticePaths.hs +++ b/Math/Combinat/Diagrams/LatticePaths.hs @@ -1,5 +1,17 @@ -- | Lattice path diagrams +-- +-- For example, the code: +-- +-- > let u = UpStep +-- > d = DownStep +-- > path = [ u,u,d,u,u,u,d,u,d,d,u,d,u,u,u,d,d,d,d,d,u,d,u,u,d,d ] +-- > drawLatticePath $ path +-- +-- produces the diagram: +-- +-- <> +-- {-# LANGUAGE FlexibleContexts #-} module Math.Combinat.Diagrams.LatticePaths where @@ -8,9 +20,10 @@ import Math.Combinat.LatticePaths --- import Data.Monoid -import Data.VectorSpace +import Linear.Vector + import Data.Colour + import Diagrams.Core import Diagrams.Prelude @@ -25,16 +38,16 @@ -------------------------------------------------------------------------------- -- | Draws a lattice path with the default settings -drawLatticePath :: Renderable (Path R2) b => LatticePath -> Diagram b R2 +drawLatticePath :: Renderable (Path V2 Double) b => LatticePath -> QDiagram b V2 Double Any drawLatticePath = drawLatticePath' Hilly red True drawLatticePath' - :: Renderable (Path R2) b + :: Renderable (Path V2 Double) b => LatticeConvention -- ^ orientation -> Colour Double -- ^ color -> Bool -- ^ whether to draw a grid -> LatticePath -- ^ whether to draw a grid - -> Diagram b R2 + -> QDiagram b V2 Double Any drawLatticePath' convention color hasgrid xs = if hasgrid then path <> grid @@ -68,7 +81,7 @@ -------------------------------------------------------------------------------- -- | Draws a rectangular grid of the given size -drawRectangularGrid :: Renderable (Path R2) b => (Int,Int) -> Diagram b R2 +drawRectangularGrid :: Renderable (Path V2 Double) b => (Int,Int) -> QDiagram b V2 Double Any drawRectangularGrid (x,y) = grid # lc grey where grid = horiz <> vert diff --git a/Math/Combinat/Diagrams/Partitions/Integer.hs b/Math/Combinat/Diagrams/Partitions/Integer.hs --- a/Math/Combinat/Diagrams/Partitions/Integer.hs +++ b/Math/Combinat/Diagrams/Partitions/Integer.hs @@ -1,5 +1,14 @@ --- | Young and Ferrers diagrams for integer partitions +-- | Young and Ferrers diagrams for integer partitions. +-- +-- For example the code +-- +-- > drawFerrersDiagram' EnglishNotation red True $ Partition [8,6,3,3,1] +-- +-- produces the diagram: +-- +-- <> +-- {-# LANGUAGE FlexibleContexts #-} module Math.Combinat.Diagrams.Partitions.Integer where @@ -8,9 +17,10 @@ import Math.Combinat.Partitions.Integer --- import Data.Monoid -import Data.VectorSpace +import Linear.Vector + import Data.Colour + import Diagrams.Core import Diagrams.Prelude @@ -29,7 +39,7 @@ -------------------------------------------------------------------------------- -partitionConventionTransformation :: PartitionConvention -> Diagram b R2 -> Diagram b R2 +partitionConventionTransformation :: PartitionConvention -> QDiagram b V2 Double Any -> QDiagram b V2 Double Any partitionConventionTransformation conv what = case conv of EnglishNotation -> what @@ -39,17 +49,18 @@ -------------------------------------------------------------------------------- -- | Draws a Ferrers diagram with the default settings (English notation, no boxes) -drawFerrersDiagram :: Renderable (Path R2) b => Partition -> Diagram b R2 +drawFerrersDiagram :: Renderable (Path V2 Double) b => Partition -> QDiagram b V2 Double Any drawFerrersDiagram = drawFerrersDiagram' EnglishNotation black False drawFerrersDiagram' - :: Renderable (Path R2) b + :: Renderable (Path V2 Double) b => PartitionConvention -- ^ orientation -> Colour Double -- ^ color -> Bool -- ^ whether to draw the boxes -> Partition - -> Diagram b R2 + -> QDiagram b V2 Double Any + drawFerrersDiagram' convention color hasgrid part = if hasgrid then balls <> boxes @@ -76,14 +87,14 @@ -------------------------------------------------------------------------------- -- | Draws a partition as a grid of boxes (sometimes also called Young diagram) -drawPartitionBoxes :: Renderable (Path R2) b => PartitionConvention -> Partition -> Diagram b R2 +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 # lc black # lwL linewidth + boxes = boxes0 # lwL linewidth -- lc black boxes0 | null ps = mempty @@ -94,8 +105,8 @@ 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..] ] + 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 ] diff --git a/Math/Combinat/Diagrams/Partitions/NonCrossing.hs b/Math/Combinat/Diagrams/Partitions/NonCrossing.hs --- a/Math/Combinat/Diagrams/Partitions/NonCrossing.hs +++ b/Math/Combinat/Diagrams/Partitions/NonCrossing.hs @@ -1,17 +1,27 @@ -- | Diagrams of non-crossing partitions +-- +-- The code +-- +-- > drawNonCrossingCircleDiagram' orange True $ NonCrossing [[3],[5,4,2],[7,6,1],[9,8]] +-- +-- produces the diagram +-- +-- <> +-- -{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleContexts, TypeFamilies #-} module Math.Combinat.Diagrams.Partitions.NonCrossing where -------------------------------------------------------------------------------- import Math.Combinat.Partitions.NonCrossing --- import Data.Monoid -import Data.AffineSpace -import Data.VectorSpace +import Linear.Vector +import Linear.Affine + import Data.Colour + import Diagrams.Core import Diagrams.Prelude import Diagrams.TwoD.Text @@ -20,16 +30,16 @@ -- | Draws a Ferrers diagram with the default settings (English notation, no boxes) -drawNonCrossingCircleDiagram :: (Renderable (Path R2) b, Renderable Text b) => NonCrossing -> Diagram b R2 +drawNonCrossingCircleDiagram :: (Renderable (Path V2 Double) b, Renderable (Text Double) b) => NonCrossing -> QDiagram b V2 Double Any drawNonCrossingCircleDiagram = drawNonCrossingCircleDiagram' grey False drawNonCrossingCircleDiagram' - :: (Renderable (Path R2) b, Renderable Text b) + :: (Renderable (Path V2 Double) b, Renderable (Text Double) b) => Colour Double -- ^ color -> Bool -- ^ whether to write numbers from @[1..n]@ next to the set elements -> NonCrossing - -> Diagram b R2 + -> QDiagram b V2 Double Any drawNonCrossingCircleDiagram' color hasnumbers (NonCrossing nc) = final where final = xdots <> xparts <> xcirc <> (if hasnumbers then numbers else mempty) @@ -50,20 +60,20 @@ n = length $ concat nc fn = fromIntegral n - r2p2 :: R2 -> P2 + r2p2 :: V2 Double -> P2 Double r2p2 v = origin .+^ v - p2r2 :: P2 -> R2 + p2r2 :: P2 Double -> V2 Double p2r2 p = p .-. origin numbers = mconcat ns # lw none # fc blue ns = [ translate v (scale 0.3 $ translate (r2 (0,-0.35)) $ text (show i)) | (i,v) <- zip [1..n] (verticesR superradius) ] - verticesR :: Double -> [R2] + verticesR :: Double -> [V2 Double] verticesR r = [ r2 (r * sin phi , r * cos phi) | i <- [0..n-1] , let phi = fromIntegral i * 2*pi/fn ] - verticesP :: Double -> [P2] + verticesP :: Double -> [P2 Double] verticesP r = map r2p2 (verticesR r) vtxs = verticesP radius @@ -82,7 +92,7 @@ -------------------------------------------------------------------------------- -makeRoundedPolygonCCW :: Renderable (Path R2) b => Double -> [P2] -> Diagram b R2 +makeRoundedPolygonCCW :: Renderable (Path V2 Double) b => Double -> [P2 Double] -> QDiagram b V2 Double Any makeRoundedPolygonCCW radius xs = case xs of @@ -104,22 +114,26 @@ go (p:rest@(q:r:_)) = [ mySeg `mappend` myArc ] : go rest where mySeg = trailFromOffsets [u] - myArc = arc' radius (ua' @@ rad) (va' @@ rad) + + myArc = scale radius arcCCW (angleDir angle1) (angleDir angle2) + u = q .-. p v = r .-. q (ux,uy) = unr2 u (vx,vy) = unr2 v ua = atan2 uy ux va = atan2 vy vx - ua' = ua - pi/2 - va' = va - pi/2 + ua' = ua - pi/2 :: Double + va' = va - pi/2 :: Double + angle1 = ua' @@ rad :: Angle Double + angle2 = va' @@ rad :: Angle Double -- nx = radius *^ r2 (cos ua' , sin ua') go _ = [] - r2p2 :: R2 -> P2 + r2p2 :: V2 Double -> P2 Double r2p2 v = origin .+^ v - p2r2 :: P2 -> R2 + p2r2 :: P2 Double -> V2 Double p2r2 p = p .-. origin -------------------------------------------------------------------------------- diff --git a/Math/Combinat/Diagrams/Partitions/Plane.hs b/Math/Combinat/Diagrams/Partitions/Plane.hs --- a/Math/Combinat/Diagrams/Partitions/Plane.hs +++ b/Math/Combinat/Diagrams/Partitions/Plane.hs @@ -1,5 +1,21 @@ --- | Drawing plane partitions +-- | Drawing plane partitions. +-- +-- For example: +-- +-- > drawPlanePartition3D $ +-- > PlanePart [ [5,4,3,3,1] +-- > , [4,4,2,1] +-- > , [3,2] +-- > , [2,1] +-- > , [1] +-- > , [1] +-- > ] +-- +-- produces the picture: +-- +-- <> +-- {-# LANGUAGE FlexibleContexts, TypeFamilies #-} module Math.Combinat.Diagrams.Partitions.Plane where @@ -11,9 +27,9 @@ import Math.Combinat.Diagrams.Tableaux as Tableaux --- import Data.Monoid -import Data.AffineSpace -import Data.VectorSpace +import Linear.Vector +import Linear.Affine + import Data.Colour import Diagrams.Core import Diagrams.Prelude @@ -21,12 +37,15 @@ -------------------------------------------------------------------------------- -drawPlanePartition3D :: (Renderable (Path R2) b) => PlanePart -> Diagram b R2 +drawPlanePartition3D :: (Renderable (Path V2 Double) b) => PlanePart -> QDiagram b V2 Double Any drawPlanePartition3D = drawPlanePartition3D' (cadetblue,indianred,lawngreen) -- | Draws 3D-like (but in fact 2D) diagram of a plane partition, coloring the faces with the given colors -- -drawPlanePartition3D' :: (Renderable (Path R2) b) => (Colour Double, Colour Double, Colour Double) -> PlanePart -> Diagram b R2 +drawPlanePartition3D' + :: (Renderable (Path V2 Double) b) + => (Colour Double, Colour Double, Colour Double) + -> PlanePart -> QDiagram b V2 Double Any drawPlanePartition3D' (col1,col2,col3) pp@(PlanePart pps) = final where final = leftSides # fc col1 # lwL linewidth @@ -38,21 +57,21 @@ linewidth = 0.05 :: Double dir_top = unitY - dir_left = fromDirection ( 210 @@ deg) - dir_right = fromDirection ((-30) @@ deg) + dir_left = fromDirection (angleDir $ 210 @@ deg) + dir_right = fromDirection (angleDir $ (-30) @@ deg) - ndir_top = negateV dir_top - ndir_left = negateV dir_left - ndir_right = negateV dir_right + ndir_top = negated dir_top + ndir_left = negated dir_left + ndir_right = negated dir_right leftSides = mconcat $ zipWith lefts [0..] layers rightSides = mconcat $ zipWith rights [0..] layers topSides = mconcat $ map tops [1..planePartZHeight pp] - iscale i v = if i /= 0 then scale (fromIntegral i) v else zeroV + iscale i v = if i /= 0 then scale (fromIntegral i) v else zero - tr :: (Transformable t, V t ~ R2) => Int -> Int -> Int -> t -> t + tr :: (Transformable t, V t ~ V2, N t ~ Double) => Int -> Int -> Int -> t -> t tr i j k = translate ( iscale i dir_right ^+^ iscale j dir_left ^+^ iscale k dir_top ) @@ -69,7 +88,7 @@ -------------------------------------------------------------------------------- -- | Draws a plane partitions as a tablaeux, with numbers indicating the Z height -drawPlanePartition2D :: (Renderable (Path R2) b, Renderable Text b) => PlanePart -> Diagram b R2 +drawPlanePartition2D :: (Renderable (Path V2 Double) b, Renderable (Text Double) b) => PlanePart -> QDiagram b V2 Double Any drawPlanePartition2D = Tableaux.drawTableau . fromPlanePart -------------------------------------------------------------------------------- diff --git a/Math/Combinat/Diagrams/Partitions/Skew.hs b/Math/Combinat/Diagrams/Partitions/Skew.hs new file mode 100644 --- /dev/null +++ b/Math/Combinat/Diagrams/Partitions/Skew.hs @@ -0,0 +1,142 @@ + +-- | 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 ] + +-------------------------------------------------------------------------------- + + diff --git a/Math/Combinat/Diagrams/Tableaux.hs b/Math/Combinat/Diagrams/Tableaux.hs --- a/Math/Combinat/Diagrams/Tableaux.hs +++ b/Math/Combinat/Diagrams/Tableaux.hs @@ -1,7 +1,20 @@ --- | Tableau diagrams +-- | Tableau diagrams. +-- +-- For example, the code +-- +-- > drawTableau $ +-- > [ [ 1 , 3 , 4 , 6 , 7 ] +-- > , [ 2 , 5 , 8 ,10 ] +-- > , [ 9 ] +-- > ] +-- +-- produces the diagram +-- +-- <> +-- -{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleContexts, TypeFamilies #-} module Math.Combinat.Diagrams.Tableaux where -------------------------------------------------------------------------------- @@ -10,9 +23,10 @@ import Math.Combinat.Partitions import Math.Combinat.Diagrams.Partitions --- import Data.Monoid -import Data.VectorSpace +import Linear.Vector + import Data.Colour + import Diagrams.Core import Diagrams.Prelude import Diagrams.TwoD.Text @@ -20,19 +34,19 @@ -------------------------------------------------------------------------------- -- | Draws a Ferrers diagram with the default settings (English notation, black) -drawTableau :: (Renderable (Path R2) b, Renderable Text b) => Tableau Int -> Diagram b R2 +drawTableau :: (Renderable (Path V2 Double) b, Renderable (Text Double) b) => Tableau Int -> QDiagram b V2 Double Any drawTableau = drawTableau' EnglishNotation black drawTableau' - :: (Renderable (Path R2) b, Renderable Text b) + :: (Renderable (Path V2 Double) b, Renderable (Text Double) b) => PartitionConvention -- ^ orientation -> Colour Double -- ^ color -> Tableau Int - -> Diagram b R2 + -> QDiagram b V2 Double Any drawTableau' convention color tableau = numbers <> boxes where - part = shape tableau + part = tableauShape tableau ps = fromPartition part :: [Int] n = length ps @@ -40,7 +54,7 @@ numbers = mconcat [ number j i a | i<-[(0::Int)..n-1], (j,a)<-zip [(0::Int)..] (tableau!!i) ] # lc color - number x y a = trafo x y $ scale 0.85 $ text (show a) # lw none # lc color # fc color + number x y a = trafo x y $ scale (0.85 :: Double) $ text (show a) # lw none # lc color # fc color v = 0.22 :: Double diff --git a/Math/Combinat/Diagrams/Tableaux/Skew.hs b/Math/Combinat/Diagrams/Tableaux/Skew.hs new file mode 100644 --- /dev/null +++ b/Math/Combinat/Diagrams/Tableaux/Skew.hs @@ -0,0 +1,73 @@ + +-- | Skew tableau diagrams. +-- +-- <> +-- + +{-# LANGUAGE FlexibleContexts, TypeFamilies #-} +module Math.Combinat.Diagrams.Tableaux.Skew where + +-------------------------------------------------------------------------------- + +import Math.Combinat.Partitions +import Math.Combinat.Partitions.Skew +import Math.Combinat.Tableaux.Skew + +import Math.Combinat.Diagrams.Partitions.Skew + +import Linear.Vector + +import Data.Colour + +import Diagrams.Core +import Diagrams.Prelude +import Diagrams.TwoD.Text + +-------------------------------------------------------------------------------- + +-- | Draws a Ferrers diagram with the default settings (English notation, black) +drawSkewTableau + :: (Renderable (Path V2 Double) b, Renderable (Text Double) b) + => SkewTableau Int + -> QDiagram b V2 Double Any +drawSkewTableau = drawSkewTableau' EnglishNotation black False + + +drawSkewTableau' + :: (Renderable (Path V2 Double) b, Renderable (Text Double) b) + => PartitionConvention -- ^ orientation + -> Colour Double -- ^ color of the numbers + -> Bool -- ^ whether to draw the inner partition + -> SkewTableau Int + -> QDiagram b V2 Double Any +drawSkewTableau' convention color drawInner tableau = numbers <> boxes where + + skewPart = skewTableauShape tableau + + xas :: [(Int,[Int])] + SkewTableau xas = tableau + + n = length xas + + numbers = mconcat [ number (j+x) i a | (i,(x,as)) <- zip [(0::Int)..n-1] xas , (j,a)<-zip [(0::Int)..] as ] + # lc color + + number x y a = trafo x y $ scale (0.85 :: Double) $ text (show a) # lw none # lc color # fc color + + v = 0.22 :: Double + + trafo x y = case convention of + EnglishNotation -> translate (r2 (0.5 + fromIntegral x , - 1 + v - fromIntegral y)) + EnglishNotationCCW -> translate (r2 (0.5 + fromIntegral y , v + fromIntegral x)) + FrenchNotation -> translate (r2 (0.5 + fromIntegral x , v + fromIntegral y)) + + -- numberSize = 0.35 :: Double + -- linewidth = 0.025 :: Double + + boxes = if drawInner + then drawSkewPartitionBoxesWithInner (lightgray,black) convention skewPart + else drawSkewPartitionBoxes convention skewPart + +-------------------------------------------------------------------------------- + + diff --git a/Math/Combinat/Diagrams/Trees/Binary.hs b/Math/Combinat/Diagrams/Trees/Binary.hs --- a/Math/Combinat/Diagrams/Trees/Binary.hs +++ b/Math/Combinat/Diagrams/Trees/Binary.hs @@ -1,5 +1,11 @@ --- | Binary trees +-- | Binary trees. +-- +-- For example, @map drawBinTree_ (binaryTrees 4)@ produces the diagrams: +-- +-- <> +-- +-- {-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-} module Math.Combinat.Diagrams.Trees.Binary where @@ -8,25 +14,26 @@ import Math.Combinat.Trees.Binary -import Data.VectorSpace -import Data.Colour hiding ( atop ) +-- import Data.Colour hiding ( atop ) + import Diagrams.Core + import Diagrams.Prelude -------------------------------------------------------------------------------- -drawBinTree_ :: forall a b. (Backend b R2, Renderable (Path R2) b ) => BinTree a -> Diagram b R2 +drawBinTree_ :: forall a b. (Backend b V2 Double, Renderable (Path V2 Double) b) => BinTree a -> QDiagram b V2 Double Any drawBinTree_ = go "." where - radius = 0.25 - radius1 = 0.15 + radius = 0.25 :: Double + radius1 = 0.15 :: Double - fx = 0.5 - fy = 1 - - linewidth = 0.04 + fx = 0.5 :: Double + fy = 1.0 :: Double + + linewidth = 0.04 :: Double - go :: String -> BinTree a -> Diagram b R2 + go :: String -> BinTree a -> QDiagram b V2 Double Any go name t = (centerXY stuff # lwL linewidth) where stuff = case t of Leaf _ -> square radius # named name # fc blue @@ -49,7 +56,7 @@ -------------------------------------------------------------------------------- {- -padX :: (Backend b R2, Monoid' m) => Double -> QDiagram b R2 m -> QDiagram b R2 m +padX :: (Backend b V2 Double, Monoid' m) => Double -> QDiagram b V2 Double m -> QDiagram b V2 Double m padX s d = withEnvelope (d # scaleX s) d frame :: ( Backend b v, InnerSpace v, OrderedField (Scalar v), Monoid' m) @@ -57,4 +64,4 @@ frame s d = setEnvelope (onEnvelope t (d^.envelope)) d where t f = \x -> f x + s --} +-} diff --git a/combinat-diagrams.cabal b/combinat-diagrams.cabal --- a/combinat-diagrams.cabal +++ b/combinat-diagrams.cabal @@ -1,5 +1,5 @@ Name: combinat-diagrams -Version: 0.1 +Version: 0.2 Synopsis: Graphical representations for various combinatorial objects Description: Uses the @diagrams@ library to generate graphical representations of combinatorial objects from @@ -7,45 +7,46 @@ License: BSD3 License-file: LICENSE Author: Balazs Komuves -Copyright: (c) 2014 Balazs Komuves +Copyright: (c) 2014-2015 Balazs Komuves Maintainer: bkomuves (plus) hackage (at) gmail (dot) com Homepage: http://code.haskell.org/~bkomuves/ Stability: Experimental Category: Math -Tested-With: GHC == 7.8.3 -Cabal-Version: >= 1.6 +Tested-With: GHC == 7.10.2 +Cabal-Version: >= 1.18 Build-Type: Simple -Flag base4 - Description: Base v4 +extra-doc-files: svg/*.svg + +extra-source-files: svg/*.svg + svg/src/gen_figures.hs +extra-source-files: test/Test.hs Library - if flag(base4) - Build-Depends: base >= 4 && < 5 - cpp-options: -DBASE_VERSION=4 - else - Build-Depends: base >= 3 && < 4 - cpp-options: -DBASE_VERSION=3 + Build-Depends: base >= 4 && < 5 Build-Depends: array, containers, transformers, - colour, vector-space, - diagrams-core, diagrams-lib, - combinat >= 0.2.7.0 + colour, linear, + diagrams-core >= 1.3, diagrams-lib >= 1.3, + combinat >= 0.2.7.2 Exposed-Modules: Math.Combinat.Diagrams Math.Combinat.Diagrams.LatticePaths - Math.Combinat.Diagrams.Tableaux Math.Combinat.Diagrams.Partitions Math.Combinat.Diagrams.Partitions.Integer Math.Combinat.Diagrams.Partitions.NonCrossing Math.Combinat.Diagrams.Partitions.Plane + Math.Combinat.Diagrams.Partitions.Skew + Math.Combinat.Diagrams.Tableaux + Math.Combinat.Diagrams.Tableaux.Skew Math.Combinat.Diagrams.Trees.Binary - Extensions: CPP, MultiParamTypeClasses, ScopedTypeVariables, - GeneralizedNewtypeDeriving, BangPatterns + default-extensions: CPP, BangPatterns, ScopedTypeVariables + other-extensions: MultiParamTypeClasses, GeneralizedNewtypeDeriving Hs-Source-Dirs: . - ghc-options: -Wall -fno-warn-unused-matches + default-language: Haskell2010 + diff --git a/svg/bintrees.svg b/svg/bintrees.svg new file mode 100644 --- /dev/null +++ b/svg/bintrees.svg @@ -0,0 +1,3 @@ + + diff --git a/svg/dyck_path.svg b/svg/dyck_path.svg new file mode 100644 --- /dev/null +++ b/svg/dyck_path.svg @@ -0,0 +1,3 @@ + + diff --git a/svg/ferrers.svg b/svg/ferrers.svg new file mode 100644 --- /dev/null +++ b/svg/ferrers.svg @@ -0,0 +1,3 @@ + + diff --git a/svg/noncrossing.svg b/svg/noncrossing.svg new file mode 100644 --- /dev/null +++ b/svg/noncrossing.svg @@ -0,0 +1,3 @@ + +987654321 diff --git a/svg/plane_partition.svg b/svg/plane_partition.svg new file mode 100644 --- /dev/null +++ b/svg/plane_partition.svg @@ -0,0 +1,3 @@ + + diff --git a/svg/skew.svg b/svg/skew.svg new file mode 100644 --- /dev/null +++ b/svg/skew.svg @@ -0,0 +1,3 @@ + + diff --git a/svg/skew2.svg b/svg/skew2.svg new file mode 100644 --- /dev/null +++ b/svg/skew2.svg @@ -0,0 +1,3 @@ + + diff --git a/svg/skew3.svg b/svg/skew3.svg new file mode 100644 --- /dev/null +++ b/svg/skew3.svg @@ -0,0 +1,3 @@ + + diff --git a/svg/skew_tableau.svg b/svg/skew_tableau.svg new file mode 100644 --- /dev/null +++ b/svg/skew_tableau.svg @@ -0,0 +1,3 @@ + +4322122111111 diff --git a/svg/src/gen_figures.hs b/svg/src/gen_figures.hs new file mode 100644 --- /dev/null +++ b/svg/src/gen_figures.hs @@ -0,0 +1,81 @@ + +-- | A script to generate the SVG figures in the documentation. +-- We use the @combinat-diagrams@ library for that. + +module Main where + +-------------------------------------------------------------------------------- + +import Math.Combinat.Partitions.Integer +import Math.Combinat.Partitions.Plane +import Math.Combinat.Partitions.NonCrossing +import Math.Combinat.Partitions.Skew +import Math.Combinat.Tableaux +import Math.Combinat.Tableaux.Skew +import Math.Combinat.LatticePaths +import Math.Combinat.Trees.Binary + +import Math.Combinat.Diagrams.Partitions.Integer +import Math.Combinat.Diagrams.Partitions.Plane +import Math.Combinat.Diagrams.Partitions.NonCrossing +import Math.Combinat.Diagrams.Partitions.Skew +import Math.Combinat.Diagrams.Tableaux +import Math.Combinat.Diagrams.Tableaux.Skew +import Math.Combinat.Diagrams.LatticePaths +import Math.Combinat.Diagrams.Trees.Binary + +import Diagrams.Core +import Diagrams.Prelude +import Diagrams.Backend.SVG + +-------------------------------------------------------------------------------- + +export fpath size what = renderSVG fpath size $ pad 1.10 what + +vcatSep = vcat' (with & sep .~ 1) +hcatSep = hcat' (with & sep .~ 1) + +boxSep m xs = pad 1.05 $ vcatSep $ map hcatSep $ yys where + yys = go xs where + go [] = [] + go zs = take m zs : go (drop m zs) + +padding fac diag = pad fac $ centerXY diag +margin siz diag = hcat [ strutX siz , vcat [ strutY siz , centerXY diag , strutY siz ] , strutX siz ] + +-------------------------------------------------------------------------------- + +main = do + + export "plane_partition.svg" (mkWidth 320) $ margin 0.05 $ drawPlanePartition3D $ + PlanePart [[5,4,3,3,1],[4,4,2,1],[3,2],[2,1],[1],[1]] + + export "noncrossing.svg" (mkWidth 256) $ padding 1.10 $ drawNonCrossingCircleDiagram' orange True $ + NonCrossing [[3],[5,4,2],[7,6,1],[9,8]] + + export "young_tableau.svg" (mkWidth 256) $ margin 0.05 $ drawTableau $ + [ [ 1 , 3 , 4 , 6 , 7 ] + , [ 2 , 5 , 8 ,10 ] + , [ 9 ] + ] + + let u = UpStep + d = DownStep + path = [ u,u,d,u,u,u,d,u,d,d,u,d,u,u,u,d,d,d,d,d,u,d,u,u,d,d ] + export "dyck_path.svg" (mkWidth 500) $ margin 0.05 $ drawLatticePath $ path + -- print (pathHeight path, pathNumberOfZeroTouches path, pathNumberOfPeaks path) + + export "ferrers.svg" (mkWidth 256) $ margin 0.05 $ drawFerrersDiagram' EnglishNotation red True $ + Partition [8,6,3,3,1] + + export "bintrees.svg" (mkWidth 750) $ boxSep 7 $ map drawBinTree_ (binaryTrees 4) + + let skew = mkSkewPartition (Partition [9,7,3,2,2,1] , Partition [5,3,2,1]) + export "skew.svg" (mkWidth 256) $ margin 0.05 $ drawSkewFerrersDiagram skew + export "skew2.svg" (mkWidth 256) $ margin 0.05 $ drawSkewFerrersDiagram' EnglishNotation green True (True,True) skew + export "skew3.svg" (mkWidth 256) $ margin 0.05 $ drawSkewPartitionBoxes EnglishNotation skew + + let skewtableau = (semiStandardSkewTableaux 7 skew) !! 137 + export "skew_tableau.svg" (mkWidth 320) $ margin 0.05 $ drawSkewTableau' EnglishNotation blue True skewtableau + +-------------------------------------------------------------------------------- diff --git a/svg/young_tableau.svg b/svg/young_tableau.svg new file mode 100644 --- /dev/null +++ b/svg/young_tableau.svg @@ -0,0 +1,3 @@ + +91085276431 diff --git a/test/Test.hs b/test/Test.hs new file mode 100644 --- /dev/null +++ b/test/Test.hs @@ -0,0 +1,80 @@ + +module Main where + +-------------------------------------------------------------------------------- + +import Math.Combinat.LatticePaths +import Math.Combinat.Tableaux +import Math.Combinat.Tableaux.Skew +import Math.Combinat.Partitions.Integer +import Math.Combinat.Partitions.NonCrossing +import Math.Combinat.Partitions.Plane +import Math.Combinat.Partitions.Skew +import Math.Combinat.Trees.Binary + +import Math.Combinat.Diagrams + +import Diagrams.Core +import Diagrams.Prelude +import Diagrams.Backend.SVG + +-------------------------------------------------------------------------------- + +svgSize = mkWidth 1000 + +vcatSep = vcat' (with & sep .~ 1) +hcatSep = hcat' (with & sep .~ 1) + +boxSep xs = myPad 1.10 $ vcatSep $ map hcatSep $ yys where + nn = length xs + m = max 1 (ceiling $ sqrt $ (fromIntegral $ length xs :: Double)) + yys = go xs where + go [] = [] + go zs = take m zs : go (drop m zs) + +myPad s = pad s . centerXY + +main = do + renderSVG "svg/dyckpaths.svg" svgSize $ boxSep $ map drawLatticePath $ dyckPaths 5 + renderSVG "svg/latpaths.svg" svgSize $ boxSep $ map (drawLatticePath' UpRight blue True) $ latticePaths (9,3) + + renderSVG "svg/partitions.svg" svgSize $ boxSep $ map (drawFerrersDiagram' EnglishNotationCCW red True) $ partitions 7 + + let part = mkPartition [4,3,1] + renderSVG "svg/tableaux.svg" svgSize $ boxSep $ map (drawTableau' EnglishNotation red) $ standardYoungTableaux part + renderSVG "svg/tableau1.svg" svgSize $ boxSep $ map (drawTableau' EnglishNotation red) $ + [ [[123,57,9,8,88],[99,6,66,2],[1,17,3]] + , [[1,2,3,4,5],[6,7,8],[9,10]] + ] + + renderSVG "svg/noncrossing.svg" svgSize $ boxSep $ map (drawNonCrossingCircleDiagram' green True) $ nonCrossingPartitions 5 + + renderSVG "svg/planepart.svg" svgSize $ boxSep $ map drawPlanePartition3D $ + [ PlanePart [[5,4,3,3,1],[4,4,2,1],[3,2],[2,1],[1],[1],[1]] + , PlanePart [[6,2,2,1,1],[3,1,1,1],[1]] + , PlanePart [[2,1,1,1,1],[1,1,1,1],[1]] + , PlanePart [[2,1],[1]] + , PlanePart [[1,1,1,1,1],[1,1,1,1],[1]] + , PlanePart [[6,2,2,1,1],[3,1,1,1],[1]] + , PlanePart [[1]] + ] + + renderSVG "svg/bintree.svg" svgSize $ boxSep $ map (drawBinTree_) $ binaryTrees 5 + + let skew1 = mkSkewPartition (Partition [8,7,3,2,2,1] , Partition [5,3,3]) + skew2 = mkSkewPartition (Partition [9,7,3,2,2,1] , Partition [5,3,2,1]) + renderSVG "svg/skew.svg" svgSize $ boxSep $ + [ drawSkewFerrersDiagram skew1 + , drawSkewFerrersDiagram' FrenchNotation green True (True,True) skew1 + , drawSkewPartitionBoxes EnglishNotationCCW skew1 + , drawSkewFerrersDiagram skew2 + , drawSkewFerrersDiagram' FrenchNotation green True (True,True) skew2 + , drawSkewPartitionBoxes EnglishNotationCCW skew2 + ] + + let skewtableau = (semiStandardSkewTableaux 7 skew2) !! 123 + skewtableau2 = (semiStandardSkewTableaux 6 skew1) !! 223 + renderSVG "svg/skewtableau.svg" svgSize $ boxSep $ + [ drawSkewTableau skewtableau + , drawSkewTableau' FrenchNotation red True skewtableau2 + ]