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)
Related
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 was supposed to create a data structure for a Tree, where every Node has an undefined amount of branches. I am guessing this will be a rose tree.
data GTree a = Node a [GTree a]
Now I am supposed to write a postorderG function that will give me a list of all my elements in my general in a postorder sequence
I wrote this but it does not seem right... Could someone help me?
postorderG :: GTree a -> [a]
postorderG (Node x l r) = postorder l ++ postorder r ++ [GTree x]
GTree is a type constructor, not a data constructor; a tree would be created with Node x [], not GTree x.
However, you don't need to create a tree at all here. You just need a the value stored at the root of the input tree for the final list in the return value.
postorderG :: GTree a -> [a]
postorderG (Node x ch) = concatMap postorderG ch -- [a]
++ [x] -- [a], not [GTree a]
If you wanted to, you could create a singleton tree to append to ch, the apply postOrderG to each child and the new singleton in order.
postorderG (Node x ch) = concatMap postorderG (ch ++ [Node x []])
Taking advantage of the [] monad instead of using concatMap, the RHS would look like either
(ch >>= postorderG) ++ [x]
or
(ch ++ [Node x []]) >>= postorderG
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
Given a sequence of elements, I want to find a list of all the direct successors for each element:
Example:
"AABAABAAC"
Should return something like (using Data.Map):
fromList [('A',"ABABA"), ('B',"AA"), ('C', "")]
I am aware of the fromListWith function but I can't seem to get the list comprehension right:
succs :: Ord a => [a] -> M.Map a [a]
succs xs = M.fromListWith (++) [(x, ???) | ??? ]
Does this help?
succs xs#(_:xss) = M.fromListWith (++) $ zip xs (map (:[]) xss ++ [[]])
I think it returns ('A',"ABABAC")..., your example has no C.
(:[]) is a point-free version of
singleton :: a -> [a]
singleton x = [x]
How did I get to this solution? I find this definition for the fibonacci numbers fascinating: [1] [2]
fibs = fibs = 0:1:zipWith (+) fibs (tail fibs)
A similar thing can pair up every element with its successor:
let x = "AABAABAAC"
zip x (tail x)
[('A','A'),('A','B'),('B','A'),('A','A'),('A','B'),('B','A'),('A','A'),('A','C')]
This type almost matches the input to
M.fromListWith :: Ord k => (a -> a -> a) -> [(k, a)] -> M.Map k a
Now turn the characters into singleton lists and add an empty list to not suppress ('C',"").
You can split the problem into two parts. First, find the edges between two elements of a list.
edges :: [a] -> [(a, a)]
edges (x:y:zs) = (x,y):edges (y:zs)
edges _ = []
Then build a map to all the items that are the immediate successors of an item with fromListWith.
succs :: Ord a => [a] -> M.Map a [a]
succs = M.fromListWith (++) . map (\(x,y) -> (x,[y])) . edges
This doesn't give quite exactly what you desire. There's no entry for 'C' since it has no immediate successors.
succs "AABAABAAC" = fromList [('A',"CABABA"),('B',"AA")]
Instead we can make a less general-purpose version of edges that includes an item for the last item in the list.
succs :: Ord a => [a] -> M.Map a [a]
succs = M.fromListWith (++) . edges
where
edges (x:y:zs) = (x,[y]):edges (y:zs)
edges (x:zs) = (x,[] ):edges zs
edges _ = []
Is it possible to convert a list of tuples [(Int,Int)] as a generic way which valid to any input size ? .. i saw in various questions thats its not possible generically
example :
type X = [(Int,Int)]
func :: X -> [Int]
Your question is not very certain about how the tuples should be converted into a list. I assume that you want to have them flattend - for instance, [(1,2),(3,4)] should become [1,2,3,4].
This translation is only possible, if the two elements of your tuple are of the same type. In this case you can do something like this:
tupleToList :: [(a,a)] -> [a]
tupleToList ((a,b):xs) = a : b : tupleToList xs
tupleToList _ = []
In the general case, such a translation is impossible. One thing I could imagine to make the impossible possible is to use Either to wrap up the two different types:
tupleToList :: [(a,b)] -> [Either a b]
tupleToList ((a,b):xs) = Left a : Right b : tupleToList xs
The lens library handles this and similar cases consistently.
> import Control.Lens
> toListOf (traverse . both) [(1,2),(3,4)]
^ ^
| |> Traversal of the tuple (a, a)
|> Traversal of a list [b]
[1,2,3,4]
To convert from a list of lists:
> toListOf (traverse . traverse) [[1,2],[3,4],[5,6,7]]
[1,2,3,4,5,6,7]
addition edit:
traverse works with Traversable
traverse will work with any datatype that has a Traversable instance, for example trees.
> import Data.Tree
> let t = Node 1 [Node 2 [Node 3 [], Node 4 []], Node 5 []]
> let prettyTree = drawTree . fmap show
> prettyTree t
1
|
+- 2
| |
| +- 3
| |
| `- 4
|
`- 5
> toListOf (traverse . traverse) [t, t]
[1,2,3,4,5,1,2,3,4,5]
You could also use a fold and avoid explicit recursion:
tupleToList = foldr (\(f,s) a -> f : s : a) []
Or:
tupleToList = foldl (\a (f,s) -> a ++ [f,s]) []
(For elements of the same type)
This can be also achieved by the homogeneous tuples library (disclaimer: which I'm the author of). It defines wrappers for tuples that make them instances of Traversable (and others such as Applicative and Monad). So a tuple can be converted to a list by toList . Tuple2 (where toList is from Data.Foldable) and
f :: [(a, a)] -> [a]
f = concatMap (toList . Tuple2)
You can also use it for other tuples, for example concatMap (toList . Tuple5) etc.
f [] = []
f [(x, y) : xs] = x : y : f xs