Safe Haskell | None |
---|---|
Language | Haskell2010 |
N-ary trees.
Synopsis
- module Data.Tree
- data Tree a = Node {}
- ternaryTrees :: Int -> [Tree ()]
- regularNaryTrees :: Int -> Int -> [Tree ()]
- semiRegularTrees :: [Int] -> Int -> [Tree ()]
- countTernaryTrees :: Integral a => a -> Integer
- countRegularNaryTrees :: (Integral a, Integral b) => a -> b -> Integer
- derivTrees :: [Int] -> [Tree ()]
- asciiTreeVertical_ :: Tree a -> ASCII
- asciiTreeVertical :: Show a => Tree a -> ASCII
- asciiTreeVerticalLeavesOnly :: Show a => Tree a -> ASCII
- type Dot = String
- graphvizDotTree :: Show a => Bool -> String -> Tree a -> Dot
- graphvizDotForest :: Show a => Bool -> Bool -> String -> Forest a -> Dot
- classifyTreeNode :: Tree a -> Either a a
- isTreeLeaf :: Tree a -> Maybe a
- isTreeNode :: Tree a -> Maybe a
- isTreeLeaf_ :: Tree a -> Bool
- isTreeNode_ :: Tree a -> Bool
- treeNodeNumberOfChildren :: Tree a -> Int
- countTreeNodes :: Tree a -> Int
- countTreeLeaves :: Tree a -> Int
- countTreeLabelsWith :: (a -> Bool) -> Tree a -> Int
- countTreeNodesWith :: (Tree a -> Bool) -> Tree a -> Int
- leftSpine :: Tree a -> ([a], a)
- leftSpine_ :: Tree a -> [a]
- rightSpine :: Tree a -> ([a], a)
- rightSpine_ :: Tree a -> [a]
- leftSpineLength :: Tree a -> Int
- rightSpineLength :: Tree a -> Int
- addUniqueLabelsTree :: Tree a -> Tree (a, Int)
- addUniqueLabelsForest :: Forest a -> Forest (a, Int)
- addUniqueLabelsTree_ :: Tree a -> Tree Int
- addUniqueLabelsForest_ :: Forest a -> Forest Int
- labelDepthTree :: Tree a -> Tree (a, Int)
- labelDepthForest :: Forest a -> Forest (a, Int)
- labelDepthTree_ :: Tree a -> Tree Int
- labelDepthForest_ :: Forest a -> Forest Int
- labelNChildrenTree :: Tree a -> Tree (a, Int)
- labelNChildrenForest :: Forest a -> Forest (a, Int)
- labelNChildrenTree_ :: Tree a -> Tree Int
- labelNChildrenForest_ :: Forest a -> Forest Int
Types
module Data.Tree
Multi-way trees, also known as rose trees.
Instances
Monad Tree | |
Functor Tree | |
MonadFix Tree | Since: containers-0.5.11 |
Applicative Tree | |
Foldable Tree | |
Defined in Data.Tree fold :: Monoid m => Tree m -> m # foldMap :: Monoid m => (a -> m) -> Tree a -> m # foldr :: (a -> b -> b) -> b -> Tree a -> b # foldr' :: (a -> b -> b) -> b -> Tree a -> b # foldl :: (b -> a -> b) -> b -> Tree a -> b # foldl' :: (b -> a -> b) -> b -> Tree a -> b # foldr1 :: (a -> a -> a) -> Tree a -> a # foldl1 :: (a -> a -> a) -> Tree a -> a # elem :: Eq a => a -> Tree a -> Bool # maximum :: Ord a => Tree a -> a # | |
Traversable Tree | |
Eq1 Tree | Since: containers-0.5.9 |
Ord1 Tree | Since: containers-0.5.9 |
Read1 Tree | Since: containers-0.5.9 |
Show1 Tree | Since: containers-0.5.9 |
MonadZip Tree | |
Eq a => Eq (Tree a) | |
Data a => Data (Tree a) | |
Defined in Data.Tree gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Tree a -> c (Tree a) # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Tree a) # toConstr :: Tree a -> Constr # dataTypeOf :: Tree a -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (Tree a)) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Tree a)) # gmapT :: (forall b. Data b => b -> b) -> Tree a -> Tree a # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Tree a -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Tree a -> r # gmapQ :: (forall d. Data d => d -> u) -> Tree a -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Tree a -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Tree a -> m (Tree a) # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Tree a -> m (Tree a) # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Tree a -> m (Tree a) # | |
Read a => Read (Tree a) | |
Show a => Show (Tree a) | |
Generic (Tree a) | |
NFData a => NFData (Tree a) | |
HasNumberOfLeaves (Tree a) Source # | |
Defined in Math.Combinat.Trees.Nary numberOfLeaves :: Tree a -> Int Source # | |
HasNumberOfNodes (Tree a) Source # | |
Defined in Math.Combinat.Trees.Nary numberOfNodes :: Tree a -> Int Source # | |
DrawASCII (Tree ()) Source # | |
Generic1 Tree | |
type Rep (Tree a) | Since: containers-0.5.8 |
Defined in Data.Tree type Rep (Tree a) = D1 (MetaData "Tree" "Data.Tree" "containers-0.5.11.0" False) (C1 (MetaCons "Node" PrefixI True) (S1 (MetaSel (Just "rootLabel") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 a) :*: S1 (MetaSel (Just "subForest") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Forest a)))) | |
type Rep1 Tree | Since: containers-0.5.8 |
Defined in Data.Tree type Rep1 Tree = D1 (MetaData "Tree" "Data.Tree" "containers-0.5.11.0" False) (C1 (MetaCons "Node" PrefixI True) (S1 (MetaSel (Just "rootLabel") NoSourceUnpackedness NoSourceStrictness DecidedLazy) Par1 :*: S1 (MetaSel (Just "subForest") NoSourceUnpackedness NoSourceStrictness DecidedLazy) ([] :.: Rec1 Tree))) |
Regular trees
ternaryTrees :: Int -> [Tree ()] Source #
Ternary trees on n
nodes (synonym for regularNaryTrees 3
)
regularNaryTrees d n
returns the list of (rooted) trees on n
nodes where each
node has exactly d
children. Note that the leaves do not count in n
.
Naive algorithm.
All trees on n
nodes where the number of children of all nodes is
in element of the given set. Example:
autoTabulate RowMajor (Right 5) $ map asciiTreeVertical $ map labelNChildrenTree_ $ semiRegularTrees [2,3] 2 [ length $ semiRegularTrees [2,3] n | n<-[0..] ] == [1,2,10,66,498,4066,34970,312066,2862562,26824386,...]
The latter sequence is A027307 in OEIS: https://oeis.org/A027307
Remark: clearly, we have
semiRegularTrees [d] n == regularNaryTrees d n
countTernaryTrees :: Integral a => a -> Integer Source #
# = \frac {1} {(2n+1} \binom {3n} {n}
countRegularNaryTrees :: (Integral a, Integral b) => a -> b -> Integer Source #
We have
length (regularNaryTrees d n) == countRegularNaryTrees d n == \frac {1} {(d-1)n+1} \binom {dn} {n}
"derivation trees"
derivTrees :: [Int] -> [Tree ()] Source #
Computes the set of equivalence classes of rooted trees (in the
sense that the leaves of a node are unordered)
with n = length ks
leaves where the set of heights of
the leaves matches the given set of numbers.
The height is defined as the number of edges from the leaf to the root.
TODO: better name?
ASCII drawings
asciiTreeVertical_ :: Tree a -> ASCII Source #
Vertical ASCII drawing of a tree, without labels. Example:
autoTabulate RowMajor (Right 5) $ map asciiTreeVertical_ $ regularNaryTrees 2 4
Nodes are denoted by @
, leaves by *
.
asciiTreeVertical :: Show a => Tree a -> ASCII Source #
Prints all labels. Example:
asciiTreeVertical $ addUniqueLabelsTree_ $ (regularNaryTrees 3 9) !! 666
Nodes are denoted by (label)
, leaves by label
.
asciiTreeVerticalLeavesOnly :: Show a => Tree a -> ASCII Source #
Prints the labels for the leaves, but not for the nodes.
Graphviz drawing
Generates graphviz .dot
file from a tree. The first argument is
the name of the graph.
:: Show a | |
=> Bool | make the individual trees clustered subgraphs |
-> Bool | reverse the direction of the arrows |
-> String | name of the graph |
-> Forest a | |
-> Dot |
Generates graphviz .dot
file from a forest. The first argument tells whether
to make the individual trees clustered subgraphs; the second is the name of the
graph.
Classifying nodes
isTreeLeaf :: Tree a -> Maybe a Source #
isTreeNode :: Tree a -> Maybe a Source #
isTreeLeaf_ :: Tree a -> Bool Source #
isTreeNode_ :: Tree a -> Bool Source #
treeNodeNumberOfChildren :: Tree a -> Int Source #
Counting nodes
countTreeNodes :: Tree a -> Int Source #
countTreeLeaves :: Tree a -> Int Source #
Left and right spines
leftSpine :: Tree a -> ([a], a) Source #
The leftmost spine (the second element of the pair is the leaf node)
leftSpine_ :: Tree a -> [a] Source #
The leftmost spine without the leaf node
rightSpine :: Tree a -> ([a], a) Source #
rightSpine_ :: Tree a -> [a] Source #
leftSpineLength :: Tree a -> Int Source #
The length (number of edges) on the left spine
leftSpineLength tree == length (leftSpine_ tree)
rightSpineLength :: Tree a -> Int Source #
Unique labels
addUniqueLabelsTree :: Tree a -> Tree (a, Int) Source #
Adds unique labels to the nodes (including leaves) of a Tree
.
addUniqueLabelsForest :: Forest a -> Forest (a, Int) Source #
Adds unique labels to the nodes (including leaves) of a Forest
Labelling by depth
labelDepthTree :: Tree a -> Tree (a, Int) Source #
Attaches the depth to each node. The depth of the root is 0.