Given
data BTree a = End
| Node a (BTree a) (BTree a)
deriving(Show,Eq,Ord)
data Msg = Msg { from :: String
, to :: String
, when :: Int
, message :: String }
instance Ord Msg where
compare a b = (when a) `compare` (when b)
instance Eq Msg where
(==) a b = (when a) == (when b)
My function to count nodes (which seems off but that's aside from the question) is
count :: (Ord a) => (BTree a) -> Int
count = sum . count'
where
count' :: (Ord a) => (BTree a) -> [Int]
count' End = []
count' (Node _ l r) =
[1] ++ (count' l) ++ (count' r)
Does count not evaluate the contents of the Msg by virtue of its value being discarded by _? Perhaps a better question is, how do I know where lazy evaluation starts and ends for this sort of thing?
If the third line of count' was:
count' (Node (Msg x _ _ _) l r) =
Can I assume that the other three fields of Msg were accessed/evaluated, or does lazy evaluation go that far?
No. The fields of a data structure are evaluated lazily by default. Since you're not using the other fields in any way, they will not be evaluated by this code. If you want to make it so that evaluating a node forces all its fields to be evaluated, you can add strictness annotations to the fields:
data BTree a = End
| Node !a (BTree a) (BTree a)
deriving(Show,Eq,Ord)
data Msg = Msg { from :: !String
, to :: !String
, when :: !Int
, message :: !String }
Since counting the nodes forces the nodes themselves to be evaluated, this will also force the node values to be evaluated. If you only want this behavior for your one function, you can force evaluation in a more fine-grained manner using seq:
count' (Node x l r) = x `seq` ([1] ++ count' l ++ count' r)
or a bang pattern (requires the BangPatterns extension)
count' (Node !x l r) = [1] ++ count' l ++ count' r
Related
I have implement the Set datatype using Binary search tree.
My implementation is as follows:-
data Set a = Empty | Node a (Set a) (Set a)
I have also written some other functions such as toList, fromList, and Insert. (took help in my previous question)
These are the functions that I have written until now:
insert :: Ord a => a -> Set a -> Set a
insert x Empty = Node x Empty Empty
insert x (Node e l r)
| x == e = Node e l r
| x < e = Node e (insert x l) r
| otherwise = Node e l (insert x r)
fromList :: Ord a => [a] -> Set a
fromList [] = Empty
fromList (x:xs) = insert x (fromList xs)
toList :: Set a -> [a]
toList Empty = []
toList (Node val l r) = toList l ++ val : (toList r)
I have been trying to solve the following functions for quite a long time now. Can you please help me out. I have made multiple attempts , but none of them work.
---- return the common elements between two Sets
intersection :: (Ord a) => Set a -> Set a -> Set a
-- all the elements in Set A *not* in Set B,
-- {1,2,3,4} `difference` {3,4} => {1,2}
-- {} `difference` {0} => {}
difference :: (Ord a) => Set a -> Set a -> Set a
Here's my attempt to this function, which compiles without an error , but it does not solve the problem:
intersection :: (Ord a) => Set a -> Set a -> Set a
intersection Empty Empty = Empty
intersection l Empty = Empty
intersection Empty r = Empty
intersection (Node val1 Empty Empty) (Node val2 Empty Empty) = if val1
== val2 then (Node val1 Empty Empty) else Empty
intersection l (Node val1 l1 r1) = Node val1 (intersection l l1) r1
I cannot import any external module/ libraries. I have also written a setmap function if that helps .
Thank you for your help.
Here is my solution, it's not the best in performance but work, solution is create a list and use element function inside filter function.
module Lib
(
insert, fromList, toList, element, intersection, difference
)
where
data Set a = Empty | Node a (Set a) (Set a) deriving Show
insert :: Ord a => a -> Set a -> Set a
insert x Empty = Node x Empty Empty
insert x (Node e l r)
| x == e = Node e l r
| x < e = Node e (insert x l) r
| otherwise = Node e l (insert x r)
fromList :: Ord a => [a] -> Set a
fromList = foldr insert Empty
toList :: Set a -> [a]
toList Empty = []
toList (Node val l r) = toList l ++ val : toList r
element :: Ord t => Set t -> t -> Bool
element Empty _ = False
element (Node v l r) x
| x == v = True
| x < v = element l x
| otherwise = element r x
intersection :: (Ord a) => Set a -> Set a -> Set a
intersection s1 s2 = intersect
where
ls2 = toList s2
intersect = fromList $ filter (element s1) ls2
difference :: (Ord a) => Set a -> Set a -> Set a
difference s1 s2 = diff
where
ls1 = toList s1
diff = fromList $ filter (not.element s2) ls1
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.
What I want to do is to take a binary search tree, and an element, and then remove it from the tree
(if it is present).
Here is my code:
data BinaryTree a = Null | Node (BinaryTree a) a (BinaryTree a)
deriving Show
type BSTree a = BinaryTree a
treeDelete :: (Ord a) => (BSTree a) -> a -> (BSTree a)
treeDelete a btree = case btree of
Null -> Null
Node Null val Null
|a==val -> Null
|otherwise -> Node Null val Null
Node left val right
|a==val-> Node left Null right
|otherwise -> (treeDelete a left) val (treeDelete a right)
You can:
Change you data structure definition as
data BinaryTree a = Null | Node (BinaryTree a) (Maybe a) (BinaryTree a)
which is a simplified trie keyed by [Bool].
Define a rotation behavior (like in Balanced Tree) to fill in the blank after delete. The rotation is not unique. For example, for the lazy Map in the container package, the deletion of a balanced tree is defined as:
data Map k a = Bin Size k a (Map k a) (Map k a)
| Tip
type Size = Int
delete :: Ord k => k -> Map k a -> Map k a
delete = go
where
go :: Ord k => k -> Map k a -> Map k a
go !_ Tip = Tip
go k t#(Bin _ kx x l r) =
case compare k kx of
LT | l' == l -> t
| otherwise -> balanceR kx x l' r
where l' = go k l
GT | r' == r -> t
| otherwise -> balanceL kx x l r'
where r' = go k r
EQ -> glue l r
balanceR, balanceL and glue are rotation to balance depth in a balanced tree.
http://hackage.haskell.org/package/containers-0.6.2.1/docs/Data-Map-Lazy.html
I have the task of rewriting two Haskell functions of the Tree Datatype so that they also give out their computing steps.
The Functions are
leaves :: Tree a -> [a]
leaves Nil = []
leaves (Leaf a) = [a]
leaves (Br l r) = leaves l ++ leaves r
and
leaves'' :: Tree a -> [a]
leaves'' Nil = []
leaves'' (Leaf a) = [a]
leaves'' (Br Nil r) = leaves'' r
leaves'' (Br (Leaf a) r) = a: leaves'' r
leaves'' (Br (Br l' r') r) = leaves'' (Br l' (Br r' r))
The Datatype is
data Tree a = Leaf a |
Br (Tree a) (Tree a)|
Nil
deriving Show
I don't really even know how to begin
I don't really even know how to begin
I would start by defining what you mean by "give out their computing steps". Is your program supposed to print some output in a particular format?
The next thing you should do is decide what the new type of leaves ought to be. Not knowing the answer to the first question, one possibility is:
leaves :: Tree a -> ([ComputingStep], [a])
Or maybe you need to return the "steps" interleaved with the leaf elements?:
leaves :: Tree a -> [Either ComputingStep a]
From here, start with your base cases and go from there. You might like to look at a function like splitAt from Data.List for inspiration (an example of a recursive function that returns a tuple).
From comments I guessed you only need information how many function calls did you make. You may just sum them in pretty simple way:
leaves :: Tree a -> (Int, [a])
leaves''' Nil = (1, [])
leaves''' (Leaf a) = (1, [a])
leaves''' (Br l r) = let (n1, resl) = leaves''' l
(n2, resr) = leaves''' r
in (n1 + n2 + 1, resl ++ resr)
(and second variant in similar way)
I have the following abstract data type defined in Haskell:
data Trie = Leaf
| Node [(Char, Trie)]
deriving (Eq)
The Node type is a list of elements (c, t) where c is the label for the edge from the current node to t.
Now I want to print out the adjacency list of the tree. Specifically, I need to print one edge per row, where an edge is in the format:
n1 n2 c
with n1 the source, n2 the target, and c the label for the edge.
I can print the edges from my root node with
instance Show Trie where
show = show' 2 1
where show' _ _ Leaf = ""
show' next n1 (Node ts) = unlines $ zipWith (\n2 (c, _) ->
show n1 ++ " " ++ show n2 ++ " " ++ show c)
[next..] ts
but now I'm stuck how to recursively print the children. In particular, how do I number the children nodes?
Labeling nodes is quite trivial since GHC will do all the heavy lifting for you:
{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-}
import qualified Data.Traversable as T
import qualified Data.Foldable as F
import Control.Monad.State
data Trie a = Leaf a | Node a [(Char, Trie a)]
deriving (Eq, Functor, F.Foldable, T.Traversable)
number :: Trie a -> Trie (a, Int)
number = flip evalState 1 . T.mapM (\x -> state $ \n -> ((x,n),n+1))
As for printing the trie, I'm afraid that I don't quite understand the desired output.
I came up with this solution:
import Data.List (foldl')
enum :: Int -> Trie -> ([(Int,Int,Char)],Int)
enum x Leaf = ([],x+1)
enum x (Node pairs)
= let go (acc,y) (c,t) = (acc',y')
where acc' = [(x,y,c)] ++ edges ++ acc
(edges,y') = enum y t
in foldl' go ([],x+1) pairs
enum takes a starting id and a Trie and returns a list of edges and the next available id.
-- some examples:
leafs xs = [ (c,Leaf) | c <- xs ]
t1 = Node $ leafs "XYZ"
t2 = Node [('W', t1)]
t3 = Node $ [('A',t2)] ++ leafs "BC"
enum 1 t1 -- ([(1,4,'Z'),(1,3,'Y'),(1,2,'X')],5)
enum 1 t2 -- ([(1,2,'W'),(2,5,'Z'),(2,4,'Y'),(2,3,'X')],6)
enum 1 t3 -- ([(1,8,'C'),(1,7,'B'),(1,2,'A'),(2,3,'W'),(3,6,'Z'),(3,5,'Y'),(3,4,'X')],9)
Here's my attempt:
data Trie c =
Leaf
| Node [(c, Trie c)]
deriving (Eq)
instance Show c => Show (Trie c) where
show = show' 1 (\_ -> "\n") where
show' next cc Leaf = show next ++ "\n” ++ cc (next + 1)
show' next cc (Node []) = show next ++ "\n” ++ cc (next + 1)
show' next cc (Node [(c,t)] = show c ++ "(" ++ show next ++ ")” ++ show' (next+1) cc t
show' next cc (Node (x:xs)) = show' next (\n -> show' n cc $ Node xs) (Node [x])
I used continuation passing style to keep track of the state. There should be a way of making that code monadic, or using a zipper instead.
You may change the specific bits for leaves or nodes depending on whether you need them to be numbered or not (by changing the next + 1 part).