I'm a beginner to Haskell.
I've implemented a set as a binary tree
Set a = Node a | Tree a (Set a) (Set a)
I've been stuck on creating a powers function. Any ideas on how I could implement a powerset function, ideally not completely the same as Data.Set 馃槄?
Let's look at a simpler version of powerset that uses lists:
powerset [] = [[]]
powerset (x:xs) = [x:ps | ps <- pxs] ++ pxs where
pxs = powerset xs
Running powerset [1, 2, 3] yields [[1,2,3],[1,2],[1,3],[1],[2,3],[2],[3],[]]
From this you can see basic functions and data definitions needed for implementing the operations with BSTs:
powerset [] = [[]] an empty set, which is missing in your case as pointed out in the comments
x:ps a way to add an element to a set
And, a more subtle one: removing an element from the set, because (x:xs) splits the set int x and xs which is used in pxs = powerset xs
A simple implementation would look like this:
data TreeSet a = Node (TreeSet a) a (TreeSet a) | Nil deriving Show
powersetTree :: (Ord a) => TreeSet a -> [TreeSet a]
powersetTree Nil = [Nil]
powersetTree tree =
[addTreeSet subtree v | subtree <- pxs] ++ pxs where
(Node l v r) = tree
pxs = powersetTree (removeTreeSet tree v)
addTreeSet :: (Ord a) => TreeSet a -> a -> TreeSet a
addTreeSet Nil x = Node Nil x Nil
addTreeSet (Node l v r) x =
if x < v then
Node (addTreeSet l x) v r
else if x > v then
Node l v (addTreeSet r x)
else error "Duplicate element"
removeTreeSet :: (Ord a) => TreeSet a -> a -> TreeSet a
removeTreeSet Nil a = error "Can't remove from empty set"
removeTreeSet (Node l v r) x =
if v == x then
unionTreeSet l r
else if x < v then
Node (removeTreeSet l x) v r
else
Node l v (removeTreeSet r x)
unionTreeSet :: (Ord a) => TreeSet a -> TreeSet a -> TreeSet a
unionTreeSet Nil Nil = Nil
unionTreeSet Nil r = r
unionTreeSet l Nil = l
unionTreeSet l (Node rl rv rr) = Node (unionTreeSet l rl) rv rr
buildTreeSet [] = Nil
buildTreeSet (x:xs) = addTreeSet ts x where ts = buildTreeSet xs
showTreeSet Nil = []
showTreeSet (Node l v r) = (showTreeSet l) ++ [v] ++ (showTreeSet r)
powerset' xs =
foldr (:) [] lists where
tree = buildTreeSet xs
treeList = powersetTree tree
lists = map showTreeSet treeList
You can try it by running powerset' [1, 2, 3] which yields [[1,2,3],[2,3],[1,3],[3],[1,2],[2],[1],[]]
Some notes:
Efficiency: my main goal above was to write the functions in simplest way to show the basic idea (maybe except powerset'). For example the performance of buildTreeSetcould be easily improved by using tail recursion with an accumulator like so:
buildTreeSet' l = build l Nil where
build [] tree = tree
build (x:xs) partTree = build xs (addTreeSet partTree x)
Another glaring problem is that if the list given as input to buildTreeSet is ordered, the tree build will be degenerate, effectively acting as a linked list, which defeats the point of using trees. The same applies for removeTreeSet and unionTreeSet because the latter just chains the two trees.
Error handling: I used error (which is like throwing an exception in java or c++) to keep the code simple. However you should consider using types like Maybe or Either to indicate that functions might fail. A big advantage of functional programming that the possibility of failure can be indicated by the signature of the function, forcing the programmer to handle errors at compile time (by checking if the return was Just or Nothing) instead of throwing errors at runtime.
Here's an example for removeTreeSet:
removeTreeSetSafe :: (Ord a) => TreeSet a -> a -> Maybe (TreeSet a)
removeTreeSetSafe Nil a = Nothing
removeTreeSetSafe (Node l v r) x =
if v == x then
Just (unionTreeSet l r)
else if x < v then
let mTree = (removeTreeSetSafe l x) in
case mTree of
(Just tree) -> Just (Node tree v r)
Nothing -> Nothing
else
let mTree = (removeTreeSetSafe r x) in
case mTree of
(Just tree) -> Just (Node l v tree)
Nothing -> Nothing
Here is an example of the difference:
> tree = buildTreeSet [1..4]
> tree
Node (Node (Node (Node Nil 1 Nil) 2 Nil) 3 Nil) 4 Nil
> removeTreeSet tree 2
Node (Node (Node Nil 1 Nil) 3 Nil) 4 Nil
> removeTreeSet Nil 2
*** Exception: Can't remove from empty set
CallStack (from HasCallStack):
error, called at main.hs:24:23 in main:Main
> removeTreeSetSafe tree 2
Just (Node (Node (Node Nil 1 Nil) 3 Nil) 4 Nil)
> removeTreeSetSafe Nil 2
Nothing
In the first case with removeTreeSet if an element is not found or the set is empty the program will simply exit with an error (assuming it was compiled).
In the second case using removeTreeSetSafe we are forced to handle the possibility of failure, else the code won't compile (as in you can't replace removeTreeSet with removeTreeSetSafe)
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
data Set a = Node | Tree (Set a) (Set a)
How can I implement a partition function which partitions the set into two sets, with all elements that satisfy the predicate on the left and the rest on the right as simply as possible?
Any help is appreciated.
Thanks in advance!
As noted in the comments, your type won't quite cut it. A reasonable implementation of a set as a tree might have type:
data Set a = Leaf | Node a (Set a) (Set a) deriving (Show)
^- note this extra `a`
where each internal Node x l r has all elements in l less than x and all elements in r greater than x.
You can partition such a Set recursively as follows:
partition :: (a -> Bool) -> Set a -> (Set a, Set a)
The Leaf case is easy, obviously:
partition _ Leaf = (Leaf, Leaf)
Here's how we do the Node case. For the sub-case where the predicate holds for the value x in the node, note that we want:
partition f (Node x l r) | f x = (Node x l1 r1, ...)
where l1 and r1 are the subsets of elements in l and r that satisfy the predicate, which we can get by recursively partitioning l and r.
where (l1, l2) = partition f l
(r1, r2) = partition f r
The Set invariant will be preserved here, because all elements in l, including those in the subset l1 are less than x; for the same reason, all elements in r1 are greater than x. The only missing piece is that we somehow need to combine l2 and r2 to form the second part of the tuple:
partition f (Node x l r) | f x = (Node x l1 r1, combine l2 r2)
Since combine is a function that takes two trees with all elements in the first tree less than all elements in the second tree, the following recursive function will do:
combine Leaf r' = r'
combine (Node x l r) r' = Node x l (combine r r')
The case where the predicate does not hold for x is handled similarly, giving the full definition:
data Set a = Leaf | Node a (Set a) (Set a)
partition :: (a -> Bool) -> Set a -> (Set a, Set a)
partition _ Leaf = (Leaf, Leaf)
partition f (Node x l r)
| f x = (Node x l1 r1, combine l2 r2)
| otherwise = (combine l1 r1, Node x l2 r2)
where (l1, l2) = partition f l
(r1, r2) = partition f r
combine Leaf r' = r'
combine (Node x l r) r' = Node x l (combine r r')
Here's the complete code plus a QuickCheck test that that partition function works as expected:
import Test.QuickCheck
import qualified Data.List (nub, partition, sort)
import Data.List (nub, sort)
data Set a = Leaf | Node a (Set a) (Set a) deriving (Show)
partition :: (a -> Bool) -> Set a -> (Set a, Set a)
partition _ Leaf = (Leaf, Leaf)
partition f (Node x l r)
| f x = (Node x l1 r1, combine l2 r2)
| otherwise = (combine l1 r1, Node x l2 r2)
where (l1, l2) = partition f l
(r1, r2) = partition f r
combine Leaf r' = r'
combine (Node x l r) r' = Node x l (combine r r')
insert :: (Ord a) => a -> Set a -> Set a
insert x Leaf = Node x Leaf Leaf
insert x (Node y l r) = case compare x y of
LT -> Node y (insert x l) r
GT -> Node y l (insert x r)
EQ -> Node y l r
fromList :: (Ord a) => [a] -> Set a
fromList = foldr insert Leaf
toList :: (Ord a) => Set a -> [a]
toList Leaf = []
toList (Node x l r) = toList l ++ x : toList r
prop_partition :: [Int] -> Bool
prop_partition lst =
let (l, r) = Main.partition even (fromList lst') in (toList l, toList r)
== Data.List.partition even (sort $ lst')
where lst' = nub lst
main = quickCheck (withMaxSuccess 10000 prop_partition)
This question already has an answer here:
Can this implementation of in-order traversal of a binary tree be improved?
(1 answer)
Closed 6 years ago.
data Tree a = Node a (Tree a) (Tree a) | Empty
toList :: (Tree a) -> [a]
toList (Node v l r ) = (toList l) ++ [v] ++ (toList r)
toList Empty = []
As we know it is not optimal because every ++ is connected with O(n) operations for concatenation of lists. The alternative solution is to use : instead of ++. But it causes error because of the fact toList Empty = []. So how to make optimal my solution?
You can't do it directly, since : only prepends a single element to a list. But in both child-branches you'll usually give multiple elements. The slow recursive implementation is needed to get around precisely this!
So, the way to go is to use a container with a more efficient concatenation operation! Such are available in libraries, e.g. sequence. But there is one container type that you can very quickly brew up yourself:
newtype DList a = DList { getDList :: [a] -> [a] }
instance Monoid (DList a) where
mempty = DList id
mappend (DList l1) (DList l2) = DList $ l1 . l2
singletonD :: a -> DList a
singletonD x = DList (x:)
With this, you can do
toDList :: Tree a -> DList a
toDList (Node v l r) = toDList l <> singletonD v <> toDList r
toDList Empty = mempty
This is an exact translation of your definition, but it won't have the same performance problem as when you concatenate ordinary lists.
Because these difference lists are so easy to implement, it's quite common in Haskell to just do it inline without further mention:
toList :: (Tree a) -> [a]
toList t = tdl t []
where tdl (Node v l r) = toList l . (v:) . tdl r
tdl Empty = id
You need to put things together differently to accomplish your goal. You can't just replace ++ with :. Try this:
toList t = toListPlus t []
toListPlus :: Tree a -> [a] -> [a]
toListPlus t xs should produce toList t ++ xs, but implemented with recursive calls to toListPlus, not using ++ or toList. Let's work through it. The base case is easy:
toListPlus Empty xs = xs
The recursive case isn't too bad either. We want to convert the left subtree to a list, sticking other stuff on after:
toListPlus (Node v l r) xs =
toListPlus l ???
What comes after? The root, and then the result of converting the right subtree, and then whatever gets tacked on:
toListPlus (Node v l r) xs =
toListPlus l (v : toListPlus r xs)
This function uses an implicit stack to keep track of the remaining work. This is probably the most efficient way to do it. If you wanted, you could use a zipper-style representation to make the stack explicit.
How does this solution relate to the one leftaroundabout described? Well, they're actually the same. We can see that by shifting the list argument over:
toListPlus Empty = \xs -> xs
toListPlus (Node v l r)
= \xs -> toListPlus l (v : toListPlus r xs)
= toListPlus l . (v :) . toListPlus r
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 new to Haskell.
I have this code (my solution to one of the exercise from Ninety-Nine Haskell Problems)
data Structure a = Single a | Multiple (a, Int) deriving (Show)
encodeM ::(Eq a)=> [a]->[Structure a]
encodeM l = map(\x -> (let size = length x
--h = head x
in if size>1 then Multiple ( head x, size) else Single (head x)
)
) $ group l
When I uncomment "-h = head x" I get: "parse error on input `='"
But
xxx l= let size = length l
h = head l
in size
works fine, why it doesn't compile when I use "let" with multiple statement inside the lambda?
I have tried to replace let by where
encodeM2 ::(Eq a)=> [a]->[Structure a]
encodeM2 l = map(\x->if si>1 then Multiple ( head x, si) else Single (head x)
where si = length x)
but it doesn't compile as well, whats wrong with it?
This is your code properly indented: (note how the let bindings align vertically)
encodeM :: Eq a => [a] -> [Structure a]
encodeM l = map (\x -> let size = length x
h = head x in
if size > 1
then Multiple (h, size)
else Single h) $
group l
This is your code readable:
encodeM :: Eq a => [a] -> [Structure a]
encodeM = map runLength . group
where
runLength x =
let size = length x
h = head x in
if size > 1
then Multiple (h, size)
else Single h
This is your code idiomatic:
encodeM :: Eq a => [a] -> [Structure a]
encodeM = map runLength . group
where
runLength [x] = Single x
runLength xs = Multiple (head xs, length xs)
I prefer to use pattern matching to if/then/else, so your code becomes:
encodeM :: (Eq a) => [a] -> [Structure a]
encodeM lst = map fun $ group lst
where
fun [x] = Single x
fun l = Multiple (head l, length l)
In Haskell whitespace matters.
Align assignemnts in your let. And you can't use where in lambda.