writing a recursive function to count the depth of a tree - haskell

I have to write a recursive function that, Given a Tree
datatype,will return the depth of the tree. An empty tree should return
0. A single root node Tree should return 1.
expected output:
let treeCons x = (\x -> foldl (flip insertTree) Empty x) x
depth (treeCons []) -> 0
depth (treeCons [5,4,6,3,7,1]) -> 4
depth (treeCons [1,2,5,8,9,4,7]) -> 5
depth (treeCons [5,4,6,3,7,1,2,5,8,9,4,7,8,5,3,4]) -> 6
I wrote the following datatype and insert function:
data Tree a = Node a (Tree a) (Tree a) | Empty deriving (Show, Eq)
insertTree :: (Ord a) => a -> Tree a -> Tree a
insertTree a Empty = Node a Empty Empty
insertTree a (Node b Empty Empty) = if (a <= b) then (Node b (Node a Empty Empty) Empty) else (Node b Empty (Node a Empty Empty))
insertTree a (Node b left right) = if (a <= b) then (Node b (insertTree a left) right ) else (Node b left (insertTree a right))
However, I'm not getting how to write depth function.I'm very new in haskell and I'll appreciate if someone helps me.

An empty tree has depth 0, and a node has depth 1 plus the maximum depth of its child nodes:
depth :: Tree a -> Int
depth Empty = 0
depth (Node _ l r) = 1 + max (depth l) (depth r)

Here you go, is very simple, recursing through a list and a Tree is about the same, only the data types differ. Where you add 1 every time you hit a branch of the tree in question:
tDepth :: Tree a -> Int
tDepth Empty = 0
tDepth (Node _ left right) = 1 + max (tLength left) (tLength right)

Related

BST: how to define `insert` in terms of catamorphic fold?

