File talk:Composition (substitution) of combinatorial species.svg

From Wikimedia Commons, the free media repository
Jump to navigation Jump to search

Source code[edit]

The source code is written in Haskell, using the diagrams framework.

{-# LANGUAGE NoMonomorphismRestriction #-}

import           Data.Colour.Palette.ColorSet
import           Diagrams.Backend.Cairo.CmdLine
import           Diagrams.Prelude

blue' = d3Colors1 0
red' = d3Colors1 3
lblue' = d3Colors1 9

elt c n = circle 1 # fc c # lw 0 # named n

mkSet' es c n = vcat' (with & sep .~ 1) elts # centerY # enbox 0.5 c
  where
    elts = zipWith (\e n -> e c n) es [0::Int .. ]

mkSet c n = mkSet' (replicate n elt) c n

enbox off c d = r <> d'
  where
    d' = d # frame off
    r  = boundingRect d' # dashing [0.2,0.2] 0 # lc c # lw 0.1

conn :: (IsName n1, IsName n2) => Colour Double -> n1 -> n2 -> Diagram B R2 -> Diagram B R2
conn c  = connectOutside' (with & shaftStyle %~ lw 0.1 . lc c & arrowHead .~ noHead)

compose = hcat' (with & sep .~ 6)
  [ elt red' "root"
  , "A" |> mkSet lblue' 3
  , vcat' (with & sep .~ 1)
    [ "B1" |> mkSet blue' 2
    , "B2" |> mkSet blue' 2
    , "B3" |> mkSet blue' 1
    ]
    # centerY
  ]
  # applyAll
    ( map (conn red' "root") ("A" |> map toName [0 :: Int .. 2])
   ++ map (conn lblue' ("A" .> (0 :: Int))) ("B1" |> map toName [0 :: Int .. 1])
   ++ map (conn lblue' ("A" .> (1 :: Int))) ("B2" |> map toName [0 :: Int .. 1])
   ++ map (conn lblue' ("A" .> (2 :: Int))) (["B3" .> (0 :: Int)])
    )
main = defaultMain (compose # frame 0.5)