So I am working on a function that detects if two binary trees have the same numbers in them.
So what I've come up with is the following which works just fine but the problem is that I am using total of 5 functions. Is there another way of detecting if two BT's have the same elements with just one function ? Here is my solution so far which seems to work just fine.
flatten :: BinTree a -> [a]
flatten Empty = []
flatten (Node l x r) = flatten l ++ [x] ++ flatten r
splt :: Int -> [a] -> ([a], [a])
splt 0 xs = ([], xs)
splt _ [] = ([],[])
splt n (x:xs) = (\ys-> (x:fst ys, snd ys)) (splt (n-1) xs)
merge :: Ord a => [a] -> [a] -> [a]
merge xs [] = xs
merge [] ys = ys
merge (x:xs) (y:ys) = if (x > y) then y:merge (x:xs) ys else x:merge xs(y:ys)
msort :: Ord a => [a] -> [a]
msort [] =[]
msort (x:[]) = (x:[])
msort xs = (\y -> merge (msort (fst y)) (msort (snd y))) (splt (length xs `div` 2) xs)
areTreesEqual :: (Ord a) => BinTree a -> BinTree a-> Bool
areTreesEqual Empty Empty = True
areTreesEqual Empty a = False
areTreesEqual a Empty = False
areTreesEqual a b = msort (flatten (a) ) == msort (flatten (b))
How about
import Data.MultiSet as Set
equal a b = accum a == accum b
where accum Empty = Set.empty
accum (Node l x r) = Set.insert x (accum l `Set.union` accum r)
Sets are lovely for unordered comparison and multisets will make sure that
1 /= 1
1 1
Eg, that duplicate numbers are counted properly. If this isn't a big concern, than swap MultiSet for Set. I think 3 lines is pretty decent for this sort of thing.
Related
I have the following code, that drops every nth element in a list.
dropEvery :: [a] -> Int -> [a]
dropEvery xs n = f xs n ++ dropEvery (drop n xs) n
where
f ys 0 = []
f ys 1 = []
f [] m = []
f (y:ys) n = y : (f ys (n-1))
I would like to make it a bit shorter and was wondering if there is a way to use "<=" in pattern matching. I tried doing this using a where clause, which did not work, why?
f ys m = []
where
m <= 1 || ys == []
How can I shirk this redundancy? Is there a nice way to use "less or equal" in pattern matching?
EDIT: I tried this using guards
where
f ys m
| m <= 1 || null ys = []
| otherwise = (head ys) : (f (tail ys) (n-1))
You can work with a guard:
dropEvery :: [a] -> Int -> [a]
dropEvery xs n = f xs n ++ dropEvery (drop n xs) n
where
f ys i | i <= 1 = []
f [] _ = []
f (y:ys) n = y : (f ys (n-1))
If the condition in the guard is satisfied, then that clause "fires" and thus in this case will return an empty list [].
You will however get stuck in an infinite loop, since you write f xs n ++ dropEvery (n xs) n but drop 3 [] will return [], and thus it will keep calling dropEvery with an empty list.
You can make use of recursion where we each time decrement n until it reaches 0, and then we make two hops, so:
dropEvery :: Int -> [a] -> [a]
dropEvery n = go (n-1)
where go _ [] = []
go i (x:xs)
| i <= 0 = go (n-1) xs
| otherwise = x : go (i-1) xs
We can also work with splitAt :: [a] -> ([a], [a]) and with a pattern guard:
dropEvery n [] = []
dropEvery n ds
| (_:ys) <- sb = sa ++ dropEvery n ys
| otherwise = sa
where (sa, sb) = splitAt (n-1) ds
So I'm trying to write a function that, given two lists of integers, adds the ith even number of each list and returns them in another list. In case one of the list doesn't have an ith even number, a 0 is considered. For example, if the lists are [1,2,1,4,6] and [2,2], it returns [4,6,6] ([2+2,4+2,6+0]). I have the following code:
addEven :: [Int] -> [Int] -> [Int]
addEeven [] [] = []
addEeven (x:xs) [] = filter (\g -> g `mod`2 == 0) (x:xs)
addEven [] (y:ys) = filter (\g -> g `mod` 2 == 0) (y:ys)
addEven (x:xs) (y:ys) = (a + b):(addEven as bs)
where
(a:as) = filter (\g -> g `mod` 2 == 0) (x:xs)
(b:bs) = filter (\g -> g `mod` 2 == 0) (y:ys)
When I run that with the previous example, I get:
[4,6*** Exception: ex.hs:(4,1)-(8,101): Non-exhaustive patterns in function addEven
I really can't see what I'm missing, since it doesn't work with any input I throw at it.
A filter might eliminate elements, hence filter (\g -> gmod2 == 0) is not said to return any elements, and thus the patterns (a:as) and (b:bs) might fail.
That being said, I think you make the problem too complex here. You can first define a helper function that adds two elements of a list:
addList :: Num a => [a] -> [a] -> [a]
addList (x:xs) (y:ys) = (x+y) : addList xs ys
addList xs [] = xs
addList [] ys = ys
Then we do the filter on the two parameters, and make a function addEven that looks like:
addEven :: Integral a => [a] -> [a] -> [a]
addEven xs ys = addList (filter even xs) (filter even ys)
or with on :: (b -> b -> c) -> (a -> b) -> a -> a -> c:
import Data.Function(on)
addEven :: Integral a => [a] -> [a] -> [a]
addEven = addList `on` filter even
While using filter is very instinctive in this case, perhaps using filter twice and then summing up the results might be slightly ineffficient for large lists. Why don't we do the job all at once for a change..?
addMatches :: [Int] -> [Int] -> [Int]
addMatches [] [] = []
addMatches [] ys = filter even ys
addMatches xs [] = filter even xs
addMatches xs ys = first [] xs ys
where
first :: [Int] -> [Int] -> [Int] -> [Int]
first rs [] ys = rs ++ filter even ys
first rs (x:xs) ys = rs ++ if even x then second [x] xs ys
else first [] xs ys
second :: [Int] -> [Int] -> [Int] -> [Int]
second [r] xs [] = [r] ++ filter even xs
second [r] xs (y:ys) = if even y then first [r+y] xs ys
else second [r] xs ys
λ> addMatches [1,2,1,4,6] [2,2]
[4,6,6]
I'm trying to write a Haskell function that would take three lists and return a list of sums of their elements.
Currently I'm trying to do it using zipWith3:
sum3 :: Num a => [a] -> [a] -> [a] -> [a]
sum3 xs ys zs = zipWith3 (\x y z -> x+y+z) xs ys zs
The problem is it only works for lists of equal lengths. But I wish sum3 to work with lists of unequal lengths, so that
sum3 [1,2,3] [4,5] [6]
would return
[11,7,3]
I think that I should redefine zipWith3 to work with lists of unequal lengths, but can't figure out how to do it (I suspect that I have to exhaust all possibilities of empty lists).
Is there a solution?
a nice trick is to use transpose:
import Data.List (transpose)
sum3 :: Num a => [a] -> [a] -> [a] -> [a]
sum3 as bs cs = map sum $ transpose [as,bs,cs]
because obviously you want to sum up the columns ;)
> sum3 [1,2,3] [4,5] [6]
[11,7,3]
I've seen this sort of question before, here: Zip with default value instead of dropping values? My answer to that question also pertains here.
The ZipList applicative
Lists with a designated padding element are applicative (the applicative grown from the 1 and max monoid structure on positive numbers).
data Padme m = (:-) {padded :: [m], padder :: m} deriving (Show, Eq)
instance Applicative Padme where
pure = ([] :-)
(fs :- f) <*> (ss :- s) = zapp fs ss :- f s where
zapp [] ss = map f ss
zapp fs [] = map ($ s) fs
zapp (f : fs) (s : ss) = f s : zapp fs ss
-- and for those of you who don't have DefaultSuperclassInstances
instance Functor Padme where fmap = (<*>) . pure
Now we can pack up lists of numbers with their appropriate padding
pad0 :: [Int] -> Padme Int
pad0 = (:- 0)
And that gives
padded ((\x y z -> x+y+z) <$> pad0 [1,2,3] <*> pad0 [4,5] <*> pad0 [6])
= [11,7,3]
Or, with the Idiom Brackets that aren't available, you vould write
padded (|pad0 [1,2,3] + (|pad0 [4,5] + pad0 6|)|)
meaning the same.
Applicative gives you a good way to bottle the essential idea of "padding" that this problem demands.
Well if you must use zipWith3:
sum3 :: Num a => [a] -> [a] -> [a] -> [a]
sum3 xs ys zs = zipWith3 (\x y z -> x + y + z) xs' ys' zs'
where
xs' = pad nx xs; nx = length xs
ys' = pad ny ys; ny = length ys
zs' = pad nz zs; nz = length zs
n = nx `max` ny `max` nz
pad n' = (++ replicate (n-n') 0)
Some samples:
*> sum3 [] [] []
[]
*> sum3 [0] [] []
[0]
*> sum3 [1] [1] [2, 2]
[4,2]
*> sum3 [1,2,3] [4,5] [6]
[11,7,3]
but I'd recommend going with Carsten's transpose based implementation.
Perhaps you could get away with something that is almost zipWith3 but which relies on Default to generate empty values on the fly if one of the lists runs out of elements:
import Data.Default
zipWith3' :: (Default a, Default b, Default c)
=> ( a -> b -> c -> r )
-> ([a] -> [b] -> [c] -> [r])
zipWith3' f = go where
go [] [] [] = []
go (x:xs) (y:ys) (z:zs) = f x y z : go xs ys zs
go [] ys zs = go [def] ys zs
go xs [] zs = go xs [def] zs
go xs ys [] = go xs ys [def]
and 'sum3'`:
sum3' :: (Default a, Num a) => [a] -> [a] -> [a] -> [a]
sum3' = zipWith3' (\x y z -> x + y + z)
One could generalize zipWith so to handle the excess tails, instead of discarding them silently.
zipWithK :: (a->b->c) -> ([a]->[c]) -> ([b]->[c]) -> [a] -> [b] -> [c]
zipWithK fab fa fb = go
where go [] [] = []
go as [] = fa as
go [] bs = fb bs
go (a:as) (b:bs) = fab a b : go as bs
The original zipWith is then
zipWith' :: (a->b->c) -> [a] -> [b] -> [c]
zipWith' f = zipWithK f (const []) (const [])
Back to the original problem,
sum2 :: Num a => [a] -> [a] -> [a]
sum2 = zipWithK (+) id id
sum3 :: Num a => [a] -> [a] -> [a] -> [a]
sum3 xs ys zs = xs `sum2` ys `sum2` zs
This is my solution:
sumLists :: Num a => [a] -> [a] -> [a]
sumLists (x : xs) (y : ys) = (x + y) : sumLists xs ys
sumLists _ _ = []
sum3 :: (Num a, Enum a) => [a] -> [a] -> [a] -> [a]
sum3 xs ys zs = foldr sumLists defaultList (map addElems list)
where list = [xs, ys, zs]
defaultList = [] ++ [0, 0 ..]
maxLength = maximum $ map length list
addElems = \x -> if length x < maxLength then x ++ [0, 0 ..] else x
here's my question:
How to extract the same elements from two equal length lists to another list?
For example: given two lists [2,4,6,3,2,1,3,5] and [7,3,3,2,8,8,9,1] the answer should be [1,2,3,3]. Note that the order is immaterial. I'm actually using the length of the return list.
I tried this:
sameElem as bs = length (nub (intersect as bs))
but the problem is nub removes all the duplications. The result of using my function to the former example is 3 the length of [1,3,2] instead of 4 the length of [1,3,3,2]. Is there a solution? Thank you.
Since the position seems to be irrelevant, you can simply sort the lists beforehand and then traverse both lists:
import Data.List (sort)
intersectSorted :: Ord a => [a] -> [a] -> [a]
intersectSorted (x:xs) (y:ys)
| x == y = x : intersectSorted xs ys
| x < y = intersectSorted xs (y:ys)
| x > y = intersectSorted (x:xs) ys
intersectSorted _ _ = []
intersect :: Ord a => [a] -> [a] -> [a]
intersect xs ys = intersectSorted (sort xs) (sort ys)
Note that it's also possible to achieve this with a Map:
import Data.Map.Strict (fromListWith, assocs, intersectionWith, Map)
type Counter a = Map a Int
toCounter :: Ord a => [a] -> Counter a
toCounter = fromListWith (+) . flip zip (repeat 1)
intersectCounter :: Ord a => Counter a -> Counter a -> Counter a
intersectCounter = intersectionWith min
toList :: Counter a -> [a]
toList = concatMap (\(k,c) -> replicate c k) . assocs
intersect :: Ord a => [a] -> [a] -> [a]
intersect xs ys = toList $ intersectCounter (toCounter xs) (toCounter ys)
You could write a function for this. There is probably a more elegant version of this involving lambda's or folds, but this does work for your example:
import Data.List
same (x:xs) ys = if x `elem` ys
then x:same xs (delete x ys)
else same xs ys
same [] _ = []
same _ [] = []
The delete x ys in the then-clause is important, without that delete command items from the first list that occur at least once will be counted every time they're encountered.
Note that the output is not sorted, since you were only interested in the length of the resulting list.
import Data.List (delete)
mutuals :: Eq a => [a] -> [a] -> [a]
mutuals [] _ = []
mutuals (x : xs) ys | x `elem` ys = x : mutuals xs (delete x ys)
| otherwise = mutuals xs ys
gives
mutuals [2,4,6,3,2,1,3,5] [7,3,3,2,8,8,9,1] == [2,3,1,3]
I have the following function which takes a list and returns two sublists split at a given element n. However, I only need to split it in half, with odd length lists having a larger first sublist
splitlist :: [a] -> Int -> ([a],[a])
splitlist [] = ([],[])
splitlist l#(x : xs) n | n > 0 = (x : ys, zs)
| otherwise = (l, [])
where (ys,zs) = splitlist xs (n - 1)
I know I need to change the signature to [a] -> ([a],[a]), but where in the code should I put something like length(xs) so that I don't break recursion?
In a real program you should probably use
splitlist :: [a] -> ([a], [a])
splitlist xs = splitAt ((length xs + 1) `div` 2) xs
(i.e. something along the lines of dreamcrash's answer.)
But if, for learning purposes, you're looking for an explicitly recursive solution, study this:
splitlist :: [a] -> ([a], [a])
splitlist xs = f xs xs where
f (y : ys) (_ : _ : zs) =
let (as, bs) = f ys zs
in (y : as, bs)
f (y : ys) (_ : []) = (y : [], ys)
f ys [] = ([], ys)
You can do it using take and drop:
splitlist :: [a] -> ([a],[a])
splitlist [] = ([],[])
splitlist l = let half = (length(l) +1)`div` 2
in (take half l, drop half l)
or you can take advantage of the function splitAt:
splitlist list = splitAt ((length (list) + 1) `div` 2) list
You can do this by using the take and drop built-in functions. But if you want something that can be done with all self written functions try this:
dropList :: Int -> [Int] -> [Int]
dropList 0 [] = []
dropList 0 (x:xs) = x:xs
dropList y [] = []
dropList y (x:xs) = dropList (y-1) xs
takeList :: Int -> [Int] -> [Int]
takeList 0 [] = []
takeList 0 (x:xs) = []
takeList y [] = []
takeList y (x:xs)
| y <= length (x:xs) = x : takeList (y-1) xs
| otherwise = []
split :: Int -> [Int] -> ([Int],[Int])
split 0 [] = ([],[])
split y [] = ([],[])
split y (x:xs) = (takeList y (x:xs), dropList y (x:xs))
main = do
print (split 4 [1,2,3,4,5,6])