This is a homework question.
My question is simple: Write a function btree_deepest of type 'a btree -> 'a list that returns the list of the deepest elements of the tree. If the tree is empty, then deepest should return []. If there are multiple elements of the input tree at the same maximal depth, then deepest should return a list containing those deepest elements, ordered according to a preorder traversal. Your function must use the provided btree_reduce function and must not be recursive.
Here is my code:
(* Binary tree datatype. *)
datatype 'a btree = Leaf | Node of 'a btree * 'a * 'a btree
(* A reduction function. *)
(* btree_reduce : ('b * 'a * 'b -> 'b) -> 'b -> 'a tree -> 'b) *)
fun btree_reduce f b bt =
case bt of
Leaf => b
| Node (l, x, r) => f (btree_reduce f b l, x, btree_reduce f b r)
(* btree_size : 'a btree -> int *)
fun btree_size bt =
btree_reduce (fn(x,a,y) => x+a+y) 1 bt
(* btree_height : 'a btree -> int *)
fun btree_height bt =
btree_reduce (fn(l,n,r) => Int.max(l, r)+1) 0 bt
I know that I have to create a function to pass to btree_reduce to build the list of deepest elements and that is where I am faltering.
If I were allowed to use recursion then I would just compare the heights of the left and right node then recurse on whichever branch was higher (or recurse on both if they were the same height) then return the current element when the height is zero and throw these elements into a list.
I think I just need a push in the right direction to get started...
Thanks!
Update:
Here is an attempt at a solution that doesn't compile:
fun btree_deepest bt =
let
val (returnMe, height) = btree_reduce (fn((left_ele, left_dep),n,(right_ele, right_dep)) =>
if left_dep = right_dep
then
if left_dep = 0
then ([n], 1)
else ([left_ele::right_ele], left_dep + 1)
else
if left_dep > right_dep
then (left_ele, left_dep+1)
else (right_ele, right_dep+1)
)
([], 0) bt
in
returnMe
end
In order to get the elements of maximum depth, you will need to keep track of two things simultaneously for every subtree visited by btree_reduce: The maximum depth of that subtree, and the elements found at that depth. Wrap this information up in some data structure, and you have your type 'b (according to btree_reduce's signature).
Now, when you need to combine two subtree results in the function you provide to btree_reduce, you have three possible cases: "Left" sub-result is "deeper", "less deep", or "of equal depth" to the "right" sub-result. Remember that the sub-result represent the depths and node values of the deepest nodes in each subtree, and think about how to combine them to gain the depth and the values of the deepest nodes for the current tree.
If you need more pointers, I have an implementation of btree_deepest ready which I'm just itching to share; I've not posted it yet since you specifically (and honorably) asked for hints, not the solution.
Took a look at your code; it looks like there is some confusion based on whether X_ele are single elements or lists, which causes the type error. Try using the "#" operator in your first 'else' branch above:
if left_dep = 0
then ([n], 1)
else (left_ele # right_ele, left_dep + 1)
Related
My assignment is to write a function that will compute the size of a binary tree. This is the implementation of the tree structure:
datatype 'a bin_tree =
Leaf of 'a
| Node of 'a bin_tree (* left tree *)
* int (* size of left tree *)
* int (* size of right tree *)
* 'a bin_tree (* right tree *)
I was given this template from my professor:
fun getSize Empty = 0
| getSize (Leaf _) = 1
| getSize (Node(t1,_,t2)) = getSize t1 + getSize t2;
I was wondering if I need to manipulate this to agree with my tree structure in order to get it to work?
The 'a bin_tree type memoizes the size of each sub-tree. So if you're allowed to assume that the size that is stored is correct, you can return the size of a tree without recursion.
The template given by your professor is not for this type, but for another tree type that does not memoize the size. It demonstrates how you can calculate the size for such a tree by pattern matching and recursion, both language features of which you need to also use.
So the task is for you to write an entirely different function for the 'a bin_tree type. You have to figure out what the right way to pattern match is. First off, the template for getSize does not add up: There are three cases with three constructors, Empty, Leaf x and Node (L, x, R). But the 'a bin_tree type only has two constructors, Leaf x and Node (L, sizeL, sizeR, R).
So you want to read up on how to perform pattern matching on data types.
I have the following code to do an inorder traversal of a Binary Tree:
data BinaryTree a =
Node a (BinaryTree a) (BinaryTree a)
| Leaf
deriving (Show)
inorder :: (a -> b -> b) -> b -> BinaryTree a -> b
inorder f acc tree = go tree acc
where go Leaf z = z
go (Node v l r) z = (go r . f v . go l) z
Using the inorder function above I'd like to get the kth element without having to traverse the entire list.
The traversal is a little like a fold given that you pass it a function and a starting value. I was thinking that I could solve it by passing k as the starting value, and a function that'll decrement k until it reaches 0 and at that point returns the value inside the current node.
The problem I have is that I'm not quite sure how to break out of the recursion of inorder traversal short of modifying the whole function, but I feel like having to modify the higher order function ruins the point of using a higher order function in the first place.
Is there a way to break after k iterations?
I observe that the results of the recursive call to go on the left and right subtrees are not available to f; hence no matter what f does, it cannot choose to ignore the results of recursive calls. Therefore I believe that inorder as written will always walk over the entire tree. (edit: On review, this statement may be a bit strong; it seems f may have a chance to ignore left subtrees. But the point basically stands; there is no reason to elevate left subtrees over right subtrees in this way.)
A better choice is to give the recursive calls to f. For example:
anyOldOrder :: (a -> b -> b -> b) -> b -> BinaryTree a -> b
anyOldOrder f z = go where
go Leaf = z
go (Node v l r) = f v (go l) (go r)
Now when we write
flatten = anyOldOrder (\v ls rs -> ls ++ [v] ++ rs) []
we will find that flatten is sufficiently lazy:
> take 3 (flatten (Node 'c' (Node 'b' (Node 'a' Leaf Leaf) Leaf) undefined))
"abc"
(The undefined is used to provide evidence that this part of the tree is never inspected during the traversal.) Hence we may write
findK k = take 1 . reverse . take k . flatten
which will correctly short-circuit. You can make flatten slightly more efficient with the standard difference list technique:
flatten' t = anyOldOrder (\v l r -> l . (v:) . r) id t []
Just for fun, I also want to show how to implement this function without using an accumulator list. Instead, we will produce a stateful computation which walks over the "interesting" part of the tree, stopping when it reaches the kth element. The stateful computation looks like this:
import Control.Applicative
import Control.Monad.State
import Control.Monad.Trans.Maybe
kthElem k v l r = l <|> do
i <- get
if i == k
then return v
else put (i+1) >> r
Looks pretty simple, hey? Now our findK function will farm out to kthElem, then do some newtype unwrapping:
findK' k = (`evalState` 1) . runMaybeT . anyOldOrder (kthElem 3) empty
We can verify that it is still as lazy as desired:
> findK' 3 $ Node 'c' (Node 'b' (Node 'a' Leaf Leaf) Leaf) undefined
Just 'c'
There are (at least?) two important generalizations of the notion of folding a list. The first, more powerful, notion is that of a catamorphism. The anyOldOrder of Daniel Wagner's answer follows this pattern.
But for your particular problem, the catamorphism notion is a bit more power than you need. The second, weaker, notion is that of a Foldable container. Foldable expresses the idea of a container whose elements can all be mashed together using the operation of an arbitrary Monoid. Here's a cute trick:
{-# LANGUAGE DeriveFoldable #-}
-- Note that for this trick only I've
-- switched the order of the Node fields.
data BinaryTree a =
Node (BinaryTree a) a (BinaryTree a)
| Leaf
deriving (Show, Foldable)
index :: [a] -> Int -> Maybe a
[] `index` _ = Nothing
(x : _) `index` 0 = Just x
(_ : xs) `index` i = xs `index` (i - 1)
(!?) :: Foldable f => Int -> f a -> Maybe a
xs !? i = toList xs `index` i
Then you can just use !? to index into your tree!
That trick is cute, and in fact deriving Foldable is a tremendous convenience, but it won't help you understand anything. I'll start by showing how you can define treeToList fairly directly and efficiently, without using Foldable.
treeToList :: BinaryTree a -> [a]
treeToList t = treeToListThen t []
The magic is in the treeToListThen function. treeToListThen t more converts t to a list and appends the list more to the end of the result. This slight generalization turns out to be all that's required to make conversion to a list efficient.
treeToListThen :: BinaryTree a -> [a] -> [a]
treeToListThen Leaf more = more
treeToListThen (Node v l r) more =
treeToListThen l $ v : treeToListThen r more
Instead of producing an inorder traversal of the left subtree and then appending everything else, we tell the left traversal what to stick on the end when it's done! This avoids the potentially serious inefficiency of repeated list concatenation that can turn things O(n^2) in bad cases.
Getting back to the Foldable notion, turning things into lists is a special case of foldr:
toList = foldr (:) []
So how can we implement foldr for trees? It ends up being somewhat similar to what we did with toList:
foldrTree :: (a -> b -> b) -> b -> BinaryTree a -> b
foldrTree _ n Leaf = n
foldrTree c n (Node v l r) = foldrTree c rest l
where
rest = v `c` foldrTree c n r
That is, when we go down the left side, we tell it that when it's done, it should deal with the current node and its right child.
Now foldr isn't quite the most fundamental operation of Foldable; that is actually
foldMap :: (Foldable f, Monoid m)
=> (a -> m) -> f a -> m
It is possible to implement foldr using foldMap, in a somewhat tricky fashion using a peculiar Monoid. I don't want to overload you with details of that right now, unless you ask (but you should look at the default definition of foldr in Data.Foldable). Instead, I'll show how foldMap can be defined using Daniel Wagner's anyOldOrder:
instance Foldable BinaryTree where
foldMap f = anyOldOrder bin mempty where
bin lres v rres = lres <> f v <> rres
I am reading this paper by Chris Okasaki; titled "Breadth-First Numbering: Lessons from a Small Exercise in Algorithm Design".
A question is - how is the magic happening in the algorithm? There are some figures (e.g. figure 7 titled "threading the output of one level into the input of next level")
Unfortunately, maybe it's only me, but that figure has completely baffled me. I don't understand how the threading happens at all?
Breadth first traversal means traversing levels of a tree one by one. So let's assume we already know what are the numbers at the beginning of each level - the number of traversed elements so far before each level. For the simple example in the paper
import Data.Monoid
data Tree a = Tree (Tree a) a (Tree a)
| Empty
deriving (Show)
example :: Tree Char
example = Tree (Tree Empty 'b' (Tree Empty 'c' Empty)) 'a' (Tree Empty 'd' Empty)
the sizes would be 0, 1, 3, 4. Knowing this, we can thread such a list of sizes through a give tree (sub-tree) left-to-right: We advance the first element of the list by one for the node, and thread the tail of the list first through the left and then through the right subtree (see thread below).
After doing so, we'll get again the same list of sizes, only shifted by one - now we have the total number of elements after each level. So the trick is: Assume we have such a list, use it for the computation, and then feed the output as the input - tie the knot.
A sample implementation:
tagBfs :: (Monoid m) => (a -> m) -> Tree a -> Tree m
tagBfs f t = let (ms, r) = thread (mempty : ms) t
in r
where
thread ms Empty = (ms, Empty)
thread (m : ms) (Tree l x r) =
let (ms1, l') = thread ms l
(ms2, r') = thread ms1 r
in ((m <> f x) : ms2, Tree l' m r')
generalized to Monoid (for numbering you'd give const $ Sum 1 as the function).
One way to view tree numbering is in terms of a traversal. Specifically, we want to traverse the tree in breadth-first order using State to count up. The necessary Traversable instance looks something like this. Note that you'd probably actually want to define this instance for a newtype like BFTree, but I'm just using the raw Tree type for simplicity. This code is strongly inspired by ideas in Cirdec's monadic rose tree unfolding code, but the situation here seems to be substantially simpler. Hopefully I haven't missed something horrible.
{-# LANGUAGE DeriveFunctor,
GeneralizedNewtypeDeriving,
LambdaCase #-}
{-# OPTIONS_GHC -Wall #-}
module BFT where
import Control.Applicative
import Data.Foldable
import Data.Traversable
import Prelude hiding (foldr)
data Tree a = Tree (Tree a) a (Tree a)
| Empty
deriving (Show, Functor)
newtype Forest a = Forest {getForest :: [Tree a]}
deriving (Functor)
instance Foldable Forest where
foldMap = foldMapDefault
-- Given a forest, produce the forest consisting
-- of the children of the root nodes of non-empty
-- trees.
children :: Forest a -> Forest a
children (Forest xs) = Forest $ foldr go [] xs
where
go Empty c = c
go (Tree l _a r) c = l : r : c
-- Given a forest, produce a list of the root nodes
-- of the elements, with `Nothing` values in place of
-- empty trees.
parents :: Forest a -> [Maybe a]
parents (Forest xs) = foldr go [] xs
where
go Empty c = Nothing : c
go (Tree _l a _r) c = Just a : c
-- Given a list of values (mixed with blanks) and
-- a list of trees, attach the values to pairs of
-- trees to build trees; turn the blanks into `Empty`
-- trees.
zipForest :: [Maybe a] -> Forest a -> [Tree a]
zipForest [] _ts = []
zipForest (Nothing : ps) ts = Empty : zipForest ps ts
zipForest (Just p : ps) (Forest ~(t1 : ~(t2 : ts'))) =
Tree t1 p t2 : zipForest ps (Forest ts')
instance Traversable Forest where
-- Traversing an empty container always gets you
-- an empty one.
traverse _f (Forest []) = pure (Forest [])
-- First, traverse the parents. The `traverse.traverse`
-- gets us into the `Maybe`s. Then traverse the
-- children. Finally, zip them together, and turn the
-- result into a `Forest`. If the `Applicative` in play
-- is lazy enough, like lazy `State`, I believe
-- we avoid the double traversal Okasaki mentions as
-- a problem for strict implementations.
traverse f xs = (Forest .) . zipForest <$>
(traverse.traverse) f (parents xs) <*>
traverse f (children xs)
instance Foldable Tree where
foldMap = foldMapDefault
instance Traversable Tree where
traverse f t =
(\case {(Forest [r]) -> r;
_ -> error "Whoops!"}) <$>
traverse f (Forest [t])
Now we can write code to pair up each element of the tree with its breadth-first number like this:
import Control.Monad.Trans.State.Lazy
numberTree :: Tree a -> Tree (Int, a)
numberTree tr = flip evalState 1 $ for tr $ \x ->
do
v <- get
put $! (v+1)
return (v,x)
We have a definition of binary tree:
type 'a tree =
| Node of 'a tree * 'a * 'a tree
| Null;;
And also a helpful function for traversing the tree"
let rec fold_tree f a t =
match t with
| Null -> a
| Node (l, x, r) -> f x (fold_tree f a l) (fold_tree f a r);;
And here is a "magic" function which, when given a binary tree, returns a list in which we have lists of elements on particular levels, for example, when given a tree:
(source: ernet.in)
the function returns [[1];[2;3];[4;5;6;7];[8;9]].
let levels tree =
let aux x fl fp =
fun l ->
match l with
| [] -> [x] :: (fl (fp []))
| h :: t -> (x :: h) :: (fl (fp t))
in fold_tree aux (fun x -> x) tree [];;
And apparently it works, but I can't wrap my mind around it. Could anyone explain in simple terms what is going on? Why does this function work?
How do you combine two layer lists of two subtrees and get a layer list of a bugger tree? Suppose you have this tree
a
/ \
x y
where x and y are arbitrary trees, and they have their layer lists as [[x00,x01,...],[x10,x11,...],...] and [[y00,y01,...],[y10,y11,...],...] respectively.
The layer list of the new tree will be [[a],[x00,x01,...]++[y00,y01,...],[x10,x11,...]++[y10,y11,...],...]. How does this function build it?
Let's look at this definition
let rec fold_tree f a t = ...
and see what kind of arguments we are passing to fold_tree in our definition of levels.
... in fold_tree aux (fun x -> x) tree []
So the first argument, aux, is some kind of long and complicated function. We will return to it later.
The second argument is also a function — the identity function. This means that fold_tree will also return a function, because fold_tree always returns the same type of value as its second argument. We will argue that the function fold_tree applied to this set of arguments takes a list of layers, and adds layers of a given tree to it.
The third argument is our tree.
Wait, what's the fourth argument? fold_tree is only supposed to get tree? Yes, but since it returns a function (see above), that function gets applied to that fourth argument, the empty list.
So let's return to aux. This aux function accepts three arguments. One is the element of the tree, and two others are the results of the folds of the subtrees, that is, whatever fold_tree returns. In our case, these two things are functions again.
So aux gets a tree element and two functions, and returns yet another function. Which function is that? It takes a list of layers, and adds layers of a given tree to it. How it does that? It prepends the root of the tree to the first element (which is the top layer) of the list, and then adds the layers of the right subtree to the tail of the list (which is all the layers below the top) by calling the right function on it, and then adds the layers of the left subtree to the result by calling the left function on it. Or, if the incoming list is empty, it just the layers list afresh by applying the above step to the empty list.
How can I define a Haskell function which will apply a function to every value in a binary tree? So I know that it is similar to the map function - and that its type would be:
mapT :: (a -> b) -> Tree a -> Tree b
But thats about it...
You can declare an instance of class Functor. This is a standard class for data types which allow a function to be mapped over. Please note how similar the type of fmap is to your mapT's type:
class Functor f where
fmap :: (a -> b) -> f a -> f b
Let's assume your tree is defined as
data Tree a = Node (Tree a) (Tree a) | Leaf a
deriving (Show)
Then you can declare an instance of Functor this way:
instance Functor Tree where
fmap f (Node l r) = Node (fmap f l) (fmap f r)
fmap f (Leaf x) = Leaf (f x)
This is how you can use it:
main = do
let t = Node (Node (Leaf 1) (Leaf 2)) (Leaf 3)
let f = show . (2^)
putStrLn $ "Old Tree: " ++ (show t)
putStrLn $ "New Tree: " ++ (show . fmap f $ t)
Output:
Old Tree: Node (Node (Leaf 1) (Leaf 2)) (Leaf 3)
New Tree: Node (Node (Leaf "2") (Leaf "4")) (Leaf "8")
You can also define for convenience:
mapT = fmap
Surely, you can do it without type classes, but it makes the code more readable for the others if you use standard functions (everyone knows the usual behaviour of fmap).
I'll pretend this is homework and not give away all of the answer. If I'm mistaken, my apologies.
Probably your Tree type looks something like this:
data Tree a = TreeNode a (Tree a) (Tree a) | EmptyNode
There are two cases here, and you will need to write a mapT implementation for each of them:
An internal node, TreeNode, which carries a value of type a and has a left and a right child. What needs to be done in this case?
A terminal node, EmptyNode. What needs to be done in this case?
The basic format of the map function applies to both. Let's look at the definition of the map function for lists:
map f (x:xs) = f x : map f xs
map _ [] = []
We can generalize this like so:
You take the first value in the data structure
Apply the function to it
Recursively call your map function with the remainder of the data structure
Pass both the modified value and the recursive call into the constructor for your type.
When you reach the end, stop recursing
All you really need is to look at your constructor and the map function should fall into place.
Interesting question if the input and output are supposed to be sorted binary trees. If you just naively traverse the tree and apply the function, the output tree may no longer be sorted. For example, consider if the function is non-linear, like
f(x) = x * x - 3 * x + 2
If the input has { 1, 2, 3, 4 } then the output will have { 2, 0, 0, 2 }. Should the output tree contain only 0 and 2?
If so, you may need to iteratively build up the output tree as you strip down and process the input tree.