diagrams-contrib-0.1.0.0: Collection of user contributions to diagrams EDSL

Maintainerbyorgey@cis.upenn.edu
Safe HaskellNone

Diagrams.TwoD.Layout.Tree

Contents

Description

A collection of methods for laying out various kinds of trees. This module is still experimental, and more layout methods will probably be added over time.

Here is an example of using force-based layout on a binary tree:

 {-# LANGUAGE NoMonomorphismRestriction #-}

 import Diagrams.Prelude
 import Diagrams.Backend.Cairo.CmdLine

 import Diagrams.TwoD.Layout.Tree

 t = BNode 1 (BNode 8 (leaf 7) (leaf 2)) (BNode 6 (leaf 3) (leaf 4))

 main = do
   let Just t' = uniqueXLayout 1 1 t
       t'' = forceLayoutTree defaultForceLayoutTreeOpts t'

   defaultMain $
     renderTree (\n -> (text (show n) # fontSize 0.5
                        <> circle 0.3 # fc white))
                (~~)
                t''

Synopsis

Binary trees

There is a standard type of rose trees (Tree) defined in the containers package, but there is no standard type for binary trees, so we define one here. Note, if you want to draw binary trees with data of type a at the leaves, you can use something like BTree (Maybe a) with Nothing at internal nodes; renderTree lets you specify how to draw each node.

data BTree a Source

Binary trees with data at internal nodes.

Constructors

Empty 
BNode a (BTree a) (BTree a) 

Instances

Functor BTree 
Foldable BTree 
Traversable BTree 
Eq a => Eq (BTree a) 
Ord a => Ord (BTree a) 
Read a => Read (BTree a) 
Show a => Show (BTree a) 

leaf :: a -> BTree aSource

Convenient constructor for leaves.

Layout algorithms

Binary tree layout

uniqueXLayout :: Double -> Double -> BTree a -> Maybe (Tree (a, P2))Source

uniqueXLayout xSep ySep t lays out the binary tree t using a simple recursive algorithm with the following properties:

  • Every left subtree is completely to the left of its parent, and similarly for right subtrees.
  • All the nodes at a given depth in the tree have the same y-coordinate. The separation distance between levels is given by ySep.
  • Every node has a unique x-coordinate. The separation between successive nodes from left to right is given by xSep.

Force-directed layout

Force-directed layout of rose trees.

forceLayoutTree :: ForceLayoutTreeOpts -> Tree (a, P2) -> Tree (a, P2)Source

Force-directed layout of rose trees. In particular,

  • edges are modeled as springs
  • nodes are modeled as point charges
  • nodes are constrained to keep the same y-coordinate.

The input could be a tree already laid out by some other method, such as uniqueXLayout.

data ForceLayoutTreeOpts Source

Constructors

FLTOpts 

Fields

forceLayoutOpts :: ForceLayoutOpts R2

Options to the force layout simulator, including damping

edgeLen :: Double

How long edges should be, ideally. This will be the resting length for the springs.

springK :: Double

Spring constant. The bigger the constant, the more the edges push/pull towards their resting length.

staticK :: Double

Coulomb constant. The bigger the constant, the more sibling nodes repel each other.

treeToEnsemble :: forall a. ForceLayoutTreeOpts -> Tree (a, P2) -> (Tree (a, PID), Ensemble R2)Source

Assign unique ID numbers to the nodes of a tree, and generate an Ensemble suitable for simulating in order to do force-directed layout of the tree. In particular,

  • edges are modeled as springs
  • nodes are modeled as point charges
  • nodes are constrained to keep the same y-coordinate.

The input to treeToEnsemble

label :: Traversable t => t a -> t (a, PID)Source

Assign unique IDs to every node in a tree (or other traversable structure).

reconstruct :: Functor t => Ensemble R2 -> t (a, PID) -> t (a, P2)Source

Reconstruct a tree (or any traversable structure) from an Ensemble, given unique identifier annotations matching the identifiers used in the Ensemble.

Rendering

renderTree :: (a -> Diagram b R2) -> (P2 -> P2 -> Diagram b R2) -> Tree (a, P2) -> Diagram b R2Source

Draw a tree annotated with node positions, given functions specifying how to draw nodes and edges.