I need to make function returns all possible branches from a tree
with this form:
data Tree a = EmptyT | NodeT a ( Tree a ) ( Tree a ) deriving (Show)
everyBranch :: Tree a -> [[a]]
I'm not sure how to approach this... xD
I'm still a newbie in Haskell.
Let's say that I have:
1
/ \
2 3
/\ / \
4 5 7 8
I want to get: [[1,2,4], [1,2,5], [1,3,8], [1,3,7]]
We'll use a recursive approach. Let's start with a rough skeleton:
everyBranch :: Tree a -> [[a]]
everyBranch EmptyT = _something
everyBranch (NodeT v (Tree l) (Tree r)) = _somethingElse
Now we'll fill in the holes. (This syntax is known as 'typed holes': if you run the above program through GHC, it will give you an error message with the type of the value which should be in the hole.) Now, I'm not sure about the first case: depending on your need, it could be [] (no branches) or [[]] (one branch with no elements), so we'll come back to this later. For the second case, we need a way to construct a list of branches given the value and the left and right subtrees. How do we do that? We'll recursively find every branch in the left tree, and every branch in the right tree, and then we'll prepend v to both:
everyBranch :: Tree a -> [[a]]
everyBranch EmptyT = _something
everyBranch (NodeT v l r) = map (v:) $ everyBranch l ++ everyBranch r
Now, let's go back to EmptyT. Consider a very simple tree: NodeT 1 EmptyT EmptyT. In this case, everyBranch should return [[1]]. Let's invoke everyBranch 'by hand' on this tree:
(I use └→ to mean 'evaluate sub-expression recursively', and => meaning 'expression evaluates to')
everyBranch (NodeT 1 EmptyT EmptyT)
=> map (1:) $ everyBranch EmptyT ++ everyBranch EmptyT
└→ everyBranch EmptyT
=> _something
=> map (1:) $ _something ++ _something
So here, we want map (1:) $ _something ++ _something to be equal to [[1]]. What is _something? Well, it turns out that if _something is [], then map (1:) $ [] ++ [] is [], which isn't what we want. On the other hand, if _something is [[]], then map (1:) $ [[]] ++ [[]] is [[1], [1]] - which isn't what we want either. It looks like we need a slightly different approach. What we'll do is, we'll add another case specifically for these sort of trees:
everyBranch :: Tree a -> [[a]]
everyBranch EmptyT = _something
everyBranch (NodeT v EmptyT EmptyT) = [[v]]
everyBranch (NodeT v l r) = map (v:) $ everyBranch l ++ everyBranch r
Now, if we test this a bit (albeit using some random value for _something to stop it from giving us errors), we find that it works for all binary trees. As mentioned though, we still need to figure out that _something value. This value will only matter in two cases: empty trees (in which case it will trivially match EmptyT), and trees with only one subtree (in which case either l or r will match EmptyT). I will leave it as an exercise for you to determine what value to put there, how it will affect the result, and why it affects it that way.
We can derive and use Foldable, to fold into an ad-hoc monoid to do the job:
data Tree a = EmptyT
| NodeT a ( Tree a ) ( Tree a )
deriving (Show, Functor, Foldable)
data T a = T a -- tip
| N [[a]] -- node
| TN (a,[[a]]) -- tip <> node
| NN ([[a]],[[a]]) -- node <> node
deriving Show
instance Monoid (T a) where
mempty = N [] -- (tip <> node <> node) is what we actually want
mappend (T a) (N as) = TN (a,as) -- tip <> node
mappend (N as) (N bs) = NN (as,bs) -- node <> node
mappend (T a) (NN ([],[])) = N ([[a]]) -- tip <> (node <> node)
mappend (T a) (NN (as,bs)) = N (map (a:) as ++ map (a:) bs)
mappend (TN (a,[])) (N []) = N ([[a]]) -- (tip <> node) <> node
mappend (TN (a,as)) (N bs) = N (map (a:) as ++ map (a:) bs)
allPaths :: Tree a -> [[a]]
allPaths (foldMap T -> N ps) = ps
The allPaths function definition uses ViewPatterns. Testing,
> allPaths $ NodeT 1 (NodeT 2 (NodeT 3 EmptyT EmptyT) EmptyT)
(NodeT 5 EmptyT EmptyT)
[[1,2,3],[1,5]]
> allPaths $ NodeT 1 (NodeT 2 (NodeT 3 EmptyT EmptyT) (NodeT 4 EmptyT EmptyT))
(NodeT 5 EmptyT EmptyT)
[[1,2,3],[1,2,4],[1,5]]
(tip <> node <> node) is what we really want, but <> is binary, and we don't know (and shouldn't rely on it if we did) the actual order in which the parts will be combined into the whole by the derived definition of foldMap,
foldMap T EmptyT == N []
foldMap T (NodeT a lt rt) == T a <> foldMap T lt <> foldMap T rt
-- but in what order?
So we "fake", it by delaying the actual combination until all three parts are available.
Or we could forgo the derivation route altogether, use the above laws as the definition of a custom foldMap with a ternary combination, and end up with ... the equivalent of the recursive code in the other answer -- much shorter overall, without the utilitarian cruft of one-off auxiliary types that need to be hidden behind module walls, and self-evidently non-partial, unlike what we've ended up with, here.
So maybe it's not so great. I'll post it anyway, as a counterpoint.
Related
I am currently doing an assigment for a class in which I have to implement a function which checks if an element is in a tree.
It is supposed to return Nothing when the element is not in the tree and Just (depth at which it was found) when it is.
An example:
sample1
##1
#3 2
###7 5 6 4
- contains 6 sample1 returns Just 2
- contains 1 sample1 returns Just 0
- contains 2 sample1 returns Just 1
- contains 8 sample1 returns Nothing
Here is what we are given:
Heap functional data structure:
module Fdata.Heap where
-- A signature for min-heaps
data Heap e t = Heap {
empty :: t e,
insert :: e -> t e -> t e,
findMin :: t e -> Maybe e,
deleteMin :: t e -> Maybe (t e),
merge :: t e -> t e -> t e,
contains :: e -> t e -> Maybe Int
}
An implementation of self-adjusting heaps:
import Fdata.Heap
import Fdata.Tree
-- An implementation of self-adjusting heaps
heap :: (Eq e, Ord e) => Heap e Tree
heap = Heap {
empty = Empty,
insert = \x t -> merge' (Node x Empty Empty) t,
findMin = \t -> case t of
Empty -> Nothing
(Node x _ _) -> Just x,
deleteMin = \t -> case t of
Empty -> Nothing
(Node _ l r) -> Just (merge' r l),
merge = \l r -> case (l, r) of
(Empty, t) -> t
(t, Empty) -> t
(t1#(Node x1 l1 r1), t2#(Node x2 l2 r2)) ->
if x1 <= x2
then Node x1 (merge' t2 r1) l1
else Node x2 (merge' t1 r2) l2,
contains = \x t -> case (x,t) of
(x,Empty)-> Nothing
(x,tx#(Node x1 l1 r1) ->
|x==x1 = Just 0
|x>x1 = (1+ (contains x l)
|x<x1 = (1+ (contains x r)
}
where
merge' = merge heap
The tree implementation
module Fdata.Tree where
import Fdata.Heap
data Tree x
= Empty
| Node x (Tree x) (Tree x)
deriving (Eq, Show)
leaf x = Node x Empty Empty
-- Convert a list to a heap
list2heap :: Heap x t -> [x] -> t x
list2heap i = foldl f z
where
f = flip $ insert i
z = empty i
-- Convert a heap to a list
heap2list :: Heap x t -> t x -> [x]
heap2list i t
= case (findMin i t, deleteMin i t) of
(Nothing, Nothing) -> []
(Just x, Just t') -> x : heap2list i t'
I am supposed to implement the contains function in the implementation for self-adjusting heaps.
I am not allowed to use any helper functions and I am supposed to use the maybe function.
My current implementation:
contains = \x t -> case (x,t) of
(x,Empty) -> Nothing
(x,tx#(Node x1 l1 r1))
|x==x1 -> Just 0
|x>x1 -> (1+ (contains x l1)
|x<x1 -> (1+ (contains x r1)
This does not work, since I get a parse error on input |.
I really dont know how to fix this since I did use 4 spaces instead of tabs and according to this: https://wiki.haskell.org/Case
the syntax is correct...
I once managed to fix this, but I got a type error about (1+ (contains x l), so this probably is not correct.
Any hint would be appreciated.
EDIT:
Thanks to everyone who answered!
Really appreciate that everyone took the time to explain their answers in great detail.
First of all:
there were some smaller mistakes, as pointed out by some of you in the comments:
I missed one closing parenthesis and accidentially named one argument l1 and another r1 and afterwards used r and l.
Fixed both mistakes.
Someone wrote that I do not need to use a lambda function. The problem is when I use something like:
contains _ Empty = Nothing
I get the error:
parse Error on input '_'.
However, lambda functions do not give me any errors about the input arguments.
Currently the only function that works without any errors is:
contains = \e t -> case (e,t) of
(_,Empty) -> Nothing
(e , Node x t1 t2) ->
if e == (head (heap2list heap (Node x t1 t2)))
then Just 0
else if (fmap (+1) (contains heap e t1))== Nothing
then (fmap (+1) (contains heap e t2))
else (fmap (+1) (contains heap e t1))
Found at:
Counting/Getting "Level" of a hierarchical data
Found by:Krom
One way of structuring contains :: Eq a => a -> Tree a -> Maybe Integer is to first label each element in your tree with its depth, using something like this, then fold the tree to find the element you're looking for, pulling its depth out with it. You can do this without very much code!
Jumping right in where this answer left off, here's contains.
contains :: Eq a => a -> Tree a -> Maybe Integer
contains x = fmap fst . find ((== x) . snd) . labelDepths
That's the whole function! This is classic functional programming style: rather than hand-crank a bespoke recursive tree traversal function I've structured the code as a pipeline of reusable operations. In Haskell pipelines are constructed using the composition operator (.) and are read from left to right. The result of labelDepths is passed to find ((== x) . snd), whose result is then passed to fmap fst.
labelDepths :: Tree a -> Tree (Integer, a), which I've explained in detail in the answer I linked above, attaches an Integer depth to each element of the input tree.
find :: Foldable t => (a -> Bool) -> t a -> Maybe a is a standard function which extracts the first element of a container (like a tree, or a list) that satisfies a predicate. In this instance, the Foldable structure in question is a Tree, so t ~ Tree and find :: (a -> Bool) -> Tree a -> Maybe a. The predicate I've given to find is ((== x) . snd), which returns True if the second element of its input tuple equals x: find ((== x) . snd) :: Tree (Integer, a) -> Maybe (Integer, a). find works by folding the input structure - testing its elements one at a time until it finds one that matches the predicate. The order in which elements are processed is defined by the container's Foldable instance, of which more below.
fmap :: Functor f => (a -> b) -> f a -> f b is another standard function. It applies a mapping function uniformly to each element of a container, transforming its elements from type a to type b. This time the container in question is the return value of find, which is a Maybe, so fmap :: (a -> b) -> Maybe a -> Maybe b. The mapping function I've supplied is fst, which extracts the first element of a tuple: fmap fst :: Maybe (Integer, a) -> Maybe Integer.
So putting it all together, you can see that this is a fairly direct implementation of my English description of the process above. First we label every element in the tree with its depth, then we find an element which matches the item we're looking for, then we extract the depth with which the element was previously labelled.
I mentioned above that Tree is a Foldable container. In fact, this isn't the case quite yet - there's no instance of Foldable for Tree. The easiest way to get a Foldable instance for Tree is to turn on the DeriveFoldable GHC extension and utter the magic words deriving Foldable.
{-# LANGUAGE DeriveFoldable #-}
data Tree x = Empty | Node x (Tree x) (Tree x) deriving Foldable
This automatically-implemented instance of Foldable will perform a preorder traversal, processing the tree in a top-down fashion. (x is considered to be "to the left of" l and r in the expression Node x l r.) You can adjust the derived traversal order by adjusting the layout of the Node constructor.
That said, I'm guessing that this is an assignment and you're not allowed to modify the definition of Tree or apply any language extensions. So you'll need to hand-write your own instance of Foldable, following the template at the bottom of this post. Here's an implementation of foldr which performs a preorder traversal.
instance Foldable Tree where
foldr f z Empty = z
foldr f z (Node x l r) = f x (foldr f (foldr f z r) l)
The Node case is the interesting one. We fold the tree from right to left (since this is a foldr) and from bottom to top. First we fold the right subtree, placing z at the rightmost leaf. Then we use the aggregated result of the right subtree as the seed for folding the left subtree. Finally we use the result of folding all of the Node's children as the aggregator to apply to f x.
Hopefully you didn't find this answer too advanced! (Happy to answer any questions you have.) While the other answers do a good job of showcasing how to write recursive tree traversal functions, I really wanted to give you a glimpse of the real power of functional programming. When you think at a higher level - breaking down a problem into its component parts, structuring operations as pipelines, and learning to spot common patterns like zipping, folding and mapping - you can be very productive and solve problems with very little code.
An instance of Foldable for a binary tree
To instantiate Foldable you need to provide a definition for at least foldMap or foldr.
data Tree a = Leaf
| Node (Tree a) a (Tree a)
instance Foldable Tree where
foldMap f Leaf = mempty
foldMap f (Node l x r) = foldMap f l `mappend` f x `mappend` foldMap f r
foldr f acc Leaf = acc
foldr f acc (Node l x r) = foldr f (f x (foldr f acc r)) l
This implementation performs an in-order traversal of the tree.
ghci> let myTree = Node (Node Leaf 'a' Leaf) 'b' (Node Leaf 'c' Leaf)
-- +--'b'--+
-- | |
-- +-'a'-+ +-'c'-+
-- | | | |
-- * * * *
ghci> toList myTree
"abc"
The DeriveFoldable extension allows GHC to generate Foldable instances based on the structure of the type. We can vary the order of the machine-written traversal by adjusting the layout of the Node constructor.
data Inorder a = ILeaf
| INode (Inorder a) a (Inorder a) -- as before
deriving Foldable
data Preorder a = PrLeaf
| PrNode a (Preorder a) (Preorder a)
deriving Foldable
data Postorder a = PoLeaf
| PoNode (Postorder a) (Postorder a) a
deriving Foldable
-- injections from the earlier Tree type
inorder :: Tree a -> Inorder a
inorder Leaf = ILeaf
inorder (Node l x r) = INode (inorder l) x (inorder r)
preorder :: Tree a -> Preorder a
preorder Leaf = PrLeaf
preorder (Node l x r) = PrNode x (preorder l) (preorder r)
postorder :: Tree a -> Postorder a
postorder Leaf = PoLeaf
postorder (Node l x r) = PoNode (postorder l) (postorder r) x
ghci> toList (inorder myTree)
"abc"
ghci> toList (preorder myTree)
"bac"
ghci> toList (postorder myTree)
"acb"
This function doesn't need to be a lambda:
contains x t =
Adding x to the case serves no purpose, since you only match it back to x. You can instead use pattern matching in the function head:
contains _ Empty = Nothing
The Node case has three sub-cases, where the value being searched for is less-than, greater-than, or equal to the value in the Node. If you order them that way, you get a symmetry from the less-than and greater-than tests, and can handle the equal case with an otherwise.
When recusring, you are going to get a Maybe Int, to which you want to add one. You can't do that directly because the Int is inside the Maybe. Normally, you would lift the addition, but I suspect that this is where the required call to maybe should go (however unnatural it may seem):
contains x (Node x' l r) | x < x' = maybe Nothing (Just . (+1)) $ contains x l
| x > x' = maybe Nothing (Just . (+1)) $ contains x r
| otherwise = Just 0
Instead of using maybe, the (+1) could have been lifted into the Maybe with fmap (or <$>):
... = fmap (+1) $ contains ...
Using maybe is unnatural because it has to explicitly pass the Nothing, and also re-wrap the Just.
This does not work, since I get a parse error on input |
Your previous line misses a closing parenthesis.
I got a Typ error about (1+ (contains x l)), so this probably is not correct.
The idea is totally correct, the issue is that contains x l returns a Maybe Int instead of an Int so you cannot directly add to that. You can only add to the result when it's a Just. There's a helper function that does exactly that, do something to Justs and keep Nothings: fmap (from Functor).
contains = \x t -> case (x,t) of
(x,Empty)-> Nothing
(x,tx#(Node x1 l1 r1))
|x==x1 -> Just 0
|x>x1 -> fmap (1+) (contains x l)
|x<x1 -> fmap (1+) (contains x r)
Btw, I'd write this as
contains x Empty = Nothing
contains x (Node v l r) = if x == v
then Just 0
else fmap (+1) $ contains x $ if x > v then l else r
This question already has an answer here:
Can this implementation of in-order traversal of a binary tree be improved?
(1 answer)
Closed 6 years ago.
data Tree a = Node a (Tree a) (Tree a) | Empty
toList :: (Tree a) -> [a]
toList (Node v l r ) = (toList l) ++ [v] ++ (toList r)
toList Empty = []
As we know it is not optimal because every ++ is connected with O(n) operations for concatenation of lists. The alternative solution is to use : instead of ++. But it causes error because of the fact toList Empty = []. So how to make optimal my solution?
You can't do it directly, since : only prepends a single element to a list. But in both child-branches you'll usually give multiple elements. The slow recursive implementation is needed to get around precisely this!
So, the way to go is to use a container with a more efficient concatenation operation! Such are available in libraries, e.g. sequence. But there is one container type that you can very quickly brew up yourself:
newtype DList a = DList { getDList :: [a] -> [a] }
instance Monoid (DList a) where
mempty = DList id
mappend (DList l1) (DList l2) = DList $ l1 . l2
singletonD :: a -> DList a
singletonD x = DList (x:)
With this, you can do
toDList :: Tree a -> DList a
toDList (Node v l r) = toDList l <> singletonD v <> toDList r
toDList Empty = mempty
This is an exact translation of your definition, but it won't have the same performance problem as when you concatenate ordinary lists.
Because these difference lists are so easy to implement, it's quite common in Haskell to just do it inline without further mention:
toList :: (Tree a) -> [a]
toList t = tdl t []
where tdl (Node v l r) = toList l . (v:) . tdl r
tdl Empty = id
You need to put things together differently to accomplish your goal. You can't just replace ++ with :. Try this:
toList t = toListPlus t []
toListPlus :: Tree a -> [a] -> [a]
toListPlus t xs should produce toList t ++ xs, but implemented with recursive calls to toListPlus, not using ++ or toList. Let's work through it. The base case is easy:
toListPlus Empty xs = xs
The recursive case isn't too bad either. We want to convert the left subtree to a list, sticking other stuff on after:
toListPlus (Node v l r) xs =
toListPlus l ???
What comes after? The root, and then the result of converting the right subtree, and then whatever gets tacked on:
toListPlus (Node v l r) xs =
toListPlus l (v : toListPlus r xs)
This function uses an implicit stack to keep track of the remaining work. This is probably the most efficient way to do it. If you wanted, you could use a zipper-style representation to make the stack explicit.
How does this solution relate to the one leftaroundabout described? Well, they're actually the same. We can see that by shifting the list argument over:
toListPlus Empty = \xs -> xs
toListPlus (Node v l r)
= \xs -> toListPlus l (v : toListPlus r xs)
= toListPlus l . (v :) . toListPlus r
I wrote a straightforward in-order-traversal function (toList1) for a binary tree. However, I worry about its complexity (memory / time). Is there a better way to implement it?
data Tree a = Empty | Node a (Tree a) (Tree a)
toList1 :: (Tree a) -> [a]
toList1 Empty = []
toList1 (Node x lx rx) = (toList lx) ++ [x] ++ (toList rx)
Haskell's append ++ performs linearly in the length of its left argument, which means that you may get quadratic performance if the tree leans left.
One possibility would be to use difference list.
Another one would be to define a Foldable instance:
data Tree a = Empty | Node a (Tree a) (Tree a)
instance Foldable Tree where
foldr f z Empty = z
foldr f z (Node a l r) = foldr f (f a (foldr f z r)) l
then, in-order-traversal comes out naturally:
toList :: Tree a -> [a]
toList = foldr (:) []
and
\> let tr = Node "root" (Node "left" Empty Empty) (Node "right" Empty Empty)
\> toList tr
["left","root","right"]
I'm trying to figure out how to calculate the depth of a general tree in Haskell. I can figure out the solution for simple binary trees, but not for general trees with any number of leaves.
Here's the code I have for binary trees.
--depth of a binary tree.
depth :: Tree a -> Int
depth Nil = 0
depth (Node n x1 x2) = 1 + max (depth x1) (depth x2)
How can I modify this for general trees? General trees contain a list of trees, and that is where I am encountering difficulty.
Secondly, I want to turn the tree into a list (so I can do operations such as calculating the sum, etc.)
Again, I can figure it out for binary trees but not for general trees.
--tree into a list.
treeToList:: Tree a -> [a]
treeToList Nil = []
treeToList (Node n x1 x2)
= collapse x1 ++ [n] ++ collapse x2
Use Foldable to get single values out, use Functor to map functions
user2407038's good answer shows you how to write a Foldable instance by hand, which is very good advice, and you can use foldMap not just to make treeToList, but also to make handy other functions.
GHC lets you derive these instances automatically:
{-# LANGUAGE DeriveFunctor, DeriveFoldable #-}
import Data.Monoid
import Data.Foldable
data Tree a = Node a [Tree a]
deriving (Show,Functor,Foldable)
Let's use an example to test this out:
example :: Tree Int
example = Node 3 [Node 2 [], Node 5 [Node 2 [],Node 1 []],Node 10 []]
-- 3
-- |
-- +--+-----+
-- 2 5 10
-- |
-- +--+
-- 2 1
Let's use fmap to multiply everything by 10:
> example
Node 3 [Node 2 [], Node 5 [Node 2 [], Node 1 []], Node 10 []]
> fmap (*10) example
Node 30 [Node 20 [],Node 50 [Node 60 [],Node 10 []],Node 100 []]
Use a Monoid to combine values
A Monoid lets you combine (mappend) values, and has a do-nothing/identity value called mempty.
Lists are a Monoid, with mempty = [] and mappend = (++), numbers are moinoids in more than one way, for example, using (+) (the Sum monoid), using (*) (the Product monoid), using maximum (I had to hand-write the Max monoid).
We'll use foldMap to tag the Ints with what monoid we want to use:
> foldMap Sum example
Sum {getSum = 23}
> foldMap Product example
Product {getProduct = 600}
> foldMap Max example
Max {unMax = 10}
You can define your own monoid however you like - here's how to make the Max monoid:
instance (Ord a,Bounded a) => Monoid (Max a) where
mempty = Max minBound
mappend (Max a) (Max b) = Max $ if a >= b then a else b
The most general fold you can make
In this great question with great answers, Haskell's top asker, MathematicalOrchid asks how to generalise fold to other data types. The answers to the question are great and worth reading.
A generalised fold simply replaces each constructor of the data type with a function and evaluates to get a value.
The hand-rolled way is to look at the types of each of the constructors, and make a function that takes a function argument to match each constructor and an argument for the object itself, and returns a value.
Examples:
[] has two constructors, (:) :: a -> [a] -> [a] and [] :: [a] so
foldList :: (a -> l -> l) -> l -> [a] -> l
foldList useCons useEmpty = f where
f (a:as) = useCons a (f as)
f [] = useEmpty
Either a b has two constructors, Left :: a -> Either a and Right :: a -> Either so
foldEither :: (a -> e) -> (b -> e) -> Either a b -> e
foldEither useLeft useRight = f where
f (Left a) = useLeft a
f (Right b) = useRight b
Generalised fold for your tree
generalFold :: (a -> [t] -> t) -> Tree a -> t
generalFold useNode = f where
f (Node a ts) = useNode a (map f ts)
we can use that to do pretty much anything we want to to a tree:
-- maximum of a list, or zero for an empty list:
maxOr0 [] = 0
maxOr0 xs = maximum xs
height :: Tree a -> Int
height = generalFold maxPlus1 where
maxPlus1 a as = 1 + maxOr0 as
sumTree = generalFold sumNode where
sumNode a as = a + sum as
productTree = generalFold productNode where
productNode a as = a * product as
longestPath = generalFold longest where
longest a as = a + maxOr0 as
Let's test them:
ghci> example
Node 3 [Node 2 [],Node 5 [Node 2 [],Node 1 []],Node 10 []]
ghci> height example
3
ghci> sumTree example -- 3 + sum[2, 5+sum[2,1], 10] = 3+2+5+2+1+10
23
ghci> productTree example -- 3*(2*(5*(2*1))*10) = 3*2*5*2*1*10
600
ghci> longestPath example -- 3 + maximum [2, 5+maximum[2,1], 10]
13
ghci> toList example -- 3 : concat [[2], 5:concat[[2],[1]], [10]]
[3,2,5,2,1,10]
Think about generalizing the pattern to lists:
data Tree a = Node a [Tree a] | Nil
depth Nil = 0
depth (Node _ [a]) = 1 + depth a
depth (Node _ [a,b]) = 1 + max (depth a) (depth b)
depth (Node _ [a,b,c]) = 1 + max (max (depth a) (depth b)) (depth c)
etc...
Well, all you are doing is finding the depth of each subtree (map depth), then finding the maximum of those numbers (maximum):
depth Nil = 0
depth (Node _ a) = 1 + maximum (map depth a)
You can flatten the tree in the same way, just map over the subtrees:
treeToList (Node n a) = n : concat (map treeToList a)
You have to use concat because map collapse returns a list of lists and you just want a list. Alternatively, you can define an instance for the Foldable typeclass and you automatically get toList :: Foldable t => t a -> [a]
import Data.Foldable
import Data.Monoid
instance Foldable Tree where
foldMap f Nil = mempty
foldMap f (Node a n) = f a `mappend` mconcat (map foldMap n)
If you scrutinize the definition of foldMap very carefully, you will see that it is just a more general treeToList, where : is replaced by mappend and [] by mempty. Then it is logical that you can write treeToList in terms of the monoid ([], ++):
data List a = List {getList :: [a]}
instance Monoid (List a) where
mempty = List []
mappend (List a) (List b) = List (a ++ b)
treeToList = getList . foldMap (List . (:[]))
A few pointers:
Take a look at the map function which allows you to apply a function to each element in a list. In your case you want to apply depth to each Tree a in the list of children.
After you get that part you have to find the max depth in the list. Do a google search for "haskell max of list" and you'll find what you need.
I have a structure for a tree and I want to print the tree by levels.
data Tree a = Nd a [Tree a] deriving Show
type Nd = String
tree = Nd "a" [Nd "b" [Nd "c" [],
Nd "g" [Nd "h" [],
Nd "i" [],
Nd "j" [],
Nd "k" []]],
Nd "d" [Nd "f" []],
Nd "e" [Nd "l" [Nd "n" [Nd "o" []]],
Nd "m" []]]
preorder (Nd x ts) = x : concatMap preorder ts
postorder (Nd x ts) = (concatMap postorder ts) ++ [x]
But how to do it by levels? "levels tree" should print ["a", "bde", "cgflm", "hijkn", "o"].
I think that "iterate" would be suitable function for the purpose, but I cannot come up with a solution how to use it. Would you help me, please?
You just need to compute the levels for all of the subtrees and zip them all together after the root:
levels :: Tree [a] -> [[a]]
levels (Nd a bs) = a : foldr (zipWith' (++)) [] (map levels bs)
Sadly, zipWith doesn't do the right thing, so we can instead use:
zipWith' f xs [] = xs
zipWith' f [] xs = xs
zipWith' f (x:xs) (y:ys) = f x y : zipWith' f xs ys
Update: there is some concern (which I agree with) that what you originally asked is a little weird as it's not a generic breadth-first tree to list convertor. What you probably really want is to concat the result of:
levels' (Nd a bs) = [a] : foldr (zipWith' (++)) [] (map levels' bs)
I'm guessing this is homework. On the assumption that it is, then here's some ideas for how to think about the problem that might lead you to an answer:
In preorder, first the current item is "reported", then recurse for all this node's tails. In postorder these two steps are done in reverse. In both cases, the recursion is "local", in the sense that it only need deal with one node at a time. Is this true for levelorder? Or to ask it another way, when levelorder recurses, do the results of the recursions interact or no? If so, then, what is the "unit" of recursion, if not a single Tree?
Understanding the nature of the recursion (or iteration..?) of levelorder will lead you to a solution that very simple and elegant. My version is only three lines long!
By the way, it might be nice to have these utility functions to make the code even clearer in some places:
element :: Tree a -> a
element (Nd x _) = x
subtrees :: Tree a -> [Tree a]
subtrees (Nd _ s) = s
Or, if you are familiar with record syntax in Haskell, you can achieve exactly this by changing your original Tree definition to:
data Tree a = Nd { element :: a, subtrees :: [Tree a] }
deriving Show
A full solution:
The key is realizing that levelorder requires recursion on a list of Tree. At each step the elements from each Tree is extracted, and the next step is upon the concatenation of the subtrees:
levelorder :: Tree a -> [a]
levelorder t = step [t]
where step [] = []
step ts = map element ts ++ step (concatMap subtrees ts)
This produces the elements in a single, flattened list, much like preorder and postorder do, and is the usual definition of a breadth-first traversal.
If instead you really want the elements grouped by level, a single change of the ++ operator to : will yield that version:
bylevel :: Tree a -> [[a]]
bylevel t = step [t]
where step [] = []
step ts = map element ts : step (concatMap subtrees ts)
Note: I have given type signatures for all top-level functions. This is a really good habit to get into, and will save you considerable time debugging.
Here is another version which can be applied to Tree a instead of Tree [a].
levelorder :: Tree a -> [[a]]
levelorder (Nd x ts) = [x]:(ziplist (map levelorder ts))
ziplist :: [[[a]]] -> [[a]]
ziplist l = if null ls then [] else (concat heads):(ziplist tails)
where
ls = filter (not.null) l
heads = map head ls
tails = map tail ls
If you want to concatenate the strings at the end you may use:
levelorder2 :: Tree [a] -> [[a]]
levelorder2 = (map concat).levelorder
levels :: (Tree a) -> [[a]]
levels (Nd x ts) = [[x]] ++ levelshelper ts
level2 = (map concat).levels
levelshelper :: [Tree a] -> [[a]]
levelshelper [] = []
levelshelper xs = (map (\(Nd x ts) -> x) xs) : (levelshelper (extractl xs))
--get the next level's Nd's
extractl :: [Tree a] -> [Tree a]
extractl [] = []
extractl ((Nd x ts):xs) = ts ++ (extractl xs)
My approach turned out being a bit more ham-handed than I wanted. Correct me if I'm wrong, though, since strings are lists of characters, but you're using polymorphic types, is it really so straightforward to to print your results out like specified in the problem? This code produces lists of lists of strings. ***Props to Chris in his more elegant answer for reminding me about the use of concat!!
You can repeat [] for empty list so that you don't get the problem with zipWith
levels :: Tree a -> [[a]]
levels Empty = repeat []
levels (Branch x l r) = [x] : zipWith (++) (levels l) (levels r)