I'm trying to get a function that counts all paths from the root to a leaf that has an even number of nodes ( counting the root and the leaf)
My tree looks like this:
data Tree = Leaf Int | Node Int Tree Tree
all i got so far is a function that counts ALL nodes in a tree, which is easy enough:
countNodes (Leaf _) = 1
countNodes (Node _ x y) = 1+ countNodes x + countNodes y
Now i saw a bunch of questions that deal with trees but i felt like no answer helped me much, so I'm just gonna ask myself. How do i make a part of a function stop when a leaf is reached? I know this has to do with my problem to think with recursions.
What I tried to do was to to make list of all paths from the root, but i always end up with a function that gets all elements in the tree and puts them together somehow.
I'm missing something simple, please help. (or link me an answer that does exactly what i want)
I think the easiest way would be to make a data type that can describe a path through a tree:
data Path = L Path | R Path | End deriving (Eq, Show)
This type is basically a list but with two prepend constructors to tell you either go Left or go Right. This conveniently lets you look up items by path, or you can write a function that gives you a list of all paths in the tree.
-- Note that this can fail: lookupNode (Leaf 1) (L End) == Nothing
lookupNode :: Tree -> Path -> Maybe Tree
allPaths :: Tree -> [Path]
If you can write the allPaths function, then you can write the function you want on top of it. To start, just begin by listing the base cases:
allPaths (Leaf _) = [End]
allPaths (Node _ left right) = _
To fill in the hole _, think about what it means to list all the paths starting at a Node and recursing down left. You would need to have a L at the beginning of all of those paths, so you can put the following in there
allPaths (Node _ left right) = (map L $ allPaths left)
Similarly, you would need to handle the right tree:
allPaths (Node _ left right) =
(map L $ allPaths left) ++
(map R $ allPaths right)
So now:
> let tree =
Node 1
(Node 2 -- L _
(Leaf 3) -- L (L End)
(Node 4 -- L (R _)
(Leaf 5) -- L (R (L End))
(Leaf 6) -- L (R (R End))
)
)
(Leaf 7) -- R End
> allPaths tree
[L (L End),L (R (L End)), L (R (R End)),R End]
Now, to find the Leafs with an even number of nodes above them, first write a function that calculates a path length:
pathLength :: Path -> Int
pathLength End = 0
pathLength (L rest) = 1 + pathlength rest
pathLength (R rest) = 1 + pathLength rest
evenNodeCountPaths :: Tree -> [Path]
evenNodeCountPaths tree = filter (even . pathLength) $ allPaths tree
Note: It is possible to do this with
data Dir = L | R | End
type Path = [Dir]
But that can lead to invalid paths like [End, End, L, R, End], which just doesn't make any sense. I chose to go for the list-like data Path for this reason. You have to write your own pathLength function, but this formulation makes it impossible to have invalid paths.
Probably it's easier to compute both the number of even and the number of odd paths.
evenAndOdd (Leaf _) = (0, 1)
evenAndOdd (Node _ l r) = let
(el, ol) = evenAndOdd l
(er, or) = evenAndOdd r
in (ol+or, el+er)
If you really must, you can then define a function in terms of this to count just the even paths.
evenOnly = fst . evenAndOdd
Related
I have a binary tree:
data Btree a = Leaf a | Unary (Btree a) a | Binary (Btree a) a (Btree a) deriving Show
and some examples to work with:
ex1 = Binary (Binary (Leaf 0) 1 (Leaf 2)) 3 (Unary (Leaf 4) 5)
ex2 = Binary (Unary (Leaf 1) 2) 3 (Binary (Leaf 4) 5 (Leaf 10))
ex3 = Binary (Binary (Leaf (0,"a"))(1,"z")(Leaf (2,"x")))(3,"y")(Binary (Leaf (4,"b"))(5,"c")(Leaf (6,"d")))
I need to find out whether the tree is complete or not, a tree is complete if the distance between the root and any leaf is always the same up to 1, all of the deepest leaves are located to the left of the others, and there is at most one internal node with unary node that should be located on the second-to-last level.
This is what i have so far
complete :: Btree a -> Bool
complete x = fst $ go x where
go (Leaf _) = (True, 0)
go (Unary left _) = (leftTrue, 1 + leftCount) where
(leftTrue, leftCount) = go left
go (Binary left _ right) = (leftTrue && rightTrue &&
leftCount == rightCount,
1 + leftCount + rightCount) where
(leftTrue, leftCount) = go left
(rightTrue, rightCount) = go right
ex1 & ex3 should return true, but only ex3 is. I believe the Unary part is the issue.
This answer counts on a code change in the Unary part like that: (leftTrue, 1 + leftCount) -> (False, 1 + leftCount).
The body of your solution is the go function.
The function returns for a subtree
if the left and right subtrees are completely balanced and how many nodes the subtree has.
All depths are the same, like in the ex3.
But if you don't have 2^n-1 nodes and 2^(n-1) leaves, it is impossible to build that tree.
In the description of your problem is allowed little disbalance allowing represent any count of nodes.
Ex1 fulfills the rules ex2 doesn't.
Ex3 is also complete according to your definition.
Under the code, I made ASCII art to the examples.
My solution doesn't count amount nodes of subtrees. It calculates maximal and minimal depths because it allows me to reveal illegal disbalance in any level of a tree.
The boolean value says if the subtree accomplishes your conditions of the complete tree.
It checks that:
differences are the same up to one
the left subtree has a greater or the same minimal depth as the maximal depth of the right tree.
Checks above also contain the condition about one unary node on the second-to-last level.
Can you guess what belongs to the place ...?
data Btree a = Leaf a | Unary (Btree a) a | Binary (Btree a) a (Btree a) deriving Show
ex1 = Binary (Binary (Leaf 0) 1 (Leaf 2)) 3 (Unary (Leaf 4) 5)
ex2 = Binary (Unary (Leaf 1) 2) 3 (Binary (Leaf 4) 5 (Leaf 10))
ex3 = Binary (Binary (Leaf (0,"a"))(1,"z")(Leaf (2,"x")))(3,"y")(Binary (Leaf (4,"b"))(5,"c")(Leaf (6,"d")))
complete :: Btree a -> Bool
complete x = fst $ go x
go :: Btree a -> (Bool,(Int,Int))
go (Leaf _) = (True, (0, 0))
go (Unary left _) = (leftMaxDepth == 0, (1 + leftMaxDepth, 0)) where
(leftIs, (leftMaxDepth, leftMinDepth)) = go left
go (Binary left _ right) =
( leftIs && rightIs
...
, (1+newMaxDepth
, 1+newMinDepth )) where
newMaxDepth = max leftMaxDepth rightMaxDepth
newMinDepth = min leftMinDepth rightMinDepth
(leftIs, (leftMaxDepth, leftMinDepth)) = go left
(rightIs, (rightMaxDepth, rightMinDepth)) = go right
&& leftMinDepth >= rightMaxDepth && newMaxDepth - newMinDepth <= 1
ex1: True
3
/ \
/ \
1 5
/ \ /
0 2 4
Depths: [3,3,3,2]
ex2: False
3
/ \
/ \
2 5
/ / \
1 4 10
Depths: [3,2,3,3]
ex3: True
(3,"y")
/ \
/ \
(1,"z") (5,"c")
/ \ / \
(0,"a") (2,"x") (4,"b") (6,"d")
Depths: [3,3,3,3]
This answer counts on a code change in the Unary part like that: (leftTrue, 1 + leftCount) -> (False, 1 + leftCount).
https://web.cecs.pdx.edu/~sheard/course/Cs163/Doc/FullvsComplete.html
Full binary rtee:
Complete binary tree:
Your solution counts on a full binary tree.
Your exercise is about checking if the binary tree is complete.
The algorithm is fine, but the check leftCount == rightCount should be changed.
A full binary tree has a minimum depth equal to the maximum depth,
and the left subtree has the same number of nodes as the right.
In a complete binary tree, the situation is more difficult:
Let the number of nodes complete binary tree is x then
x = 2^m-1+n, where m is the minimum depth of the tree and 0 <= n < 2^(m+1) .
Let '1' be the suffix of the left subtree and the suffix '2' of the right.
for subtrees of a complete binary tree, it always holds:
If the minimum depths of the left and right subtrees are the same, then the right tree must be full.
If the minimum depth of the left subtree is equal to the minimum depth of the right subtree plus one, then the left subtree must be full.
getMinDepthAndRest :: Int -> (Int,Int)
getMinDepthAndRest x = getMinDepthandRest' x 0
getMinDepthAndRest' :: Int -> Int -> (Int,Int)
getMinDepthAndRest' x m'
| x < 2^m'-1 = (m'-1,x-2^(m'-1)+1)
| otherwise = getMinDepthandRest' x (m'+1)
complete :: Btree a -> Bool
complete x = fst $ go x where
go (Leaf _) = (True, 1)
go (Unary left _) = (leftCount == 1, 1 + leftCount) where
(leftTrue, leftCount) = go left
go (Binary left _ right) = (leftTrue && rightTrue &&
(m1==m2 && n2==0) || (m1==m2+1 && n1==0),
1 + leftCount + rightCount) where
(m1,n1) = getMinDepthAndRest leftCount
(m2,n2) = getMinDepthAndRest rightCount
(leftTrue, leftCount) = go left
(rightTrue, rightCount) = go right
So I have a tree defined as follows:
data Tree = Node Tree Int Tree | Leaf Int
The Int for a Node in this case is the value at that Node. I am trying to check that a tree is balanced, and that the tree is increasing as it's traversed left to right.
To do so I have a recursive function that takes a (Node left x right) and checks that the difference in height of left and right (the nodes below it) is no more than one. I then call balanced again for left and right.
Is it possible to access the Int value of left and right?
Yes, you can write a function that returns the integer at the top node:
getInt (Node _ i _) = i
getInt (Leaf i) = i
E.g.
Prelude> getInt $ Leaf 42
42
Prelude> getInt $ Node (Leaf 42) 123 (Leaf 1337)
123
Of course you can, instead of put variables like left and right, use the constructors again:
Edit, I forget the case of Leaf, it has also an int:
data Tree = Node Tree Int Tree | Leaf Int
exampleSumNodes (Node left x right) = (treeToInt left) + x + (treeToInt right)
treeToInt (Node _ n _) = n
treeToInt (Leaf n ) = n
I am working with the following data type:
data SuffixTree = Leaf Int | Node [(String, SuffixTree)]
deriving (Eq, Show)
Each subtree has a corresponding label (string).
The idea is to build the corresponding suffix tree by adding each suffix and its index into an accumulating tree (at the beginning it is Node []).
This is already defined
buildTree s
= foldl (flip insert) (Node []) (zip (suffixes s) [0..length s-1])
where suffixes is correctly defined.
I've been trying to implement the insert function for a while but can't seem to succeed.
This is what I have now (the names and style are not the best since this is still work in progress):
insert :: (String, Int) -> SuffixTree -> SuffixTree
insert pair tree#(Node content)
= insert' pair tree content
where
insert' :: (String, Int) -> SuffixTree -> [(String, SuffixTree)] -> SuffixTree
insert' (s, n) (Node []) subtrees
= Node ((s, Leaf n) : subtrees)
insert' (s, n) (Node content#((a, tree) : pairs)) subtrees
| null p = insert' (s, n) (Node pairs) subtrees
| p == a = insert' (r, n) tree subtrees
| p /= a = Node ((p, newNode) : (subtrees \\ [(a, tree)]))
where
(p, r, r') = partition s a
newNode = Node [(r, (Leaf n)), (r', tree)]
The partition function takes two strings and returns a tuple consisting of:
The common prefix (if it exists)
The first string without the prefix
The second string without the prefix
I think I understand the rules needed to build the tree.
We start by comparing the label of the first subtree to the string we want to insert (say, str). If they don't have a prefix in common, we try to insert in the next subtree.
If the label is a prefix of str, we continue to look into that subtree, but instead of using str we try to insert str without the prefix.
If str is a prefix of label, then we replace the existing subtree with a new Node, having a Leaf and the old subtree. We also adjust the labels.
If we don't have a match between str and any label then we add a new Leaf to the list of subtrees.
However, the biggest problem that I have is that I need to return a new tree containing the changes, so I have to keep track of everything else in the tree (not sure how to do this or if I'm thinking correctly about this).
The code appears to be working correctly on this string: "banana":
Node [("a",Node [("",Leaf 5),("na",Node [("",Leaf 3),("na",Leaf 1)])]),
("na",Node [("",Leaf 4),("na",Leaf 2)]),("banana",Leaf 0)]
However, on this string "mississippi" I get an Exception: Non-exhaustive patterns in function insert'.
Any help or ideas are greatly appreciated!
You are using a quadratic algorithm; whereas optimally, suffix tree can be constructed in linear time. That said, sticking with the same algorithm, a possibly better approach would be to first build the (uncompressed) suffix trie (not tree) and then compress the resulting trie.
The advantage would be that a suffix trie can be represented using Data.Map:
data SuffixTrie
= Leaf' Int
| Node' (Map (Maybe Char) SuffixTrie)
which makes manipulations both more efficient and easier than list of pairs. Doing so, you may also completely bypass common prefix calculations, as it comes out by itself:
import Data.List (tails)
import Data.Maybe (maybeToList)
import Control.Arrow (first, second)
import Data.Map.Strict (Map, empty, insert, insertWith, assocs)
data SuffixTree
= Leaf Int
| Node [(String, SuffixTree)]
deriving Show
data SuffixTrie
= Leaf' Int
| Node' (Map (Maybe Char) SuffixTrie)
buildTrie :: String -> SuffixTrie
buildTrie s = foldl go (flip const) (init $ tails s) (length s) $ Node' empty
where
go run xs i (Node' ns) = run (i - 1) $ Node' tr
where tr = foldr loop (insert Nothing $ Leaf' (i - 1)) xs ns
loop x run = insertWith (+:) (Just x) . Node' $ run empty
where _ +: Node' ns = Node' $ run ns
buildTree :: String -> SuffixTree
buildTree = loop . buildTrie
where
loop (Leaf' i) = Leaf i
loop (Node' m) = Node $ con . second loop <$> assocs m
con (Just x, Node [(xs, tr)]) = (x:xs, tr) -- compress single-child nodes
con n = maybeToList `first` n
then:
\> buildTree "banana"
Node [("a",Node [("",Leaf 5),
("na",Node [("",Leaf 3),
("na",Leaf 1)])]),
("banana",Leaf 0),
("na",Node [("",Leaf 4),
("na",Leaf 2)])]
similarly:
\> buildTree "mississippi"
Node [("i",Node [("",Leaf 10),
("ppi",Leaf 7),
("ssi",Node [("ppi",Leaf 4),
("ssippi",Leaf 1)])]),
("mississippi",Leaf 0),
("p",Node [("i",Leaf 9),
("pi",Leaf 8)]),
("s",Node [("i",Node [("ppi",Leaf 6),
("ssippi",Leaf 3)]),
("si",Node [("ppi",Leaf 5),
("ssippi",Leaf 2)])])]
Here's how the problem is occurring.
Let's say you're processing buildTree "nanny". After you've inserted the suffixes "nanny", "anny", and "nny", your tree looks like t1 given by:
let t1 = Node t1_content
t1_content = [("n",t2),("anny",Leaf 1)]
t2 = Node [("ny",Leaf 2),("anny",Leaf 0)]
Next, you try to insert the prefix "ny":
insert ("ny", 3) t1
= insert' ("ny", 3) t1 t1_content
-- matches guard p == a with p="n", r="y", r'=""
= insert' ("y", 3) t2 t1_content
What you intend to do next is insert ("y", 3) into t2 to yield:
Node [("y", Leaf 3), ("ny",Leaf 2),("anny",Leaf 0)])
Instead, what happens is:
insert' ("y", 3) t2 t1_content
-- have s="y", a="ny", so p="", r="y", r'="ny"
-- which matches guard: null p
= insert' ("y", 3) (Node [("anny", Leaf 0)]) t1_content
-- have s="y", a="anny", so p="", r="y", r'="anny"
-- which matches guard: null p
= insert' ("y", 3) (Node []) t1_content
= Node [("y", Leaf 3), ("n",t2), ("anny",Leaf 1)]
and suffix "y" has been added to t1 instead of t2.
When you next try to insert suffix "y", the guard p==a case tries to insert ("y",3) into Leaf 3 and you get a pattern error.
The reason it works on banana is that you only ever insert a new node at the top level of the tree, so "adding to t2" and "adding to t1" are the same thing.
I suspect you'll need to substantially rethink the structure of your recursion to get this working.
Looks like this code does the job, although there may still be improvements to make. I hope that it's general enough to work on any string. I also tried to avoid using ++, but it's still better than nothing.
getContent (Node listOfPairs)
= listOfPairs
insert :: (String, Int) -> SuffixTree -> SuffixTree
insert (s, n) (Node [])
= Node [(s, Leaf n)]
insert (s, n) (Node (pair#(a, tree) : pairs))
| p == a = Node ((a, insert (r, n) tree) : pairs)
| null p = Node (pair : (getContent (insert (r, n) (Node pairs))))
| p /= a = Node ([(p, Node [(r, Leaf n), (r', tree)])] ++ pairs)
where
(p, r, r') = partition s a
Assume I have a binary tree:
data Bst a = Empty | Node (Bst a) a (Bst a)
I have to write a function that searches for a value and returns the number of its children. If there is no node with this value, it returns -1. I was trying to write both BFS and DFS, and I failed with both.
Pattern matching is your friend. Your Bst can either be Empty or a Node, so at the toplevel, your search function will be
search Empty = ...
search (Node left x right) = ...
Can an Empty tree possibly contain the target value? With a Node the target value, if present, will be either the node value (x above), in the left subtree, in the right subtree—or perhaps some combination of these.
By “return[ing] the number of its children,” I assume you mean the total number of descendants of the Bst rooted at a Node whose value is the target, which is an interesting combination of problems. You will want another function, say numChildren, whose definition uses pattern matching as above. Considerations:
How many descendants does an Empty tree have?
In the Node case, x doesn’t count because you want descendants. If only you had a function to count the number of children in the left and right subtrees …
Here is a way to do this. Breath-first search can actually be a bit tricky to implement and this solution (findBFS) has aweful complexity (appending to the list is O(n)) but you'll get the gist.
First I have decided to split out the finding functions to return the tree where the node element matches. That simplifies splitting out the counting function. Also, it is easier to return the number of elements than the number of descendants and return -1 in case not found, so the numDesc functions rely on the numElements function.
data Tree a = Empty
| Node a (Tree a) (Tree a)
numElements :: Tree a -> Int
numElements Empty = 0
numElements (Node _ l r) = 1 + numElements l + numElements r
findDFS :: Eq a => a -> Tree a -> Tree a
findDFS _ Empty = Empty
findDFS x node#(Node y l r) | x == y = node
| otherwise = case findDFS x l of
node'#(Node _ _ _) -> node'
Empty -> findDFS x r
findBFS :: Eq a => a -> [Tree a] -> Tree a
findBFS x [] = Empty
findBFS x ((Empty):ts) = findBFS x ts
findBFS x (node#(Node y _ _):ts) | x == y = node
findBFS x ((Node _ l r):ts) = findBFS x (ts ++ [l,r])
numDescDFS :: Eq a => a -> Tree a -> Int
numDescDFS x t = numElements (findDFS x t) - 1
numDescBFS :: Eq a => a -> Tree a -> Int
numDescBFS x t = numElements (findBFS x [t]) - 1
module Main where
import Data.List
import Data.Function
type Raw = (String, String)
icards = [("the", "le"),("savage", "violent"),("work", "travail"),
("wild", "sauvage"),("chance", "occasion"),("than a", "qu'un")]
data Entry = Entry {wrd, def :: String, len :: Int, phr :: Bool}
deriving Show
-- French-to-English, search-tree section
entries' :: [Entry]
entries' = map (\(x, y) -> Entry y x (length y) (' ' `elem` y)) icards
data Tree a = Empty | Tree a (Tree a) (Tree a)
tree :: Tree Entry
tree = build entries'
build :: [Entry] -> Tree Entry
build [] = Empty
build (e:es) = ins e (build es)
ins :: Entry -> Tree Entry -> Tree Entry
...
find :: Tree Entry -> Word -> String
...
translate' :: String -> String
translate' = unwords . (map (find tree)) . words
so i'm trying to design function ins and find but i am not sure where to start.any ideas?
I have no idea by which criteria the tree should be sorted, so I use just wrd. Then it would look like:
ins :: Entry -> Tree Entry -> Tree Entry
ins entry Empty = Tree entry Empty Empty
ins entry#(Entry w _ _ _) (Tree current#(Entry w1 _ _ _) left right)
| w == w1 = error "duplicate entry"
| w < w1 = Tree current (ins entry left) right
| otherwise = Tree current left (ins entry right)
How to get there?
As always when using recursion, you need a base case. Here it is very simple: If the tree is empty, just replace it by a node containing your data. There are no children for the new node, so we use Empty.
The case if you have a full node looks more difficult, but this is just due to pattern matching, the idea is very simple: If the entry is "smaller" you need to replace the left child with a version that contains the entry, if it is "bigger" you need to replace the right child.
If both node and entry have the same "size" you have three options: keep the old node, replace it by the new one (keeping the children) or throw an error (which seems the cleanest solution, so I did it here).
A simple generalization of Landei's answer:
ins :: Ord a => a -> Tree a -> Tree a
ins x Empty = Tree x Empty Empty
ins x (Tree x' l r) = case compare x x' of
EQ -> undefined
LT -> Tree x' (ins x l) r
GT -> Tree x' l (ins x r)
For this to work on Tree Entry, you will need to define an instance of Ord for Entry.