I have following toy haskell code for binary search tree. The function preorderV is to traverse the tree with a function applying to every element. It works fine for normal function. However if I apply function "print", I got compiling error. How could I make function related to IO work with preorderV?
Thanks
Code:
data BSTree a = EmptyTree | Node a (BSTree a) (BSTree a) deriving (Show)
data Mode = IN | POST | PRE
singleNode :: a -> BSTree a
singleNode x = Node x EmptyTree EmptyTree
bstInsert :: (Ord a) => a -> BSTree a -> BSTree a
bstInsert x EmptyTree = singleNode x
bstInsert x (Node a left right)
| x == a = Node a left right
| x < a = Node a (bstInsert x left) right
| x > a = Node a left (bstInsert x right)
buildTree :: String -> BSTree String
buildTree = foldr bstInsert EmptyTree . words
preorderV :: (a->b) -> BSTree a -> BSTree b
preorderV f EmptyTree = EmptyTree
preorderV f (Node x left right) = Node (f x) (preorderV f left) (preorderV f right)
Error:
Couldn't match type ‘BSTree’ with ‘IO’
Expected type: IO (IO ())
Actual type: BSTree (IO ())
In a stmt of a 'do' block: preorderV print $ buildTree content
The type of preorderV print $ buildTree content is BSTree (IO ()), that is, you are creating a binary tree of IO computations - you don't have an IO computation itself.
To do what I think you want to do you need to create a monadic version of preorderV which has the following type:
preorderVM :: (a -> IO ()) -> BSTree a -> IO ()
preorderVM f EmptyTree = ... -- what do you want to do here?
preorderVM f (Node x left right) = do
f x
preorderVM f left
preorderVM f right
your code works so far but you got a BSTree (IO ()) back and as you use this inside a do Block (main most likely) you get the error.
what you now can do is fold over the tree to get the actions back, then you can use sequence or something similar to use each of those actions one after the other:
foldT :: (a -> s -> s) -> s -> BSTree a -> s
foldT _ s EmptyTree = s
foldT f s (Node a left right) =
let s' = foldT f s left
s'' = f a s'
in foldT f s'' right
main :: IO ()
main = do
let doPrint = preorderV print $ buildTree "C A B D E"
folded = foldT (:) [] doPrint
sequence_ . reverse $ folded
This will print
λ> :main
"A"
"B"
"C"
"D"
"E"
BTW: Your preorderV is usually called map ;)
Related
I really like the repmin problem:
Write down repmin :: Tree Int -> Tree Int, which replaces all the numbers in the tree by their minimum in a single pass.
If I were writing something like this in python, I would go for passing values by their reference (let's say one-element lists instead of numbers is good enough):
def repmin(tree, wrapped_min_link=None):
x, subforest = tree
if wrapped_min_link is None:
wrapped_min_link = [x]
else:
[m] = wrapped_min_link
wrapped_min_link = [min(m, x)]
n = len(subforest)
subforest_min = [None] * n
for i in range(n):
if subforest[i]:
subforest_min[i] = repmin(subforest[i], wrapped_min_link)
return (wrapped_min_link, subforest_min)
It seems to me like a fitting way to wrap one's head around the knot-tying solution in Haskell (I wrote this one for rose trees from Data.Tree):
copyRose :: Tree Int -> Int -> (Tree Int, Int)
copyRose (Node x []) m = (Node m [], x)
copyRose (Node x fo) m =
let
unzipIdMinimum =
foldr (\ ~(a, b) ~(as, bmin) -> (a:as, b `min` bmin)) ([], maxBound :: Int)
(fo', y) = unzipIdMinimum . map (flip copyRose m) $ fo
in (Node m fo', x `min` y)
repmin :: Tree Int -> Tree Int
repmin = (loop . uncurry) copyRose
Yet, I reckon the solutions to work very differently. Here is my understanding of the latter one:
Let us rewrite loop for (->) a bit:
loop f b = let cd = f (b, snd cd) in fst cd
I reckon it to be loop for (->)'s workalike as snd gives the same degree of laziness as pattern-matching within let.
So, when repmin traverses through the tree, it is:
Building up the minimum in the tree to be returned as the second element of the pair.
Leaves snd $ copyRose (tree, m) behind in every node.
Thus, when the traversal comes to an end, the programme knows the value of snd $ copyRose (tree, m) (that is, the minimum in the tree) and is able to show it whenever some node of the tree is being computed.
Do I understand repmin in Haskell correctly?
This is more an extended comment than an answer, but I don't really think of your implementation as single-pass. It looks like it traverses the tree once, producing a new, lazily-generated, tree and the global minimum, but it actually produces a lazily generated tree and an enormous tree of thunks that will eventually calculate the minimum. To avoid this, you can get closer to the Python code by generating the tree eagerly, keeping track of the minimum as you go.
You'll note that I've generalized the type from Int to an arbitrary Ord type. You'll also note that I've used to different type variables to refer to the type of elements in the given tree and the type of the minimum passed in to generate a new tree—this lets the type system tell me if I mix them up.
repmin :: Tree a -> Tree a
repmin = (loop . uncurry) copyRose
copyRose :: Ord a => Tree a -> b -> (Tree b, a)
copyRose (Node x ts) final_min
| (ts', m) <- copyForest x ts final_min
= (Node final_min ts', m)
copyForest :: Ord a => a -> [Tree a] -> b -> ([Tree b], a)
copyForest !m [] _final_min = ([], m)
copyForest !m (t : ts) final_min
| (t', m') <- copyTree m t final_min
, (ts', m'') <- copyForest m' ts final_min
= (t' : ts', m'')
copyTree :: Ord a => a -> Tree a -> b -> (Tree b, a)
copyTree !m (Node x ts) final_min
| (ts', m') <- copyForest (min m x) ts final_min
= (Node final_min ts', m')
Exercise: rewrite this in monadic style using ReaderT to pass the global minimum and State to keep track of the minimum so far.
I want to return the list of all the subtrees of the initial tree with the depth given in parameter
I've tried to return the list of the tree when the depth is 0 and when depth matching with n, I want to decrement n and apply the map function using my function and the n parameter decremented to the list of subtrees
data Tree t = Node t [Tree t] deriving (Show, Eq)
exTree :: Tree Int
exTree = Node 1 [ Node 2 [], Node 3 [ Node 4 [], Node 5 [],Node 6 []]]
height :: Tree t -> Int
height (Node _ []) = 1
height (Node _ l) = 1 + maximum (map height l)
treemap :: (t->t) -> Tree t -> Tree t
treemap f (Node x []) = Node (f x) []
treemap f (Node x l) = Node (f x) (map (treemap f) l)
-- Here is the function concerned:
extrForest :: Int -> Tree t -> [Tree t]
extrForest 0 a = [a]
extrForest n (Node _ l) = map (extrForest (n-1)) l
Here is the error message:
Couldn't match type ‘[Tree t]’ with ‘Tree t’
Expected type: Tree t -> Tree t
Actual type: Tree t -> [Tree t]
Relevant bindings include
l :: [Tree t] (bound at ds2.hs:16:22)
extrForest :: Int -> Tree t -> [Tree t] (bound at ds2.hs:15:1)
In the first argument of ‘map’, namely ‘(extrForest (n - 1))’
In the expression: map (extrForest (n - 1)) l
Still don't quite understand what you need, so here is a very ad-hoc solution.
Looking at your error, it is clear that you have the common problem [a] vs [[a]].
When you look at the type signature map :: (a -> b) -> [a] -> [b] you see that your function has to take an [a] and return a simple [b], not [[b]], as this then needs to be mapped over again. However, your extForest returns a list of forests, so what you should do, is to concatenate them: concat . map. Turns out this is a common thing, and there's a Prelude function to do this: concatMap :: Foldable t => (a -> [b]) -> t a -> [b].
An ADT can be represented using the Scott Encoding by replacing products by tuples and sums by matchers. For example:
data List a = Cons a (List a) | Nil
Can be encoded using the Scott Encoding as:
cons = (λ h t c n . c h t)
nil = (λ c n . n)
But I couldn't find how nested types can be encoded using SE:
data Tree a = Node (List (Tree a)) | Leaf a
How can it be done?
If the Wikipedia article is correct, then
data Tree a = Node (List (Tree a)) | Leaf a
has Scott encoding
node = λ a . λ node leaf . node a
leaf = λ a . λ node leaf . leaf a
It looks like the Scott encoding is indifferent to (nested) types. All it's concerned with is delivering the correct number of parameters to the constructors.
Scott encodings are basically representing a T by the type of its case expression. So for lists, we would define a case expression like so:
listCase :: List a -> r -> (a -> List a -> r) -> r
listCase [] n c = n
listCase (x:xs) n c = c x xs
this gives us an analogy like so:
case xs of { [] -> n ; (x:xs) -> c }
=
listCase xs n (\x xs -> c)
This gives a type
newtype List a = List { listCase :: r -> (a -> List a -> r) -> r }
The constructors are just the values that pick the appropriate branches:
nil :: List a
nil = List $ \n c -> n
cons :: a -> List a -> List a
cons x xs = List $ \n c -> c x xs
We can work backwards then, from a boring case expression, to the case function, to the type, for your trees:
case t of { Leaf x -> l ; Node xs -> n }
which should be roughly like
treeCase t (\x -> l) (\xs -> n)
So we get
treeCase :: Tree a -> (a -> r) -> (List (Tree a) -> r) -> r
treeCase (Leaf x) l n = l x
treeCase (Node xs) l n = n xs
newtype Tree a = Tree { treeCase :: (a -> r) -> (List (Tree a) -> r) -> r }
leaf :: a -> Tree a
leaf x = Tree $ \l n -> l x
node :: List (Tree a) -> Tree a
node xs = Tree $ \l n -> n xs
Scott encodings are very easy tho, because they're only case. Church encodings are folds, which are notoriously hard for nested types.
I am completely new to Haskell and trying to learn. I decided to write a short (unbalanced) binary search tree code just to get going. It breaks a text into words, adds the words to the binary tree (discarding repetitions), and then traverses the tree in order to print out the sorted list of words in the text.
data BinTree t = ExternalNode
| InternalNode (BinTree t) t (BinTree t)
treeInsert :: Ord t => BinTree t -> t -> BinTree t
treeInsert ExternalNode w = InternalNode ExternalNode w ExternalNode
treeInsert tree#(InternalNode left v right) w
| w == v = tree
| w < v = InternalNode (treeInsert left w) v right
| otherwise = InternalNode left v (treeInsert right w)
treeFromList :: Ord t => [t] -> BinTree t
treeFromList l = go ExternalNode l
where
go acc [] = acc
go acc (x : xs) = acc `seq` go (treeInsert acc x) xs
inOrderList :: BinTree t -> [t]
inOrderList ExternalNode = []
inOrderList (InternalNode left v right) = (inOrderList left) ++ [ v ] ++ (inOrderList right)
main :: IO ()
main = do
tmp <- readFile "words.txt"
printList . inOrderList . treeFromList $ words tmp
where
printList [] = return ()
printList (x : xs) = do
putStrLn x
printList xs
The program works fine on small texts. Then I fed the King James Bible to it. It crashes complaining that the stack size is too small. I have to increase the stack size to 200M to make it work!
Where is my mistake? I imagine it could have something to do with lazy evaluation messing up stuff. In any case, the problem is not with the depth of the binary search tree, which is only 163 for the Bible example.
The problem is that you are building up too deeply nested thunks.
This version adds seq calls in treeInsert to force evaluation at each level of the tree
and can run in very little stack:
import System.Environment
import Control.Monad
data BinTree t = ExternalNode
| InternalNode (BinTree t) !t (BinTree t)
treeInsert :: Ord t => BinTree t -> t -> BinTree t
treeInsert ExternalNode w = InternalNode ExternalNode w ExternalNode
treeInsert tree#(InternalNode left v right) w
| w == v = tree
| w < v = let t = treeInsert left w in t `seq` InternalNode t v right
| otherwise = let t = treeInsert right w in t `seq` InternalNode left v t
treeFromList :: Ord t => [t] -> BinTree t
treeFromList l = go ExternalNode l
where
go acc [] = acc
go acc (x : xs) = let t = treeInsert acc x in t `seq` go t xs
inOrderList :: BinTree t -> [t]
inOrderList ExternalNode = []
inOrderList (InternalNode left v right) = (inOrderList left) ++ [ v ] ++ (inOrderList right)
main1 = do
(arg0:_) <- getArgs
tmp <- readFile arg0
let t = treeFromList $ words tmp
forM_ (inOrderList t) putStrLn
main = main1
You can also use strictness annotations in the definition of BinTree:
data BinTree t = ExternalNode | InternalNode !(BinTree t) !t !(BinTree t)
in lieu of the seq calls in treeInsert - this is what Data.Set does.
It appears that the seq call in treeFromList doesn't have much effect.
Given the following Algrebaic Data Structure:
data Tree a = Node {
rootLabel :: a,
subForest :: [Tree a]
} deriving (Show)
and fold:
treeFold :: (a -> [b] -> b) -> Tree a -> b
treeFold f (Node x ts) = f x (map (treeFold' f) ts)
How can I get an [a] from a Tree a?
Do you mean using fold? You can get a function Tree a -> [a] pretty straightforward:
collapse :: Tree a -> [a]
collapse (Node x ts) = x : (concat $ map collapse ts)
Prelude> let t = Node 3 [Node 2 [], Node 4 [], Node 6 []]
Prelude> collapse t
[3,2,4,6]
If you specifically want to use fold, I guess you could do something similar:
collapse' :: Tree a -> [a]
collapse' = treeFold (\x tss -> x : (concat tss))
Prelude> collapse' t
[3,2,4,6]
I personally think the first version is clearer.