I want to write a Haskell function that checks if a tree is a perfect tree. I know that a tree is perfect if all the leaves of the tree are at the same depth.
I know I would start off like this
perfectTree :: Tree a -> Bool
But seeing that my grasp on the actual definition isn't too strong, can anyone actually explain what a perfect tree is and how you would go about checking that a tree is perfect in Haskell
I should have included that I defined data Type as follows:
data Tree a = Leaf | Node a (Tree a) (Tree a)
One way is to define a helper function perfectTreeHeight :: Tree a -> Maybe Int that returns Just the height of the tree if it's perfect, or Nothing otherwise. This is much easier to implement since you actually get the heights from the recursive calls so you can compare them. (Hint: use do-notation)
perfectTree is then just a trivial wrapper around this function.
import Data.Maybe (isJust)
perfectTree :: Tree a -> Bool
perfectTree = isJust . perfectTreeHeight
perfectTreeHeight :: Tree a -> Maybe Int
perfectTreeHeight = ...
Have you tried to think recursively about this?
Solution: The subtrees of the tree must all be perfect trees. Also, the depths of those subtrees should be equal. End.
I hope this high level solution/idea helps. I avoided to give an actual definition of perfectTree because I lack the actual definition of a Tree.
I'm assuming that your tree looks something like this...
data Tree a = Leaf a | Branch (Tree a) (Tree a) deriving Show
Now, we could define a recursive height function along these lines:
height :: Tree a -> Maybe Int
height (Leaf _) = Just 1
height (Branch a b) = ???
Ind the second case (???), we want to add one to the height of the subtrees, but only if they are perfect, and only if they have the same height. Let's define a helper function, same, which takes the heights of the subtrees, and returns a Maybe Int containing their height, but only if they are both perfect and have the same height.
same :: Eq a => Maybe a -> Maybe a -> Maybe a
same (Just a) (Just b) = if a == b then Just a else Nothing
same _ _ = Nothing
Now we can finish the height function. All it needs to do is add 1 to the height of the subtrees.
height :: Tree a -> Maybe Int
height (Leaf _) = Just 1
height (Branch a b) = maybe Nothing (Just . (1+)) subTreeHeight
where subTreeHeight = same (height a) (height b)
And here's how to use it.
main :: IO ()
main = do
let aTree = (Leaf 'a')
print aTree
print $ height aTree
let bTree = Branch (Leaf 'a') (Leaf 'b')
print bTree
print $ height bTree
let cTree = Branch (Leaf 'a') (Branch (Leaf 'b') (Leaf 'c'))
print cTree
print $ height cTree
let dTree = Branch (Branch (Leaf 'a') (Leaf 'b')) (Branch (Leaf 'c') (Leaf 'd'))
print dTree
print $ height dTree
When I run this, I get:
Leaf 'a'
Just 1
Branch (Leaf 'a') (Leaf 'b')
Just 2
Branch (Leaf 'a') (Branch (Leaf 'b') (Leaf 'c'))
Nothing
Branch (Branch (Leaf 'a') (Leaf 'b')) (Branch (Leaf 'c') (Leaf 'd'))
Just 3
Related
So for this problem I tried to take the sum of all leaves in a tree. But it's shooting an error every time. I am providing a snippet of the code I wrote.
Sample case
t1 =NODE 1 (NODE 2 (NODE 3 (LEAF 4) (LEAF 5)) (LEAF 6)) (NODE 7 (LEAF 8) (LEAF 9))
Answer should be 32.
data Tree a = LEAF a | NODE a (Tree a) (Tree a) deriving (Show, Read, Eq)
tre (LEAF a) = a
tre (NODE a (Tree b) (Tree c)) = [Tree b, Tree c]
sum [] accum = []
sum list#(x:xs) accum = if tre x == Int
then sumTree xs (accum + x)
else sumTree x accum
sumTree :: Num p => Tree p -> p
sumTree p accum= let
list = tre p
in sum list accum
32
The Haskell snipet provided is not the idiomatic Haskell way of solving the problem.
You don't need the tre function => use Pattern matching on constructors of your type
You don't have to use tre x == Int let out the magic of type inference
I've provided the following snippet of the code, load it into ghci and use :i Tree and :i sumTree to understand the types
module Main where
data Tree a = Leaf a | Node a (Tree a) (Tree a) deriving (Show)
sumTree (Leaf a) = a
sumTree (Node a l r) = a + sumTree l + sumTree r
main = do
let tree = Node 5 (Node 21 (Leaf 14) (Leaf 13)) (Leaf 29)
putStrLn $ show tree
putStrLn $ show $ sumTree tree
When I take a mixed tree from char and float I have to seperate them as a Float or Character in haskell and add them to the specific list I tried to write something as you can see below;
I tried to take a as [a] in the else part but it gives error too.
data BETree = Leaf Float | Node Char BETree BETree deriving (Show, Ord, Eq)
charList :: [Char]
charList = []
floatList :: [Float]
floatList = []
toList :: BETree -> ([Float], [Char])
toList (Node a l r) = if (a :: Char ) then (charList ++ [a])
else (floatList ++ a)
I expect to entered values to seperate for floatList and charList however I get errors like this;
Couldn't match expected type ‘[[Char]]’ with actual type ‘Char’
OR
vice versa
There are a couple of aspects of Haskell that you haven't mastered yet, and they're causing you some difficulty.
First, as you probably know, Haskell takes its types very seriously. It's a strongly typed language, so that means that the whole concept of searching through a data structure to find values of a particular type is the wrong way of thinking about this problem. The definition of BETree is:
data BETree = Leaf Float | Node Char BETree BETree deriving (Show, Ord, Eq)
which says that this structure consists of Leafs that contain a Float and internal Nodes that contain a Char. So, if you want to find all the Char values, you don't check the types, you just look for the Nodes. They will all contain Chars and can't contain anything else, by the definition of BETree. In other words, in your function definition:
toList (Node a l r) = ...
you don't need to try to check the type of a -- it's guaranteed to be Char by the definition of Node in the BETree definition. If you separately write a definition:
toList (Leaf x) = ...
then you're similarly guaranteed that x is a Float, and you don't need to check any types.
Second, Haskell normally works with immutable values. This means that, unlike in most other languages, you usually don't start by creating an empty list and then trying to add elements to it in a separate function. Instead, you usually write recursive functions that return the "list so far", which they generate by adding an element (or elements) to the list returned by recursively calling themselves. As a simple example, to write a function that builds up the list of all positive integers in an input list, you'd write:
positiveInts :: [Int] -> [Int]
positiveInts (x:xs) | x > 0 = x : positiveInts xs -- add "x" to list from recursive call
| otherwise = positiveInts xs -- drop "x"
positiveInts [] = []
So. here's how it might work for your problem, starting with the simpler problem of just building the floatList:
toFloatList :: BETree -> [Float]
toFloatList (Leaf x) = [x] -- x is guaranteed to be a Float, so return it
toFloatList (Node _a l r) = -- _a can't be a float, so ignore it
toFloatList l ++ toFloatList r -- but recurse to find more Floats in Leafs
And test it:
> toFloatList (Node 'x' (Leaf 1.0) (Node 'y' (Leaf 3.0) (Leaf 4.0)))
[1.0,3.0,4.0]
>
Building just the charList is only slightly more complicated:
toCharList :: BETree -> [Char]
toCharList (Leaf _x) = [] -- x is guaranteed to be a Float, so no Chars here
toCharList (Node a l r) = -- "a" is a Char
toCharList l ++ [a] ++ toCharList r -- recurse and put "a" in the middle
and testing it:
> toCharList (Node 'x' (Leaf 1.0) (Node 'y' (Leaf 3.0) (Leaf 4.0)))
"xy"
> "xy" == ['x','y']
True
>
In Haskell, the list of Chars ['x','y'] is equivalent to the string "xy" which is why it gets printed this way.
Now, the easiest way to define toList is:
toList :: BETree -> ([Float], [Char])
toList bet = (toFloatList bet, toCharList bet)
This traverses the tree twice. If you want to build both lists together in a single traversal, things get significantly more complicated:
toList' :: BETree -> ([Float], [Char])
toList' (Leaf x) = ([x],[]) -- easy, since Leaf contains only one Float
toList' (Node a l r) = -- Nodes are harder
let (fl1, cl1) = toList' l -- lists from the left branch
(fl2, cl2) = toList' r -- lists from the right branch
in (fl1 ++ fl2, cl1 ++ [a] ++ cl2) -- combine with our Char "a"
and the test:
> toList (Node 'x' (Leaf 1.0) (Node 'y' (Leaf 3.0) (Leaf 4.0)))
([1.0,3.0,4.0],"xy")
> toList' (Node 'x' (Leaf 1.0) (Node 'y' (Leaf 3.0) (Leaf 4.0)))
([1.0,3.0,4.0],"xy")
>
I want to do what the title says, but it keeps me showing errors. I put my code below.
data Tree a = Leaf a | Branch (Tree a) (Tree a) deriving Show
treeToList :: Tree a -> [a]
treeToList (Leaf x) = [x]
treeToList (Branch a b) = (treeToList a):(treeToList b)
It would show something like this:
treeToList Branch (Branch (Leaf 2) (Leaf 3)) (Leaf 4)
[2,3,4]
In the first pattern match you get a value of type list. Now all you have to do is concatenate them when you pattern match the Branch constructor.
treeToList :: Tree a -> [a]
treeToList (Leaf x) = [x]
treeToList (Branch a b) = (treeToList a) ++ (treeToList b)
Demo in ghci:
*Main> treeToList (Branch (Branch (Leaf 2) (Leaf 3)) (Leaf 4))
[2,3,4]
I want to define a State monad that manages errors (in a sense like Maybe): if an error/problem occurs during the "do" computation, it is signal led and propagated by >>=.
The error should also contain a string describing it.
After, i want to apply this monad to mapTreeM, using for map a function that assumes states as numbers and a tree containing numbers, and at each visiting step updates the current state by adding to it the value of the current leaf; the resulting tree must contain a pair with the old leaf value and the state at the visiting instant. Such visit must fail if the state becomes negative during the computation, and succeed if it is positive.
e.g. Given this tree: Branch (Branch (Leaf 7) (Branch (Leaf (-1)) (Leaf 3))) (Branch (Leaf (-2)) (Leaf 9))
We obtain a tree (considering the initial state 0): Branch (Branch (Leaf (7,7)) (Branch (Leaf (-1,6)) (Leaf (3,9)))) (Branch (Leaf (-2,7)) (Leaf (9,16)))
If we put -18 in the second leaf, we should obtain an erroneous value signaling that we reached a negative state (-11).
I did a thing like this to print the tree without managing errors...i haven't understood how to do it.
The following is my code:
module Main where
-- State monad
newtype State st a = State (st -> (st, a))
instance Monad (State state) where
return x = State(\s -> (s,x))
State f >>= g = State(\oldstate ->
let (newstate, val) = f oldstate
State newf = g val
in newf newstate)
-- Recursive data structure for representing trees
data Tree a = Leaf a | Branch (Tree a) (Tree a)
deriving (Show,Eq)
-- Utility methods
getState :: State state state
getState = State(\state -> (state,state))
putState :: state -> State state ()
putState new = State(\_ -> (new, ()))
mapTreeM :: (Num a) => (a -> State state b) -> Tree a -> State state (Tree b)
mapTreeM f (Leaf a) =
f a >>= (\b -> return (Leaf b))
mapTreeM f (Branch lhs rhs) = do
lhs' <- mapTreeM f lhs
rhs' <- mapTreeM f rhs
return (Branch lhs' rhs')
numberTree :: (Num a) => Tree a -> State a (Tree (a,a))
numberTree tree = mapTreeM number tree
where number v = do
cur <- getState
putState(cur+v)
return (v,cur+v)
-- An instance of a tree
testTree = (Branch
(Branch
(Leaf 7) (Branch (Leaf (-1)) (Leaf 3)))
(Branch
(Leaf (-2)) (Leaf (-20))))
runStateM :: State state a -> state -> a
runStateM (State f) st = snd (f st)
main :: IO()
main = print $ runStateM (numberTree testTree) 0
Can I propose an alternative solution to your problem? While Monads are good for many things, what you want to do can be done with a simple function that
keeps track of errors.
My function transferVal below is an example of such function.
The function transferVal traverses the
Tree from left to right while keeping the last value found. If an error occurs, the function returns the error and stops traversing the Tree.
Instead of using Maybe, it is often better to use Either <error_type> <result_type> to get a more clear error if something goes wrong. In my example, I use ([ChildDir],a) where [ChildDir] contains the
"direction" of the incriminated node and a is the erroneous value that triggered the error. The function printErrorsOrTree is an example of how you can use the output of transferVal and main contains 4 examples of which the first three are correct and the last one triggers the error that you was expecting.
module Main where
import Data.List (intercalate)
import Control.Monad (mapM_)
data Tree a = Leaf a | Branch (Tree a) (Tree a)
deriving (Show,Eq)
-- given a Branch, in which child the error is?
data ChildDir = LeftChild | RightChild
deriving Show
-- an error is the direction to get to the error from the root and the
-- value that triggered the error
type Error a = ([ChildDir],a)
-- util to append a direction to an error
appendDir :: ChildDir -> Error a -> Error a
appendDir d (ds,x) = (d:ds,x)
transferVal :: (Ord a,Num a) => Tree a -> Either (Error a) (Tree (a,a))
transferVal = fmap fst . go 0
where go :: (Ord a,Num a) => a -> Tree a -> Either (Error a) (Tree (a,a),a)
go c (Leaf x) = let newC = x + c
in if newC < 0
then Left ([],newC)
else Right (Leaf (x,newC),newC)
go c (Branch t1 t2) = case go c t1 of
Left e -> Left $ appendDir LeftChild e
Right (newT1,newC) -> case go newC t2 of
Left e -> Left $ appendDir RightChild e
Right (newT2,newC') -> Right (Branch newT1 newT2,newC')
printErrorsOrTree :: (Show a,Show b) => Either (Error a) (Tree b) -> IO ()
printErrorsOrTree (Left (ds,x)) = putStrLn $ "Error in position " ++ (intercalate " -> " $ map show ds) ++ ". Error value is " ++ show x
printErrorsOrTree (Right t) = putStrLn $ "Result: " ++ show t
main :: IO ()
main = mapM_ runExample
[(Leaf 1)
,(Branch (Leaf 1) (Leaf 2))
,(Branch (Branch (Leaf 7) (Branch (Leaf (-1)) (Leaf 3))) (Branch (Leaf (-2)) (Leaf 9)))
,(Branch (Branch (Leaf 7) (Branch (Leaf (-11)) (Leaf 3))) (Branch (Leaf (-2)) (Leaf 9)))]
where runExample orig = do
let res = transferVal orig
print orig
printErrorsOrTree res
By making your Tree datatype an instance of Traversable, you can use mapM (from Data.Traversable) to map an action over a Tree. You can also layer the StateT monad transformer atop the Either monad to provide error handling.
import Control.Monad.State
import Control.Applicative
import Control.Monad.Error
import Data.Monoid
import Data.Foldable
import Data.Traversable
import qualified Data.Traversable as T
-- our monad which carries state but allows for errors with string message
type M s = StateT s (Either String)
data Tree a = Leaf a | Branch (Tree a) (Tree a)
deriving (Show,Eq)
-- Traversable requires Functor
instance Functor Tree where
fmap f (Leaf a) = Leaf (f a)
fmap f (Branch lhs rhs) = Branch (fmap f lhs) (fmap f rhs)
-- Traversable requires Foldable
instance Foldable Tree where
foldMap f (Leaf a) = f a
foldMap f (Branch lhs rhs) = foldMap f lhs `mappend` foldMap f rhs
-- Finally, we can get to Traversable
instance Traversable Tree where
traverse f (Leaf a) = Leaf <$> f a
traverse f (Branch lhs rhs) = Branch <$> traverse f lhs <*> traverse f rhs
testTree = (Branch
(Branch
(Leaf 7) (Branch (Leaf (-1)) (Leaf 3)))
(Branch
(Leaf (-2)) (Leaf (-20))))
numberTree :: (Num a, Ord a) => Tree a -> M a (Tree (a,a))
numberTree = T.mapM number where
number v = do
cur <- get
let nxt = cur+v
-- lift the error into the StateT layer
when (nxt < 0) $ throwError "state went negative"
put nxt
return (v, nxt)
main :: IO ()
main =
case evalStateT (numberTree testTree) 0 of
Left e -> putStrLn $ "Error: " ++ e
Right t -> putStrLn $ "Success: " ++ show t
Have a problem with trees in Haskell. There is a tree:
data Tree a b = Leaf a | Branch (b,Tree a b) (b,Tree a b)
deriving(Eq, Show)
tree = Branch
("A",Branch
("C",Leaf 3)
("D",Branch
("G",Leaf 7)
("H",Leaf 6)
)
)
("B",Branch
("E",Leaf 5)
("F",Leaf 4)
)
I need to define a function, that returns a list of all branches in this tree, the Output is like this: [["A", "C"], ["A", "D", "G"],["A","D","H"],["B","E"],["B","F"]]. What I do is wrong, but have no idea how to fix it:
branch:: Tree a b -> [[b]]
branch (Leaf x) = []
branch (Branch (a,right) (b,left)) = ([y] ++ branch left) ++ ([b] ++ branch right)
The output I get is ["A","C","D","G","H","B","E","F"]
I think something like this should work:
branch :: Tree a b -> [[b]]
branch (Leaf _) = [[]]
branch (Branch (a, right) (b, left)) = map (a :) (branch right)
++ map (b :) (branch left)