I have a typical binary search tree data type:
data Tree a
= Empty
| Branch a (Tree a) (Tree a) deriving Show
and a catamorphism
foldt :: b -> (a -> b -> b -> b) -> Tree a -> b
foldt empty _ Empty = empty
foldt empty branch (Branch a l r) = branch a (foldt empty branch l) (foldt empty branch r)
I tried to define an insert function using foldt and got some interesting results:
insert :: (Ord a) => a -> Tree a -> Tree a
insert x = foldt (single x) insertb
where insertb a left right
| x == a = Branch x left right
| x < a = Branch a (insert x left) right
| x > a = Branch a left (insert x right)
ghci> mytree = insert 2 (Branch 3 Empty Empty)
ghci> mytree
Branch 3 (Branch 2 (Branch 2 Empty Empty) (Branch 2 Empty Empty)) (Branch 2 Empty Empty)
ghci>
Of course, a traditional insert method behaves as expected:
insert' :: (Ord a) => a -> Tree a -> Tree a
insert' x Empty = single x
insert' x (Branch a left right)
| x == a = Branch x left right
| x < a = Branch a (insert' x left) right
| x > a = Branch a left (insert' x right)
ghci> mytree2 = insert' 2 (Branch 3 Empty Empty)
ghci> mytree2
Branch 3 (Branch 2 Empty Empty) Empty
ghci>
Is there a way to define insert in terms of foldt, or am I barking up the wrong tree (ha) here?
Let's define a function
insertMaybe :: Ord a => Tree a -> Maybe a -> Tree a
This function takes a tree, and maybe an element. In the Just case, the element is inserted. In the Nothing case, the tree is returned unchanged. So then we can define
insert a t = insertMaybe t (Just a)
Now:
insertMaybe :: Ord a => Tree a -> Maybe a -> Tree a
insertMaybe = foldt leaf branch
where
leaf (Just new) = ?
leaf Nothing = ?
branch a l r Nothing = ?
branch a l r (Just new)
| ... = ?
...
Alternatively:
data Ins a = Ins
{ inserted :: Tree a
, notInserted :: Tree a }
insert a t = inserted (insertAndNot a t)
-- Return the tree with the
-- element inserted, and also unchanged.
insertAndNot :: Ord a => a -> Tree a -> Ins a
insertAndNot new = foldt leaf branch
where
leaf = Ins ? ?
branch a ~(Ins li lni) ~(Ins ri rni)
| ... = Ins ? ?
...
Paramorphism
The above solutions have a major efficiency problem: they completely rebuild the tree structure just to insert an element. As amalloy suggested, we can fix that by replacing foldt (a catamorphism) by parat (a paramorphism). parat gives the branch function access to both the recursively modified and the unmodified subtrees.
parat :: b -> (a -> (Tree a, b) -> (Tree a, b) -> b) -> Tree a -> b
parat leaf _branch Empty = leaf
parat leaf branch (Branch a l r) =
branch a
(l, parat leaf branch l)
(r, parat leaf branch r)
Conveniently, it's also slightly easier to define insert using parat. Can you see how? This ends up being an efficient version of the "alternative" way I suggested for using foldt.
Thanks to dfeuer and amalloy for the tips on paramorphisms, TIL!
Given a paramorphism for the Tree data type:
parat :: b -> (a -> (Tree a, b) -> (Tree a, b) -> b) -> Tree a -> b
parat empty _ Empty = empty
parat empty branch (Branch a l r) =
branch a
(l, parat leaf branch l)
(r, parat leaf branch r)
we can write an insert function as:
insert :: Ord a => a -> Tree a -> Tree a
insert x = parat (single x) branch
where branch a (l, l') (r, r')
| x == a = Branch x l r
| x < a = Branch a l' r
| x > a = Branch a l r'
ghci> mytree = insert 2 (Branch 3 Empty Empty)
ghci> mytree
Branch 3 (Branch 2 Empty Empty) Empty
ghci>
testing a bigger tree...
import Data.Function
mytree :: Tree Integer
mytree = (Branch 3 Empty Empty) & insert 2 & insert 4 & insert 6 & insert 5 & insert 10
inorder :: Tree a -> [a]
inorder = foldt [] (\a l r -> l ++ [a] ++ r)
ghci> mytree
Branch 3 (Branch 2 Empty Empty) (Branch 4 Empty (Branch 6 (Branch 5 Empty Empty) (Branch 10 Empty Empty)))
ghci> inorder mytree
[2,3,4,5,6,10]
ghci>

check if tree is a subtree of another tree

I am trying to check out if tree is a subtree of another tree. Here is my data for Tree:
data Tree a = Empty | Node a (Tree a)(Tree a) deriving Show
tree1 :: Tree Int
tree1 = Node 1
(Node 2
(Node 4 Empty Empty)
(Node 5 Empty
(Node 8 Empty Empty))
)
(Node 3
(Node 6 Empty
(Node 9 Empty Empty))
(Node 7 Empty Empty)
)
tree2 :: Tree Int
tree2 = Node 2
(Node 4 Empty Empty)
(Node 5 Empty
(Node 8 Empty Empty))
And finally def of unfulfilled function:
isSubTree :: Eq a => Tree a -> Tree a -> Bool
isSubTree _ Empty = False
isSubTree Empty _ = False
isSubTree (Node a l r) (Node b ll rr) |
| otherwise = False
I need a hint how to fulfill first guardian - should i use elem or any other basic function? If I would want to find any specific element in tree I would use code below, so should I somehow modify that code?
treeMember x (Node a l r) |x `elem` [a] = True
|otherwise = treeMember x l || treeMember x r
A tree t1 is a (non-strict) subtree of a tree t2 given the two trees are equal, or t1 is a subtree of one of the (direct) children of t2.
We can let Haskell implement an instance for the Eq typeclass with:
data Tree a = Empty | Node a (Tree a) (Tree a) deriving (Eq, Show)
So now we can implement a check with:
isSubtree :: Eq a => Tree a -> Tree a -> Bool
isSubtree t1 t2 | t1 == t2 = True
isSubtree t1 (Node _ c1 c2) = …
isSubtree _ _ = False
where you still need to fill in the … part. I leave this as an exercise.

Trying a version of takeWhile on trees in Haskell

Given a tree that looks like this:
data Tree a = Leaf | Node (Tree a) a (Tree a)
And a fold function that looks like this:
foldTree :: (b -> a -> b -> b) -> b -> Tree a -> b
foldTree _ b Leaf = b
foldTree fn b (Node lt x rt) = f (foldTree fn b lt) x (foldTree fn b rt)
I want to be able to write a takeWhileTree function that looks like this:
treeTakeWhile :: (a -> Bool) -> Tree a -> Tree a
I want it to mimic the 'normal' list takeWhile function so that it returns the largest possible tree whose elements satisfy the given condition.
So, if a tree t = Node (Node Leaf 10 Leaf) 4 (Node Leaf 5 Leaf), then:
treeTakeWhile (> 5) T = Leaf
treeTakeWhile (>= 4) T = T
treeTakeWhile (< 5) T = Node Leaf 4 Leaf
treeTakeWHile (< 8) T = Node Leaf 4 (Node Leaf 5 Leaf)
So far I seem to not be able to formulate what to pass into foldTree.
In the definition of foldtree, the function can be broken down as: b probably being the left subtree, a probably being the value in the current node and b probably being the right subtree.
Therefore, the function passed to treeTakeWhile has to be applied to all these parts of the node in some manner while being able to stop when the operation no longer applies.
treeTakeWhile fn = foldTree (\xs x ys -> if y then g else Leaf) Node()
where g = (lt, x, rt)
y = fn (Node lt x rt)
The above is clearly wrong but I am not sure how to express the act of applying the function to the current node's value followed by the left tree and the right tree here. Could somebody point me in the right direction? And how will the fold be able to produce the required tree?
Edit 1:
Okay, based on your feedback, I have gotten to a place where I think I am pretty close to the answer but cannot figure out why the compiler still complains:
treeTakeWhile :: (a -> Bool) -> Tree a -> Tree a
treeTakeWhile c = foldTree f acc
where acc = Leaf
f l x r = if c x then Node (f lt) x (f rt) else Leaf
As far as I can tell, foldTree is being passed the right arguments now. And the predicate is also being evaluated as required at each level of the tree. The return value is always of type Tree as well.
Instead of using foldTree immediately, let's first aim to define the function itself.
Basically there are three options here:
the tree is a Leaf, regardless what the condition is, the result is a Leaf as well;
the tree is a Node and the condition is satsified, then we yield the element, and recurse on the subtrees;
the tree is a Node and the condition is not satisfied, then the result is a Leaf.
We can encode these rules as:
treeTakeWhile :: (a -> Bool) -> Tree a -> Tree a
treeTakeWhile c = go
where go Leaf = Leaf -- (1)
go (Node l x r) | c x = Node (go l) x (go r) -- (2)
| otherwise = Leaf -- (3)
this then yields the expected results:
Prelude> treeTakeWhile (>5) t
Leaf
Prelude> treeTakeWhile (>=4) t
Node (Node Leaf 10 Leaf) 4 (Node Leaf 5 Leaf)
Prelude> treeTakeWhile (<5) t
Node Leaf 4 Leaf
Prelude> treeTakeWhile (<8) t
Node Leaf 4 (Node Leaf 5 Leaf)
Moving this to a foldTree
Now we aim to move the logic to a foldTree, we can thus write the function as:
treeTakeWhile :: (a -> Bool) -> Tree a -> Tree a
treeTakeWhile c = foldTree f x0
where f tl x tr = -- ...
x0 = -- ...
The x0 is the value we should fill in for Leafs, but we already know what that is: it is the first rule (1) and we should thus return a Leaf as well.
For f we need a function Tree a -> a -> Tree a -> Tree a. The first operand tl is the treeTakeWhile of the left subtree (this would be equivalent to go l in the original function implementation), the second parameter x is the value encoded in the Node, and the last parameter tr is the result of treeTakeWhile on the second subtree (so equivalent to go r), so:
treeTakeWhile :: (a -> Bool) -> Tree a -> Tree a
treeTakeWhile c = foldTree f x0
where f tl x tr = -- ...
x0 = -- ...
(leave this as an exercise).

Haskell deleting in a binary search tree

So far I have come up with something like this. What I am trying to do here is get the right most or the leftmost element depending on which is available and swapping them with root and deleting the corresponding rightmost or left most element. I just need some help figuring out why it fails when I ask it to delete root of a tree but it works for all other cases and what does Irrefutable pattern failed mean?
If I do something like delt 3 Node 3 (Node 2 (Node 1 Empty Empty) Empty) (Node 4 Empty Empty)
it gives an error like Node *** Exception: delt.hs:26:40-75: Irrefutable pattern failed for pattern (Main.Node rm (Main.Empty) (Main.Empty))
delt 2 a gives Node 3 (Node 1 Empty Empty) (Node 4 Empty Empty)
data Tree a = Empty | Node a (Tree a) (Tree a) deriving (Show, Read, Eq)
treeIns :: (Ord a) => a -> Tree a -> Tree a
treeIns x Empty= Node x (Empty) (Empty)
treeIns x (Node a l r)
| x == a = Node a l r
| x < a = Node a (treeIns x l) r
| x > a = Node a l (treeIns x r)
leftm :: Tree a -> Tree a
leftm Empty = Empty
leftm (Node a (Empty) (Empty)) = (Node a (Empty) (Empty))
leftm (Node a (l) (Empty)) = leftm l
leftm (Node a (l) (r)) = leftm l
rightm :: Tree a -> Tree a
rightm Empty = Empty
rightm (Node a (Empty) (Empty)) = (Node a (Empty) (Empty))
rightm (Node a (Empty) (r)) = rightm r
rightm (Node a (l) (r)) = rightm r
delt :: (Eq a, Ord a)=>a -> Tree a -> Tree a
delt x Empty = Empty
delt x (Node a (Empty)(Empty))
| x== a = Empty
delt x (Node a l r)
|x == a = (if l /= (Empty) then (let (Node rm (Empty) (Empty)) = rightm l in (Node rm (delt rm l) r)) else (let (Node rm (Empty) (Empty)) = l\
eftm r in (Node rm l (delt rm r)) ))
|x>a = Node a (l) (delt x r)
|x < a = Node a (delt x l ) r
Here is a similar implementation just for reference. (Without the delete part though)
-- a tree can be empty or contain a value with two other Trees
data Tree a = EmptyTree | Node a (Tree a) (Tree a) deriving (Show, Read, Eq)
instance Functor Tree where
fmap f EmptyTree = EmptyTree
fmap f (Node x left right) = Node (f x) (fmap f left) (fmap f right)
-- create a Node with a value and two Empty subtrees (left and right)
singleton :: a -> Tree a
singleton x = Node x EmptyTree EmptyTree
-- insert a new Node into a tree
insertInTree :: (Ord a) => a -> Tree a -> Tree a
-- insert into empty tree is equal to creating a new tree
insertInTree x EmptyTree = singleton x
-- pattern match on value and subtrees
insertInTree x (Node a left right)
-- if element is equal to root element, return same tree
| x == a = Node x left right
-- if element is smaller than root, go to left
-- subtree and check again.
| x < a = Node a (insertInTree x left) right
-- if element is bigger than root, go to right
-- subtree and check again.
| x > a = Node a left (insertInTree x right)
-- binary tree search
search :: (Ord a) => a -> Tree a -> Bool
-- search in EmptyTree is always False
search x EmptyTree = False
-- serach in a Node
search x (Node a left right)
-- if element equals root element, great
| x == a = True
-- if element is smaller than root, continue search on the left side
| x < a = search x left
-- if element is bigger than root, continue search on the right side
| x > a = search x right
-- create a test tree
myTree = foldr insertInTree EmptyTree [15,75,651,2,3,4,85,42,1,5,36,45,78,12,2]

Retrieve minimum from tree and the tree itself - haskell

With this function, i can remove the minimum in a binary search tree:
data BTree a = Empty
| Node a (BTree a) (BTree a)
semmin :: BTree a -> BTree a
semmin (Node x Empty Empty) = Empty
semmin (Node x l r) = Node x (semmin l) r
I want to retrieve the minimum value and the tree without this minimum, the trick is, i can traverse it only once.
The type is mimSmim :: BTree a -> (a,BTree a)
how should i do it?
EDIT:
Does this count as one traverse?
semmin :: BTree a -> (a,BTree a)
semmin (Node x Empty Empty) = (x,Empty)
semmin (Node x l r) = let i= (semmin l)
in (fst(i),(Node x (snd(i)) r))
Here's a hint: If you are at a Node x l r and you already knew that the left tree's mimSmim l was (a, l'), then the Node's mimSmim (Node x l r) would be (a, Node x l' r).
You are looking for a zipper. A [zipper][1] is a representation of another data structure that lets you focus one section of the entire structure without losing the rest. Please see the last chapter of Learn You A Haskell for an intuitive approach to developing the zipper data type and functions to use on it.
The posted code is on the right track, even if not completely correct:
semmin :: BTree a -> (a,BTree a)
semmin (Node x Empty Empty) = (x,Empty)
semmin (Node x l r) = let i= (semmin l)
in (fst(i),(Node x (snd(i)) r))
As a hint for improving your code, not that the following crashes:
semmin (Node 1 Empty (Node 2 Empty Empty))
Also, to improve readability a bit, I would suggest:
semmin :: BTree a -> (a,BTree a)
semmin (Node x Empty Empty) = (x,Empty)
semmin (Node x l r) = let (minValue, minTree) = semmin l
in (minValue, Node x minTree r)
Finally, this looks as if it's returning the whole tree back, instead of the tree at which the minimum is found. Check if that's the case, and if that's what you want.

Resources