My tree looks like this, a tree which at each node can or cannot have an integer:
data Tree = Empty | Node (Maybe Integer) Tree Tree deriving Show
I want to sum all the values in the tree, not including Nothing values and if tree is not empty but has only Nothing values, just return Nothing, or empty tree is 0. These cases I understand how to.
I want thinking depth first traversal would be best, or just some basic traversal in general, but struggling on how to implement it elegantly.
treeValues :: Tree -> Maybe Integer
You can make your Tree a Foldable instance, and you get many functions for free, including sum:
sum :: (Foldable t, Num a) => t a -> a Source
The sum function computes the sum of the numbers of a structure.
But you need to make your Tree a parametric type:
data Tree a = Empty | Node (Maybe a) Tree Tree
Also, with GHC 7.10, almost all Prelude functions will use Foldable and Traversable typeclasses instead of lists, and then you can use them freely for your tree, if you implement those typeclasses.
You already know how to sum lists, so you could transform your tree into a list first:
> toList :: Tree -> [Integer]
> toList Empty = []
> toList (Node a l r) = maybeToList a ++ toList l ++ toList r
> where maybeToList (Just x) = [x]
> maybeToList Nothing = []
Now, you want to differ between an empty tree (Empty) and a tree that contains only Nothing. Since toList filters all Nothing values, this boils down to
> sumTree :: Tree -> Maybe Integer
> sumTree Empty = Just 0
> sumTree tree = case toList tree of
> [] -> Nothing -- all values in the tree are Nothing
> xs -> Just $ sum xs -- some were Just x
But wait, there's more!
sumTree isn't that nice yet. What if we want to compute the product of a Tree? Hm. Well, we can take a tree, transform it to a list, and use… a folding function!
> type I = Integer -- otherwise the lines get ridiculously long
>
> foldrTree' :: (I -> I -> I) -> I -> Tree -> Maybe I
> foldrTree' _ init Empty = init
> foldrTree' f init tree = case toList tree of
> [] -> Nothing
> xs -> Just $ foldr f init xs
> -- ^^^^^
Now we can take any (Integer -> Integer -> Integer) and produce a single value, as long as our operation is associative:
> productTree :: Tree -> Maybe Integer
> productTree = foldrTree' (*) 1
>
> sumTree' :: Tree -> Maybe Integer
> sumTree' = foldrTree' (+) 0
Here's a hint:
data Tree a = Empty | Node a (Tree a) (Tree a)
reduce :: (a -> r -> r -> r) -> r -> Tree a -> r
reduce f z = go
where
go Empty = z
go (Node x l r) = f x (go l) (go r)
Regarding the above solutions and comments plus lyah and Brent Yorgeys advice I compiled the following proposal (try as you might like in ghci):
:set -XDeriveFoldable -XDeriveFunctor
:m + Data.Foldable Data.Monoid
data Tree a = Empty | Node (Maybe a) (Tree a) (Tree a) deriving (Show, Functor, Foldable)
let tree :: Tree Integer ; tree = Node Nothing (Node (Just 42) Empty Empty) (Node Nothing Empty Empty)
foldMap Sum tree
It though returns only 0 in both cases only Nothing values given and tree is Empty but I hope it gives a hint later for learners like me.
Related
Basically, I'm trying to insert elements from the list into the binary tree one by one, or that's what I thought it should be done when inserting list to the tree.
Here is my tree for inserting:
data Tree = EmptyTree | Node Integer Tree Tree deriving (Show, Eq, Ord)
insertElement x EmptyTree = Node x EmptyTree EmptyTree
insertElement x (Node a left right) = if x == a
then (Node x left right)
else if x < a
then (Node a (insertElement x left) right)
else
Node a left (insertElement x right)
and I thought I could use map to get elements from list and insert it into the list.
Something like this: inserter x = map (insertElement x EmptyTree)
where I get list with inserter and insert it into the list.
But, this code is pretty much incorrect I think, and I was wondering how can I do this?
If you would use inserter xs = map (`insertElement` EmptyTree) you will create a list of trees where each item is inserted once.
What you can do is use foldl :: Foldable t => (b -> a -> b) -> b -> t a -> b or foldr :: Foldable t => (a -> b -> b) -> b -> t a -> b to each time pass the accumulator, the thus far build up list, and thus insert the next item, so:
inserter :: Foldable f => f Integer -> Tree
inserter = foldr insertElement EmptyTree
or:
inserter :: Foldable f => f Integer -> Tree
inserter = foldl (flip insertElement) EmptyTree
It might however make more sense to allow to specify the base tree, and thus using inserter to insert a Foldable of items to a Tree that might already contain items, for example:
inserter :: Foldable f => Tree -> f Integer -> Tree
inserter = foldl (flip insertElement)
I really like the repmin problem:
Write down repmin :: Tree Int -> Tree Int, which replaces all the numbers in the tree by their minimum in a single pass.
If I were writing something like this in python, I would go for passing values by their reference (let's say one-element lists instead of numbers is good enough):
def repmin(tree, wrapped_min_link=None):
x, subforest = tree
if wrapped_min_link is None:
wrapped_min_link = [x]
else:
[m] = wrapped_min_link
wrapped_min_link = [min(m, x)]
n = len(subforest)
subforest_min = [None] * n
for i in range(n):
if subforest[i]:
subforest_min[i] = repmin(subforest[i], wrapped_min_link)
return (wrapped_min_link, subforest_min)
It seems to me like a fitting way to wrap one's head around the knot-tying solution in Haskell (I wrote this one for rose trees from Data.Tree):
copyRose :: Tree Int -> Int -> (Tree Int, Int)
copyRose (Node x []) m = (Node m [], x)
copyRose (Node x fo) m =
let
unzipIdMinimum =
foldr (\ ~(a, b) ~(as, bmin) -> (a:as, b `min` bmin)) ([], maxBound :: Int)
(fo', y) = unzipIdMinimum . map (flip copyRose m) $ fo
in (Node m fo', x `min` y)
repmin :: Tree Int -> Tree Int
repmin = (loop . uncurry) copyRose
Yet, I reckon the solutions to work very differently. Here is my understanding of the latter one:
Let us rewrite loop for (->) a bit:
loop f b = let cd = f (b, snd cd) in fst cd
I reckon it to be loop for (->)'s workalike as snd gives the same degree of laziness as pattern-matching within let.
So, when repmin traverses through the tree, it is:
Building up the minimum in the tree to be returned as the second element of the pair.
Leaves snd $ copyRose (tree, m) behind in every node.
Thus, when the traversal comes to an end, the programme knows the value of snd $ copyRose (tree, m) (that is, the minimum in the tree) and is able to show it whenever some node of the tree is being computed.
Do I understand repmin in Haskell correctly?
This is more an extended comment than an answer, but I don't really think of your implementation as single-pass. It looks like it traverses the tree once, producing a new, lazily-generated, tree and the global minimum, but it actually produces a lazily generated tree and an enormous tree of thunks that will eventually calculate the minimum. To avoid this, you can get closer to the Python code by generating the tree eagerly, keeping track of the minimum as you go.
You'll note that I've generalized the type from Int to an arbitrary Ord type. You'll also note that I've used to different type variables to refer to the type of elements in the given tree and the type of the minimum passed in to generate a new tree—this lets the type system tell me if I mix them up.
repmin :: Tree a -> Tree a
repmin = (loop . uncurry) copyRose
copyRose :: Ord a => Tree a -> b -> (Tree b, a)
copyRose (Node x ts) final_min
| (ts', m) <- copyForest x ts final_min
= (Node final_min ts', m)
copyForest :: Ord a => a -> [Tree a] -> b -> ([Tree b], a)
copyForest !m [] _final_min = ([], m)
copyForest !m (t : ts) final_min
| (t', m') <- copyTree m t final_min
, (ts', m'') <- copyForest m' ts final_min
= (t' : ts', m'')
copyTree :: Ord a => a -> Tree a -> b -> (Tree b, a)
copyTree !m (Node x ts) final_min
| (ts', m') <- copyForest (min m x) ts final_min
= (Node final_min ts', m')
Exercise: rewrite this in monadic style using ReaderT to pass the global minimum and State to keep track of the minimum so far.
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.
I got the task of getting all leafs from a binary tree of this datatype:
data Bintree el = Empty |
Tree {left :: Bintree el, node :: el, right :: Bintree el} deriving Show
Now I have this Treefold function which works perfectly in tests:
binTreeFold :: (a -> b -> a -> a) -> a -> Bintree b -> a
binTreeFold f el Empty = el
binTreeFold f el tree#(Tree leftTree node rightTree) = f (binTreeFold f el leftTree) node (binTreeFold f el rightTree)
And I try to get all leafs but somehow it simply doesnt work (Compile issues mentioned below):
leavesWithFold :: Bintree a -> [a]
leavesWithFold Empty = []
leavesWithFold tree = binTreeFold (\left -> \node -> \right -> if (checkIfTreeIsLeaf node) then left ++ [node] ++ right else left ++ [] ++ right) [] tree
using the following function:
checkIfTreeIsLeaf :: Bintree a -> Bool
checkIfTreeIsLeaf Empty = False
checkIfTreeIsLeaf (Tree Empty node Empty) = True
checkIfTreeIsLeaf _ = False
The compiler tells me
Couldn't match type `a' with `Bintree a0'
But in former functions the use of
left ++ [node] ++ right
Was working perfectly fine. Have you any idea what I did wrong and probably what I could change?
Best Whishes
Well typically the idea of a using a fold function is that it does all the work for you. So by writing a function that branches into an Empty case and a tree case, this is already a bit strange.
A recursive approach
But let us simply start with a recursive approach. Forget about folding, etc. for now. How would we generate a list of leaves in general?
Well there are basically three cases here:
in case we encounter an Empty, then we return the empty list, since Empty is not a leaf, and we are supposed to return all leaves, so:
leaves Empty = []
in case we encounter a Tree with Empty both as left and right subtree, we know that that Tree is a leaf, so we return the element it carries, as a list:
leaves (Tree Empty x Empty) = [x]
in case one of the two subtrees (or both) are not Empty, we recursively would call the leaves function, and concatenate the two together:
leaves (Tree l _ r) = leaves l ++ leaves r
So now in full we got:
leaves :: Bintree a -> [a]
leaves Empty = []
leaves (Tree Empty x Empty) = [x]
leaves (Tree l x r) = leaves l ++ leaves r
How to detect through recursion that this is a leaf
We of course can not do that with the binTreeFold approach. But can't we detect whether a tree is in fact a leaf? In case the two recursive calls both result in an empty list, we know that the current Bintree is in fact a leaf. Indeed: if the left (and right) subtree are Empty, they result in empty lists. And in case these are not empty, then these either are leaves, that will recursively produce a singleton list, or those are not Trees with descendants, that will eventually lead to leaves, and therefore to non-empty lists.
Encoding this in the fold function
So we an first take a look at the recursive calls, and then based on the fact whether these are both empty lists, either return a singleton list with the leaf element, or concatenate the two lists together, like:
f [] x [] = [x]
f l _ r = l ++ r
Or using this in the binTreeFold function:
leavesWithFold :: Bintree a -> [a]
leavesWithFold = binTreeFold f []
where f [] x [] = [x]
f l _ r = l ++ r
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