https://wiki.haskell.org/api.php?action=feedcontributions&user=Lambdaloop&feedformat=atomHaskellWiki - User contributions [en]2021-02-26T10:48:46ZUser contributionsMediaWiki 1.27.4https://wiki.haskell.org/index.php?title=99_questions/Solutions/68&diff=4145699 questions/Solutions/682011-08-06T18:58:56Z<p>Lambdaloop: Made preInTree function neater</p>
<hr />
<div>Preorder and inorder sequences of binary trees. We consider binary trees with nodes that are identified by single lower-case letters, as in the example of problem P67.<br />
<br />
a) Write predicates preorder/2 and inorder/2 that construct the preorder and inorder sequence of a given binary tree, respectively. The results should be atoms, e.g. 'abdecfg' for the preorder sequence of the example in problem P67.<br />
<br />
b) Can you use preorder/2 from problem part a) in the reverse direction; i.e. given a preorder sequence, construct a corresponding tree? If not, make the necessary arrangements.<br />
<br />
c) If both the preorder sequence and the inorder sequence of the nodes of a binary tree are given, then the tree is determined unambiguously. Write a predicate pre_in_tree/3 that does the job.<br />
<br />
<haskell><br />
treeToPreorder :: Tree Char -> String<br />
treeToPreorder = preorder<br />
where preorder Empty = ""<br />
preorder (Branch x l r) = x : preorder l ++ preorder r<br />
<br />
<br />
treeToInorder :: Tree Char -> String<br />
treeToInorder = inorder<br />
where inorder Empty = ""<br />
inorder (Branch x l r) = inorder l ++ x : inorder r<br />
<br />
-- Given a preorder string produce a binary tree such that its preorder string<br />
-- is identical to the given one.<br />
preToTree :: String -> Tree Char<br />
preToTree "" = Empty<br />
preToTree (c:cs) = Branch c Empty (preorderToTree cs)<br />
<br />
-- Given a preorder and an inorder string with unique node chars produce the<br />
-- corresponding binary tree.<br />
preInTree :: Monad m => String -> String -> m (Tree Char)<br />
preInTree [] [] = return Empty<br />
preInTree po@(x:xs) io = do (lio,_:rio) <- return $ break (== x) io<br />
(lpo,rpo) <- return $ splitAt (length lio) xs<br />
l <- preInTree lpo lio<br />
r <- preInTree rpo rio<br />
return $ Branch x l r<br />
preInTree _ _ = fail "woops"<br />
</haskell></div>Lambdaloophttps://wiki.haskell.org/index.php?title=99_questions/Solutions/63&diff=3887799 questions/Solutions/632011-02-27T02:03:59Z<p>Lambdaloop: Added an alternative implementation for isCompleteBinaryTree</p>
<hr />
<div>Construct a complete binary tree<br />
<br />
A complete binary tree with height H is defined as follows:<br />
* The levels 1,2,3,...,H-1 contain the maximum number of nodes (i.e 2**(i-1) at the level i)<br />
* In level H, which may contain less than the maximum possible number of nodes, all the nodes are "left-adjusted". This means that in a levelorder tree traversal all internal nodes come first, the leaves come second, and empty successors (the nil's which are not really nodes!) come last. <br />
<br />
Particularly, complete binary trees are used as data structures (or addressing schemes) for heaps. <br />
<br />
We can assign an address number to each node in a complete binary tree by enumerating the nodes in level-order, starting at the root with number 1. For every node X with address A the following property holds: The address of X's left and right successors are 2*A and 2*A+1, respectively, if they exist. This fact can be used to elegantly construct a complete binary tree structure.<br />
<br />
Write a predicate complete_binary_tree/2.<br />
<br />
<haskell><br />
import Data.List <br />
<br />
data Tree a = Empty | Branch a (Tree a) (Tree a) <br />
deriving (Show, Eq) <br />
<br />
filled :: Tree a -> [[Bool]] <br />
filled Empty = repeat [False] <br />
filled (Branch _ l r) = [True] : zipWith (++) (filled l) (filled r) <br />
<br />
completeBinaryTree :: Int -> Tree Char <br />
completeBinaryTree n = generate_tree 1 <br />
where generate_tree x <br />
| x > n = Empty <br />
| otherwise = Branch 'x' (generate_tree (2*x) ) <br />
(generate_tree (2*x+1)) <br />
<br />
isCompleteBinaryTree :: Tree a -> Bool <br />
isCompleteBinaryTree Empty = True <br />
isCompleteBinaryTree t = and $ last_proper : zipWith (==) lengths powers <br />
where levels = takeWhile or $ filled t <br />
-- The upper levels of the tree should be filled. <br />
-- Every level has twice the number of nodes as the one above it, <br />
-- so [1,2,4,8,16,...] <br />
lengths = map (length . filter id) $ init levels <br />
powers = iterate (2*) 1 <br />
-- The last level should contain a number of filled spots, <br />
-- and (maybe) some empty spots, but no filled spots after that! <br />
last_filled = map head $ group $ last levels <br />
last_proper = head last_filled && (length last_filled) < 3 <br />
</haskell><br />
The "generate_tree" method here creates Node number "x", and then creates x's children nodes. By the property described above, these nodes are numbers 2*x and 2*x+1. If x > n, then the node is only created as Empty, and does not create children nodes.<br />
----<br />
Alternative solution which constructs complete binary trees from a given list using local recursion (also includes a lookup function as per the Prolog solution):<br />
<haskell><br />
completeBinaryTree :: Int -> a -> Tree a<br />
completeBinaryTree n = cbtFromList . replicate n<br />
<br />
cbtFromList :: [a] -> Tree a<br />
cbtFromList xs = let (t, xss) = cbt (xs:xss) in t<br />
where cbt ((x:xs):xss) =<br />
let (l, xss') = cbt xss<br />
(r, xss'') = cbt xss'<br />
in (Branch x l r, xs:xss'')<br />
cbt _ = (Empty, [])<br />
<br />
lookupIndex :: Tree a -> Integer -> a<br />
lookupIndex t = lookup t . path<br />
where lookup Empty _ = error "index to large"<br />
lookup (Branch x _ _) [] = x<br />
lookup (Branch x l r) (p:ps) = lookup (if even p then l else r) ps<br />
<br />
path = reverse . takeWhile (>1) . iterate (`div` 2) . (1+)<br />
</haskell><br />
<br />
----<br />
<br />
We can also implement <hask>isCompleteBinaryTree</hask> by generate the equal-sized CBT and compare.<br />
<br />
<haskell><br />
treeNodes Empty = 0<br />
treeNodes (Branch _ left right) = 1 + treeNodes left + treeNodes right<br />
<br />
treeEqual Empty Empty = True<br />
treeEqual (Branch _ l1 r1) (Branch _ l2 r2) =<br />
(treeEqual l1 l2) && (treeEqual r1 r2)<br />
treeEqual _ _ = False<br />
<br />
isCompleteBinaryTree t = treeEqual t $ completeBinaryTree $ treeNodes t<br />
</haskell><br />
<br />
<br />
----<br />
<br />
An alternative implementation for <hask>isCompleteBinaryTree</hask>:<br />
<haskell><br />
<br />
completeHeight Empty = Just 0<br />
completeHeight (Branch _ l r) = do<br />
hr <- completeHeight r<br />
hl <- completeHeight l<br />
if (hl == hr) || (hl - hr == 1)<br />
then return $ 1+hl<br />
else Nothing<br />
<br />
isCompleteBinaryTree = (/=Nothing) . completeHeight<br />
<br />
</haskell><br />
<br />
This uses a helper method <hask>completeHeight</hask> which calculates the height of a complete binary tree, or returns <hask>Nothing</hask> if it is not complete.</div>Lambdaloop