I was just reading Apfelmus' excellent introduction to Finger Trees for the second time and started to wonder about his implementation of head:
import Prelude hiding (head)
data Tree v a = Leaf v a
| Branch v (Tree v a) (Tree v a)
toList :: Tree v a -> [a]
toList (Leaf _ a) = [a]
toList (Branch _ x y) = toList x ++ toList y
head :: Tree v a -> a
head (Leaf _ a) = a
head (Branch _ x _) = head x
As implementing functions in terms of one another is a quite nice way of reusing code, it got me thinking if the following implementation would be as efficient (complexity wise) as his original:
import Prelude -- not needed, just for making it obvious
data Tree v a = Leaf v a
| Branch v (Tree v a) (Tree v a) deriving Show
toList :: Tree v a -> [a]
toList (Leaf _ a) = [a]
toList (Branch _ x y) = toList x ++ toList y
head' :: Tree v a -> a
head' = head . toList
Is lazy evaluation as efficient as the original implementation?
Yes, head and head' should have the same time complexity if handed to GHC. I would expect a small constant-factor difference in favor of head (maybe 60% confident of this -- the list fusion optimization stuff is pretty wild when it works).
Related
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.
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"]
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.
Given the following tree structure in Haskell:
data Tree = Leaf Int | Node Int Tree Tree deriving Show
How can I get Haskell to return a list of the data in pre-order?
e.g. given a tree:
Node 1 (Leaf 2) (Leaf 3)
return something like:
preorder = [1,2,3]
You could aim to a more general solution and make your data type an instance of Foldable.
There is a very similar example at hackage, but that implements a post-order visit.
If you want to support pre-order visits you will have to write something like this:
import qualified Data.Foldable as F
data Tree a = Leaf a | Node a (Tree a) (Tree a) deriving Show
instance F.Foldable Tree where
foldr f z (Leaf x) = f x z
foldr f z (Node k l r) = f k (F.foldr f (F.foldr f z r) l)
With this, you'll be able to use every function that works on Foldable types, like elem, foldr, foldr, sum, minimum, maximum and such (see here for reference).
In particular, the list you are searching for can be obtain with toList. Here are some examples of what you could write by having that instance declaration:
*Main> let t = Node 1 (Node 2 (Leaf 3) (Leaf 4)) (Leaf 5)
*Main> F.toList t
[1,2,3,4,5]
*Main> F.foldl (\a x -> a ++ [x]) [] t
[1,2,3,4,5]
*Main> F.foldr (\x a -> a ++ [x]) [] t
[5,4,3,2,1]
*Main> F.sum t
15
*Main> F.elem 3 t
True
*Main> F.elem 12 t
False
Use pattern matching
preorder (Leaf n) = [n]
preorder (Node n a b) = n:(preorder a) ++ (preorder b)
Ok, sorry about the late reply, but I got this working as follows:
preorder(Leaf n) = [n]
preorder(Node n treeL treeR) = [n] ++ preorder treeL ++ preorder treeR'code'
This however does not work for me still
preorder (Leaf n) = [n]
preorder (Node n a b) = n:(preorder a) ++ (preorder b)