I need to implement a DFS traversal on a Tree with a maximum depth ( so for example if the depth is 0 then you only show the root ).
successors node will return a list of (Int,Tree) where Tree is basically the "s" in my Node s a
limitedDfsRec :: (ProblemState s a, Ord s, Ord a) => [Node s a] -> Int -> S.Set (Node s a)-> [Node s a] -> [Node s a]
limitedDfsRec [] _ _ result = reverse result
limitedDfsRec (node:coada) max_depth visited result | adancime node > max_depth = limitedDfsRec coada max_depth visited result
| S.member node visited = limitedDfsRec coada max_depth visited result
| otherwise =
let succesori = [(Nod copil (Just actiune_copil) (Just $ stare node) ((adancime node) + 1) []) | (actiune_copil,copil) <- successors (stare node)]
in limitedDfsRec (succesori ++ coada) max_depth (S.insert node visited) (node : result)
You start from a node,if it's depth is greater than the maximum depth allowed you go to next element in the list (coada).
If the element is already visited then you go to the next element in the list.
Else,you get all the children (succesori) and put them in the list (coada),you add the element to the visited and to the final result.
That function is used toghether with this one :
instance ProblemState Tree Int where
successors (Tree n)
| n == 2 = [(1, Tree 4), (2, Tree 6)] -- 4 instead of 5 => cycle
| otherwise = [(1, Tree $ 2 * n + 1), (2, Tree $ 2 * n + 2)]
isGoal (Tree n) = n == 13
Which generates the children. Well,the problem is that the function above still visits nodes even if they are in the visited set and I don't understand why.
So,for example, starting from Tree 0 with a maximum depth of 2 you should get [0,1,3,4,2,6] but my function gets [0,1,3,4,2,4,6] because when it gets to 2 it puts 4 and 6 in the list but when it gets to 4 it sees that 4 was not visited yet and puts it in the output (result).
I want to see the problem with THIS code,not other ways it works because I need to use this on more than 2 children.
You're keeping whole nodes in the visited set
| S.member node visited = ...
-- ^ Node s a
So you can have multiple nodes labeled by 4 but with different extra information.
You probably only want a visited :: S.Set s.
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
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
Assuming I have a custom tree datatype of the following form:
data BalTree a = Leaf | Node Integer (BalTree a) a (BalTree a) deriving (Eq, Show, Read)
and creating a new tree of size 10, I'll get this:
Node 10 (Node 5 (Node 2 (Node 1 Leaf 'Z' Leaf) 'Z' Leaf)
'Z'
(Node 2 (Node 1 Leaf 'Z' Leaf) 'Z' Leaf))
'Z'
(Node 4 (Node 2 (Node 1 Leaf 'Z' Leaf) 'Z' Leaf)
'Z'
(Node 1 Leaf 'Z' Leaf))
How do I retrieve an element in in-order transversal when given an index?
My attempt:
ind Leaf pos = Nothing
ind tree#(Node n lt x rt) pos
| pos < 0 = Nothing
| pos > treeSize-1 = Nothing
| pos < hTreeSize = ind lt pos
| pos == hTreeSize = Just x
| pos > hTreeSize = ind rt (pos - hTreeSize)
where treeSize = size tree
hTreeSize = treeSize `div` 2
I'm not exactly sure if this is in-order transversal and it doesn't return the correct result.
We want to get the nth value stored in a binary tree in an in-order walk. We know the number of values stored in each tree rooted at each node (the Integer parameter of Node).
data BalTree a = Leaf
| Node Integer (BalTree a) a (BalTree a)
size :: BalTree a -> Integer
size Leaf = 0
size (Node size _ _ _) = size
nthInOrder :: BalTree a -> Integer -> Maybe a
nthInOrder Leaf _ =
Nothing
nthInOrder (Node _ left x right) n
| leftSize == n - 1 = Just x
| n <= leftSize = nthInOrder left n
| otherwise = nthInOrder right (n - leftSize - 1)
where
leftSize = size left
The idea is this: suppose we're at node A and want the nth value:
A
/ \
B C
If B holds n-1 values, then the nth value is that of A. If B holds more or equal than n values, then we can ignore the rest of the tree and search only B; so we just recurse into it. Otherwise, we should be looking for the value in C, so we recurse into it; in this case, we also need to update the n to reflect that there are some values in B, and 1 value in A.
In the worst case, this algorithm walks down to a Leaf, so, the complexity is O(depth of tree). If the tree is balanced, the complexity is O(log2(size of tree)).
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
I wrote the below code to construct a tree with given vertex given a list of connections between vertices.
type Connection = (Int,Int)
data Tree = Leaf Int | Node Int [Tree] deriving (Eq,Read,Show)
makeTree :: Int -> [Connection] -> Tree
makeTree x [] = Leaf x
makeTree indx connections = Node indx otherTrees where
otherTrees = [makeTree i cx | i <- directConnections, let cx = removeConnectionsTo indx connections]
directConnections = map (\(x,y) -> if (x == indx) then y else x) $ filter (\(x,y) -> x == indx || y == indx) connections
removeConnectionsTo :: Int -> [Connection] -> [Connection]
removeConnectionsTo indx = filter (\(x,y) -> x /= indx && y /= indx)
For some reason, the inputs below give me surprisingly different results:
makeTree 1 [(1,2),(1,3)] gives me Node 1 [Leaf 2,Leaf 3]
makeTree 1 [(1,2),(1,5),(2,3),(2,4),(5,6),(5,7)] gives me Node 1 [Node 2 [Node 3 [],Node 4 []],Node 5 [Node 6 [],Node 7 []]]
I am running GHCi, version 7.4.1 on OS X 10.8.2.
I don't understand why I get Leaf twice in the first example (correct) but node with empty subtree lists in the second example (incorrect).
A quick fix would be to just check if otherTrees is empty before deciding whether to build a Leaf or a Node, e.g.
makeTree indx connections
| null otherTrees = Leaf indx
| otherwise = Node indx otherTrees
where ...
To understand what is happening here, let's add a little instrumentation:
import Debug.Trace
makeTree :: Int -> [Connection] -> Tree
makeTree ix cs | traceShow (ix, cs) False = undefined
makeTree x [] = ... -- leave rest of the function as before
Now load it up into GHCi, and let's see what the recursive calls are:
> import Control.DeepSeq
> (show $ makeTree 1 [(1,2),(1,5),(2,3),(2,4),(5,6),(5,7)]) `deepseq` ()
(1,[(1,2),(1,5),(2,3),(2,4),(5,6),(5,7)])
(2,[(2,3),(2,4),(5,6),(5,7)])
(3,[(5,6),(5,7)])
(4,[(5,6),(5,7)])
(5,[(2,3),(2,4),(5,6),(5,7)])
(6,[(2,3),(2,4)])
(7,[(2,3),(2,4)])
()
As you can see, the list in the second argument is not empty which is why it doesn't match the first case of your function, so you'll either need to add some additional checks as in my example, or make sure that you filter out the rest of the connections.