Learn You a Haskell demonstrates the powerset function:
The powerset of some set is a set of all subsets of that set.
powerset :: [a] -> [[a]]
powerset xs = filterM (\x -> [True, False]) xs
And running it:
ghci> powerset [1,2,3]
[[1,2,3],[1,2],[1,3],[1],[2,3],[2],[3],[]]
What's going on here? I see filterM's signature (shown below), but I don't understand how it's executing.
filterM :: Monad m => (a -> m Bool) -> [a] -> m [a]
Please walk me through this powerset function.
powerset :: [a] -> [[a]]
powerset xs = filterM (\x -> [True, False]) xs
------------- -----
filterM :: Monad m => (a -> m Bool ) -> [a] -> m [a]
-- filter :: (a -> Bool ) -> [a] -> [a] (just for comparison)
------------- -----
m Bool ~ [Bool] m ~ []
So this is filter "in" the nondeterminism (list) monad.
Normally, filter keeps only those elements in its input list for which the predicate holds.
Nondeterministically, we get all the possibilities of keeping the elements for which the nondeterministic predicate might hold, and removing those for which it might not hold. Here, it is so for any element, so we get all the possibilities of keeping, or removing, an element.
Which is a powerset.
Another example (in a different monad), building on the one in Brent Yorgey's blog post mentioned in the comments,
>> filterM (\x-> if even x then Just True else Nothing) [2,4..8]
Just [2,4,6,8]
>> filterM (\x-> if even x then Just True else Nothing) [2..8]
Nothing
>> filterM (\x-> if even x then Just True else Just False) [2..8]
Just [2,4,6,8]
Let's see how this is actually achieved, with code. We'll define
filter_M :: Monad m => (a -> m Bool) -> [a] -> m [a]
filter_M p [] = return []
filter_M p (x:xs) = p x >>= (\b ->
if b
then filter_M p xs >>= (return . (x:))
else filter_M p xs )
Writing out the list monad's definitions for return and bind (>>=) (i.e. return x = [x], xs >>= f = concatMap f xs), this becomes
filter_L :: (a -> [Bool]) -> [a] -> [[a]]
filter_L p [] = [[]]
filter_L p (x:xs) -- = (`concatMap` p x) (\b->
-- (if b then map (x:) else id) $ filter_L p xs )
-- which is semantically the same as
-- map (if b then (x:) else id) $ ...
= [ if b then x:r else r | b <- p x, r <- filter_L p xs ]
Hence,
-- powerset = filter_L (\_ -> [True, False])
-- filter_L :: (a -> [Bool] ) -> [a] -> [[a]]
powerset :: [a] -> [[a]]
powerset [] = [[]]
powerset (x:xs)
= [ if b then x:r else r | b <- (\_ -> [True, False]) x, r <- powerset xs ]
= [ if b then x:r else r | b <- [True, False], r <- powerset xs ]
= map (x:) (powerset xs) ++ powerset xs -- (1)
-- or, with different ordering of the results:
= [ if b then x:r else r | r <- powerset xs, b <- [True, False] ]
= powerset xs >>= (\r-> [True,False] >>= (\b-> [x:r|b] ++ [r|not b]))
= powerset xs >>= (\r-> [x:r,r])
= concatMap (\r-> [x:r,r]) (powerset xs) -- (2)
= concat [ [x:r,r] | r <- powerset xs ]
= [ s | r <- powerset xs, s <- [x:r,r] ]
and we have thus derived the two usual implementations of powerset function.
The flipped order of processing is made possible by the fact that the predicate is constant (const [True, False]). Otherwise the test would be evaluated over and over again for the same input value, and we probably wouldn't want that.
let me help you about this:
first: you have to understand the list monad. If you remember, we have:
do
n <- [1,2]
ch <- ['a','b']
return (n,ch)
The result will be: [(1,'a'),(1,'b'),(2,'a'),(2,'b')]
Because: xs >>= f = concat (map f xs) and return x = [x]
n=1: concat (map (\ch -> return (n,ch)) ['a', 'b'])
concat ([ [(1,'a')], [(1,'b')] ]
[(1,'a'),(1,'b')]
and so forth ...
the outermost result will be:
concat ([ [(1,'a'),(1,'b')], [(2,'a'),(2,'b')] ])
[(1,'a'),(1,'b'),(2,'a'),(2,'b')]
second: we have the implementation of filterM:
filterM _ [] = return []
filterM p (x:xs) = do
flg <- p x
ys <- filterM p xs
return (if flg then x:ys else ys)
Let do an example for you to grasp the idea easier:
filterM (\x -> [True, False]) [1,2,3]
p is the lambda function and (x:xs) is [1,2,3]
The innermost recursion of filterM: x = 3
do
flg <- [True, False]
ys <- [ [] ]
return (if flg then 3:ys else ys)
You see the similarity, like the example above we have:
flg=True: concat (map (\ys -> return (if flg then 3:ys else ys)) [ [] ])
concat ([ return 3:[] ])
concat ([ [ [3] ] ])
[ [3] ]
and so forth ...
the final result: [ [3], [] ]
Likewise:
x=2:
do
flg <- [True, False]
ys <- [ [3], [] ]
return (if flg then 2:ys else ys)
result: [ [2,3], [2], [3], [] ]
x=1:
do
flg <- [True, False]
ys <- [ [2,3], [2], [3], [] ]
return (if flg then 1:ys else ys)
result: [ [1,2,3], [1,2], [1,3], [1], [2,3], [2], [3], [] ]
theoretically: it's just chaining list monads after all:
filterM :: (a -> m Bool) -> [a] -> m [a]
(a -> [Bool]) -> [a] -> [ [a] ]
And that's all, hope you enjoy :D
The best way to understand filterM's for the list monad (as is in your example) is to consider the following alternative pseudo-code'ish definition of filterM
filterM :: Monad m => (a -> m Bool) -> [a] -> m [a]
filterM p [x1, x2, .... xn] = do
b1 <- p x1
b2 <- p x2
...
bn <- p xn
let element_flag_pairs = zip [x1,x2...xn] [b1,b2...bn]
return [ x | (x, True) <- element_flag_pairs]
With this definition of filterM you can easily see why the power-set is generated in your example.
For the sake of completeness, you might be also interested in how foldM and mapM can be defined as above
mapM :: Monad m => (a -> m b) -> [a] -> m [ b ]
mapM f [x1, x2, ... xn] = do
y1 <- f x1
y2 <- f x2
...
yn <- f xn
return [y1,y2,...yn]
foldM :: Monad m => (b -> a -> m b) -> b -> [ a ] -> m b
foldM _ a [] = return a
foldM f a [x1,x2,..xn] = do
y1 <- f a x1
y2 <- f y1 x2
y3 <- f y2 x3
...
yn <- f y_(n-1) xn
return yn
Hope this helps!
Related
filterM :: Monad m => (a -> m Bool) -> [a] -> m [a]
filterM p [] = return []
filterM p (x:xs) = do b <- p x
ys <- filterM p xs
return (if b then x:ys else ys)
and
> filterM (\x -> [True,False]) [1,2,3]
[[1,2,3],[1,2],[1,3],[1],[2,3],[2],[3],[]]
Is return (if b then x:ys else ys) evaluated each time a list is created? Is yes, why isn't the result [[1,2,3]],[[1,2]],[[1,3]],[[1]],[[2,3]],[[2]],[[3]],[[]]?
Does the result [[1,2,3],[1,2],[1,3],[1],[2,3],[2],[3],[]] imply that return (if b then x:ys else ys) is evaluated once after all the lists are created?
In short: because the bind function (>>=) for the instance Monad [] is implement with concatMap, not map.
We can desugar the do block as:
filterM :: Monad m => (a -> m Bool) -> [a] -> m [a]
filterM p [] = return []
filterM p (x:xs) = p x >>= \b -> (filterM p xs >>= \ys -> return (if b then x:ys else ys))
For m ~ [], the >>= function is equivalent to flip concatMap, and return x is equivalent to [x], so that means that we can transform this, for a list, into:
filterM :: (a -> [Bool]) -> [a] -> [[a]]
filterM p [] = [[]]
filterM p (x:xs) = concatMap (\b -> concatMap (\ys -> [if b then (x:ys) else ys]) (filterM p xs)) (p x)
A concatMap (\x -> [f x]) is equivalent to map f, since the concatenation of all these singleton lists will result in a list that contains the outcomes of f for all elements in the given list.
It thus means that the above function is equivalent to:
filterM :: (a -> [Bool]) -> [a] -> [[a]]
filterM p [] = [[]]
filterM p (x:xs) = concatMap (\b -> map (\ys -> if b then (x:ys) else ys) (filterM p xs)) (p x)
If p is \_ -> [True, False], it thus means we can replace (p x) with [True, False], and thus obtain:
concatMap (\b -> map (\ys -> if b then (x:ys) else ys) (filterM p xs)) [True, False]
This thus means that concatMap is the concatenation of two lists: one where b is True, and one where b is False, like:
map (\ys -> (x:ys)) (filterM p xs) ++ map (\ys -> ys) (filterM p xs)
The first map will thus prepend all the lists from filterM p xs with x whereas the second one will not. The above expression is thus equivalent to:
map (x:) (filterM p xs) ++ filterM p xs
if filterM p xs contains the powerset of xs, then the above expression will thus contain the powerset of (x:xs).
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
how do we get calculate inversions in a list in Haskell?
eg. [1, 2, 3, 1] , xi > xj where i < j is the condition for inversion. In the given example it would be 3.
I tried the following code:
module Inversion where
inv :: Ord a => [a] -> [(a, a)]
inv [] = []
inv xs = [(a, b) | a <- xs, b <- tail xs, a > b]
I even tried to zip it with tail and then get the pairs.
import Data.List
inv :: Ord a => [a] -> [(a, a)]
inv xs = [(a,b) | (a:bs) <- tails xs, b <- bs, a > b]
This is a naive implementation close to what you already got:
inv :: Ord a => [a] -> [(a, a)]
inv [] = []
inv xs = [(a, b) | b <- xs', a > b] ++ inv xs'
where xs' = tail xs
a = head xs
It does the first thing that comes to mind: compare the first element with every other element in the list and then do the same with the rest of the list.
Your example:
*Main> inv [1,2,3,1]
[(2,1),(3,1)]
This seems to work for me:
inv lst = filter nonOrdPair $ zip lst (tail lst)
where nonOrdPair (a,b) = a > b
on your example gives
Prelude> inv [1, 2, 3, 1]
[(3,1)]
if you only need the first element you can get it with map fst.
You can't use zip and tail in this case. This would lead to only comparing consecutive pairs where you need all pairs. So given a list (x:xs), you need to check whether any of the xs is smaller than x:
import Data.Maybe (mapMaybe)
checkInv :: Ord a => a -> a -> Maybe (a,a)
checkInv x y = if x <= y then Nothing
else Just (x, y)
inv :: Ord a => [a] -> [(a,a)]
inv [] = []
inv (x:xs) = mapMaybe (checkInv x) xs ++ inv xs
> inv [1,2,3,1]
[(2,1), (3,1)]
Just to throw some folds into the matter:
inv :: Ord a => [a] -> [(a,a)]
inv [x] = [] :: [(x,x)]
inv xs = foldl (\acc x -> if (head xs) > x then (head xs, x) : acc else acc) [] xs
Zipping and then filtering the pairs is not a bad idea, but you have to consider all the pairs for that to work:
inv xs = filter (\(a, b) -> a > b) $ allPairs xs
where
allPairs xs = allPairsHelp xs (tail xs)
where
allPairsHelp xs [] = []
allPairsHelp xs ys = zip xs ys ++ allPairsHelp xs (tail ys)
Given two lists, I can produce a list of all permutations the Cartesian Product of these two lists:
permute :: [a] -> [a] -> [[a]]
permute xs ys = [ [x, y] | x <- xs, y <- ys ]
Example> permute [1,2] [3,4] == [ [1,3], [1,4], [2,3], [2,4] ]
How do I extend permute so that instead of taking two lists, it takes a list (length n) of lists and returns a list of lists (length n)
permute :: [[a]] -> [[a]]
Example> permute [ [1,2], [3,4], [5,6] ]
== [ [1,3,5], [1,3,6], [1,4,5], [1,4,6] ] --etc
I couldn't find anything relevant on Hoogle.. the only function matching the signature was transpose, which doesn't produce the desired output.
Edit: I think the 2-list version of this is essentially the Cartesian Product, but I can't wrap my head around implementing the n-ary Cartesian Product. Any pointers?
Prelude> sequence [[1,2],[3,4],[5,6]]
[[1,3,5],[1,3,6],[1,4,5],[1,4,6],[2,3,5],[2,3,6],[2,4,5],[2,4,6]]
I found Eric Lippert's article on computing Cartesian product with LINQ quite helpful in improving my understanding of what was going on. Here's a more-or-less direct translation:
cartesianProduct :: [[a]] -> [[a]]
cartesianProduct sequences = foldr aggregator [[]] sequences
where aggregator sequence accumulator =
[ item:accseq |item <- sequence, accseq <- accumulator ]
Or with more "Haskell-y" terse, meaningless parameter names ;)
cartesianProduct = foldr f [[]]
where f l a = [ x:xs | x <- l, xs <- a ]
This winds up being quite similar to sclv posted after all.
Here is my way of implementing it simply, using only list comprehensions.
crossProduct :: [[a]] -> [[a]]
crossProduct (axis:[]) = [ [v] | v <- axis ]
crossProduct (axis:rest) = [ v:r | v <- axis, r <- crossProduct rest ]
As a supplement to jleedev's answer (couldn't format this in the comments):
A quick unchecked substitution of list functions for monadic ones:
sequence ms = foldr k (return []) ms
where
k m m' = do { x <- m; xs <- m'; return (x:xs) }
....
k m m' = m >>= \x -> m' >>= \xs -> [x:xs]
k m m' = flip concatMap m $ \x -> flip concatMap m' $ \xs -> [x:xs]
k m m' = concatMap (\x -> concatMap (\xs -> [x:xs]) m') m
....
sequence ms = foldr k ([[]]) ms
where
k m m' = concatMap (\x -> concatMap (\xs -> [x:xs]) m') m
If you want to have more control over the output, you can use a list as applicative functor, e.g.:
(\x y z -> [x,y,z]) <$> [1,2] <*> [4,5] <*> [6,7]
Let's say you want a list of tuples instead:
(\x y z -> (x,y,z)) <$> [1,2] <*> [4,5] <*> [6,7]
And it looks kind of cool, too...
You can do this in 2 ways:
Using list comprehension
cp :: [[a]] -> [[a]]
cp [] = [[]]
cp (xs:xss) = [ x:ys | x <- xs, ys <- cp xss ]
Using a fold
cp1 :: [[a]] -> [[a]]
cp1 xs = foldr f [[]] xs
where f xs xss = [x:ys | x <- xs, ys <- xss]
A couple of times I've found myself wanting a zip in Haskell that adds padding to the shorter list instead of truncating the longer one. This is easy enough to write. (Monoid works for me here, but you could also just pass in the elements that you want to use for padding.)
zipPad :: (Monoid a, Monoid b) => [a] -> [b] -> [(a, b)]
zipPad xs [] = zip xs (repeat mempty)
zipPad [] ys = zip (repeat mempty) ys
zipPad (x:xs) (y:ys) = (x, y) : zipPad xs ys
This approach gets ugly when trying to define zipPad3. I typed up the following and then realized that of course it doesn't work:
zipPad3 :: (Monoid a, Monoid b, Monoid c) => [a] -> [b] -> [c] -> [(a, b, c)]
zipPad3 xs [] [] = zip3 xs (repeat mempty) (repeat mempty)
zipPad3 [] ys [] = zip3 (repeat mempty) ys (repeat mempty)
zipPad3 [] [] zs = zip3 (repeat mempty) (repeat mempty) zs
zipPad3 xs ys [] = zip3 xs ys (repeat mempty)
zipPad3 xs [] zs = zip3 xs (repeat mempty) zs
zipPad3 [] ys zs = zip3 (repeat mempty) ys zs
zipPad3 (x:xs) (y:ys) (z:zs) = (x, y, z) : zipPad3 xs ys zs
At this point I cheated and just used length to pick the longest list and pad the others.
Am I overlooking a more elegant way to do this, or is something like zipPad3 already defined somewhere?
How about custom head and tail functions (named next and rest in my example below)?
import Data.Monoid
zipPad :: (Monoid a, Monoid b) => [a] -> [b] -> [(a,b)]
zipPad [] [] = []
zipPad xs ys = (next xs, next ys) : zipPad (rest xs) (rest ys)
zipPad3 :: (Monoid a, Monoid b, Monoid c) => [a] -> [b] -> [c] -> [(a,b,c)]
zipPad3 [] [] [] = []
zipPad3 xs ys zs = (next xs, next ys, next zs) : zipPad3 (rest xs) (rest ys) (rest zs)
next :: (Monoid a) => [a] -> a
next [] = mempty
next xs = head xs
rest :: (Monoid a) => [a] -> [a]
rest [] = []
rest xs = tail xs
Test snippet:
instance Monoid Int where
mempty = 0
mappend = (+)
main = do
print $ zipPad [1,2,3,4 :: Int] [1,2 :: Int]
print $ zipPad3 [1,2,3,4 :: Int] [9 :: Int] [1,2 :: Int]
Its output:
[(1,1),(2,2),(3,0),(4,0)]
[(1,9,1),(2,0,2),(3,0,0),(4,0,0)]
This pattern comes up quite a lot. A solution I learned from Paul Chiusano is as follows:
data These a b = This a | That b | These a b
class Align f where
align :: (These a b -> c) -> f a -> f b -> f c
instance Align [] where
align f [] [] = []
align f (x:xs) [] = f (This x) : align f xs []
align f [] (y:ys) = f (That y) : align f [] ys
align f (x:xs) (y:ys) = f (These x y) : align f xs ys
liftAlign2 f a b = align t
where t (This l) = f l b
t (That r) = f a r
t (These l r) = f l r
zipPad a b = liftAlign2 (,) a b
liftAlign3 f a b c xs ys = align t (zipPad a b xs ys)
where t (This (x,y)) = f x y c
t (That r) = f a b r
t (These (x,y) r) = f x y r
zipPad3 a b c = liftAlign3 (,,) a b c
A little test in ghci:
*Main> zipPad3 ["foo", "bar", "baz"] [2, 4, 6, 8] [True, False] "" 0 False
[("foo",2,True),("bar",4,False),("baz",6,False),("",8,False)]
A simpler way to do this is with Maybe. I will illustrate with Edward's
more general formulation:
import Data.Maybe
import Control.Applicative
zipWithTails l r f as bs = catMaybes . takeWhile isJust $
zipWith fMaybe (extend as) (extend bs)
where
extend xs = map Just xs ++ repeat Nothing
fMaybe a b = liftA2 f a b <|> fmap l a <|> fmap r b
There are times when you want to be able to apply a different function to either tail rather than just supply mempty or manual zeroes as well:
zipWithTail :: (a -> a -> a) -> [a] -> [a] -> [a]
zipWithTail f (a:as) (b:bs) = f a b : zipWithTails f as bs
zipWithTail f [] bs = bs
zipWithTail f as _ = as
zipWithTails :: (a -> c) -> (b -> c) -> (a -> b -> c) -> [a] -> [b] -> [c]
zipWithTails l r f (a:as) (b:bs) = f a b : zipWithTails l r f as bs
zipWithTails _ r _ [] bs = fmap r bs
zipWithTails l _ _ as _ = fmap l as
I use the former when I'm doing something like zipWithTail (+)
and the former when I need to do something like zipWithTail (*b) (a*) (\da db -> a*db+b*da) since the former can be much more efficient than feeding a default into a function, and the latter a little bit so.
However, if you just wanted to make a more succinct version of what you have, you could probably turn to mapAccumL ,but its not any clearer, and the ++ can be expensive.
zipPad as bs = done $ mapAccumL go as bs
where go (a:as) b = (as,(a,b))
go [] b = ([],(mempty,b))
done (cs, both) = both ++ fmap (\x -> (x, mempty)) cs