Calculate n-ary Cartesian Product - haskell

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]

Related

How to convert my own Data constructor to List in Haskell

I have just started trying Haskell after using Python, and I'm facing a lot of problems understanding it
for example after I tried to make a new type called ListBag and writing a simple function to convert list to ListBag I can't go back and do anything with that data:
data ListBag a = LB [(a,Int)] deriving (Show,Eq)
fromList :: (Ord a) => [a] ->ListBag a
fromList xs = LB [ y| y<- ys]
where ys = toList(fromListWith (+) [(x, 1) | x <- xs])
a :: [Integer]
a=[1,1,1,1,1,1,2,2,2,3,3,3,3,4,5,5]
b = fromList a
Now b is:
LB [(1,6),(2,3),(3,4),(4,1),(5,2)]
and because b is b :: ListBag Integer it can't be mapped or ...
So how can I convert it to List again?
Firstly, your ListBag doesn't save order in which elements was in initial list, but... you can convert ListBag a to [a] like so:
toList :: ListBag a -> [a]
toList (LB ys) = concat $ (\(y, n) -> replicate n y) <$> ys
And you can redefine your fromList as
fromList xs = LB $ toList $ fromListWith (+) [ (x, 1) | x <- xs]
Because [ y | y <- ys] ~ ys and x where x = y ~ y
#SergeyKuz1001's answer is excellent. When you're ready to take it up a notch, you can use List's Monad instance, and a few combinators to make toList very concise.
toList :: ListBag a -> [a]
toList (LB ys) = ys >>= uncurry (flip replicate)
Ahh, monads
toList :: ListBag a -> [a]
toList (LB l) = do
(what, howmany) <- l
replicate howmany what
Or if you like list comprehensions:
toList (LB l) =
[x | (what, howmany) <- l, x <- replicate howmany what]
The trick is to make use of the fact that a monadic bind on lists can put arbitrary number of things in place of each element. So for every pair (what, howmany) we output howmany number of whats.
This isn't much different from the SergeyKuz1001's solution, just a different style. Due to optimizations I believe the performance ist rather the same in all versions.

Haskell - How can I make this lists into tuple function pair with all elements?

So i have
pair:: [a] -> [b] -> [(a,b)]
pair[] _ = []
pair(x:xs) (y:ys) = (x, y) : prod xs ys
But the result are only like the following:
>> pair [1,2] [3,4]
>> [(1,3),(2,4)]
How can I make this so it pairs like:
[(1,3),(1,4),(2,3),(2,4)]
You can use the list applicative (or monad) instance:
λ> liftA2 (,) [1,2] [3,4]
[(1,3),(1,4),(2,3),(2,4)]
Or, equivalently,
f = do
x <- [1,2]
y <- [3,4]
return (x,y)
You can also use a list comprehension:
[ (x,y) | x <- [1,3], y <- [2,4] ]
Although there is already a much more elegant answer, i think it is worthwhile to show how this would be achieved in a simple straightforward way. If you want to get all pairs, you obviously need to visit every element of one list for an element in the other.
pair :: [a] -> [b] -> [(a, b)]
pair [] _ = []
pair (x:xs) ys = pair' x ys ++ pair xs ys where
pair' :: a -> [b] -> [(a, b)]
pair' _ [] = []
pair' x (y:ys) = (x,y) : pair' x ys
But of course using the pair = liftA2 (,) or [1,3] >>= \x -> [2,4] >>= \y -> (x,y) in its do notation or list comprehension notation is much better. Also ++ isn't what you normally want to do. So maybe you can build the lists as pair' would do, keep them in a list and then concat them.
concat $ map (\x -> map (\y -> (x,y)) ys) xs

Powerset Function 1-Liner

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!

Concatenation of lists in Haskell

I want a function that takes two lists of any type and returns one (i.e. f:: [[a]] -> [[a]] -> [[a]]). Basically, too produce the 'concatenation' of the two input lists.
e.g.
> f [[1,2,3], [123]] [[4,5,6], [3,7]]
[[1,2,3,4,5,6], [1,2,3,3,7], [123,4,5,6], [123,3,7]]
I currently have got this far with it:
f _ [] = []
f [] _ = []
f (xs:xss) (ys:yss) = ((xs ++ ys) : [m | m <- f [xs] yss])
But this doesn't take into account xss and is wrong. Any suggestions?
It's a Cartesian product, so you can simply use one list comprehension to do everything.
Prelude> let xs = [[1,2,3], [123]]
Prelude> let ys = [[4,5,6], [3,7]]
Prelude> [x ++ y | x <- xs, y <- ys]
[[1,2,3,4,5,6],[1,2,3,3,7],[123,4,5,6],[123,3,7]]
import Control.Applicative
(++) <$> [[1,2,3], [123]] <*> [[4,5,6], [3,7]]
[[1,2,3,4,5,6],[1,2,3,3,7],[123,4,5,6],[123,3,7]]
f l1 l2 = [x ++ y | x <- l1, y <- l2]
In Alternative:
import Control.Applicative
f :: (Applicative f, Alternative g) => f (g a) -> f (g a) -> f (g a)
f = liftA2 (<|>)
f a b = map concat . sequence $ [a,b]
Scales up for combining any number of lists.

Recursively sort non-contiguous list to list of contiguous lists

I've been trying to learn a bit of functional programming (with Haskell & Erlang) lately and I'm always amazed at the succinct solutions people can come up with when they can think recursively and know the tools.
I want a function to convert a list of sorted, unique, non-contiguous integers into a list of contiguous lists, i.e:
[1,2,3,6,7,8,10,11]
to:
[[1,2,3], [6,7,8], [10,11]
This was the best I could come up with in Haskell (two functions)::
make_ranges :: [[Int]] -> [Int] -> [[Int]]
make_ranges ranges [] = ranges
make_ranges [] (x:xs)
| null xs = [[x]]
| otherwise = make_ranges [[x]] xs
make_ranges ranges (x:xs)
| (last (last ranges)) + 1 == x =
make_ranges ((init ranges) ++ [(last ranges ++ [x])]) xs
| otherwise = make_ranges (ranges ++ [[x]]) xs
rangify :: [Int] -> [[Int]]
rangify lst = make_ranges [] lst
It might be a bit subjective but I'd be interested to see a better, more elegant, solution to this in either Erlang or Haskell (other functional languages too but I might not understand it.) Otherwise, points for just fixing my crappy beginner's Haskell style!
Most straightforward way in my mind is a foldr:
ranges = foldr step []
where step x [] = [[x]]
step x acc#((y:ys):zs) | y == x + 1 = (x:y:ys):zs
| otherwise = [x]:acc
Or, more concisely:
ranges = foldr step []
where step x ((y:ys):zs) | y == x + 1 = (x:y:ys):zs
step x acc = [x]:acc
But wait, there's more!
abstractRanges f = foldr step []
where step x ((y:ys):zs) | f x y = (x:y:ys):zs
step x acc = [x]:acc
ranges = abstractRanges (\x y -> y == x + 1)
powerRanges = abstractRanges (\x y -> y == x*x) -- mighty morphin
By turning the guard function into a parameter, you can group more interesting things than just +1 sequences.
*Main> powerRanges [1,1,1,2,4,16,3,9,81,5,25]
[[1,1,1],[2,4,16],[3,9,81],[5,25]]
The utility of this particular function is questionable...but fun!
I can't believe I got the shortest solution. I know this is no code golf, but I think it is still quite readable:
import GHC.Exts
range xs = map (map fst) $ groupWith snd $ zipWith (\a b -> (a, a-b)) xs [0..]
or pointfree
range = map (map snd) . groupWith fst . zipWith (\a b -> (b-a, b)) [0..]
BTW, groupWith snd can be replaced with groupBy (\a b -> snd a == snd b) if you prefer Data.List over GHC.Exts
[Edit]
BTW: Is there a nicer way to get rid of the lambda (\a b -> (b-a, b)) than (curry $ (,) <$> ((-) <$> snd <*> fst) <*> snd) ?
[Edit 2]
Yeah, I forgot (,) is a functor. So here is the obfuscated version:
range = map (map fst) . groupWith snd . (flip $ zipWith $ curry $ fmap <$> (-).fst <*> id) [0..]
Suggestions are welcome...
import Data.List (groupBy)
ranges xs = (map.map) snd
. groupBy (const fst)
. zip (True : zipWith ((==) . succ) xs (tail xs))
$ xs
As to how to come up with such a thing: I started with the zipWith f xs (tail xs), which is a common idiom when you want to do something on consecutive elements of a list. Likewise is zipping up a list with information about the list, and then acting (groupBy) upon it. The rest is plumbing.
Then, of course, you can feed it through #pl and get:
import Data.List (groupBy)
import Control.Monad (ap)
import Control.Monad.Instances()
ranges = (((map.map) snd)
. groupBy (const fst))
.) =<< zip
. (True:)
. ((zipWith ((==) . succ)) `ap` tail)
, which, by my authoritative definition, is evil due to Mondad ((->) a). Twice, even. The data flow is meandering too much to lay it out in any sensible way. zipaptail is an Aztec god, and Aztec gods aren't to be messed with.
Another version in Erlang:
part(List) -> part(List,[]).
part([H1,H2|T],Acc) when H1 =:= H2 - 1 ->
part([H2|T],[H1|Acc]);
part([H1|T],Acc) ->
[lists:reverse([H1|Acc]) | part(T,[])];
part([],Acc) -> Acc.
k z = map (fst <$>) . groupBy (const snd) .
zip z . (False:) . (zipWith ((==) . succ) <*> tail) $ z
Try reusing standard functions.
import Data.List (groupBy)
rangeify :: (Num a) => [a] -> [[a]]
rangeify l = map (map fst) $ groupBy (const snd) $ zip l contigPoints
where contigPoints = False : zipWith (==) (map (+1) l) (drop 1 l)
Or, following (mixed) advice to use unfoldr, stop abusing groupBy, and be happy using partial functions when it doesn't matter:
import Control.Arrow ((***))
import Data.List (unfoldr)
spanContig :: (Num a) => [a] -> [[a]]
spanContig l =
map fst *** map fst $ span (\(a, b) -> a == b + 1) $ zip l (head l - 1 : l)
rangeify :: (Num a) => [a] -> [[a]]
rangeify = unfoldr $ \l -> if null l then Nothing else Just $ spanContig l
Erlang using foldr:
ranges(List) ->
lists:foldr(fun (X, [[Y | Ys], Acc]) when Y == X + 1 ->
[[X, Y | Ys], Acc];
(X, Acc) ->
[[X] | Acc]
end, [], List).
This is my v0.1 and I can probably make it better:
makeCont :: [Int] -> [[Int]]
makeCont [] = []
makeCont [a] = [[a]]
makeCont (a:b:xs) = if b - a == 1
then (a : head next) : tail next
else [a] : next
where
next :: [[Int]]
next = makeCont (b:xs)
And I will try and make it better. Edits coming I think.
As a comparison, here's an implementation in Erlang:
partition(L) -> [lists:reverse(T) || T <- lists:reverse(partition(L, {[], []}))].
partition([E|L], {R, [EL|_] = T}) when E == EL + 1 -> partition(L, {R, [E|T]});
partition([E|L], {R, []}) -> partition(L, {R, [E]});
partition([E|L], {R, T}) -> partition(L, {[T|R], [E]});
partition([], {R, []}) -> R;
partition([], {R, T}) -> [T|R].
The standard paramorphism recursion scheme isn't in Haskell's Data.List module, though I think it should be. Here's a solution using a paramorphism, because you are building a list-of-lists from a list, the cons-ing is a little tricksy:
contig :: (Eq a, Num a) => [a] -> [[a]]
contig = para phi [] where
phi x ((y:_),(a:acc)) | x + 1 == y = (x:a):acc
phi x (_, acc) = [x]:acc
Paramorphism is general recursion or a fold with lookahead:
para :: (a -> ([a], b) -> b) -> b -> [a] -> b
para phi b [] = b
para phi b (x:xs) = phi x (xs, para phi b xs)
It can be pretty clear and simple in the Erlang:
partition([]) -> [];
partition([A|T]) -> partition(T, [A]).
partition([A|T], [B|_]=R) when A =:= B+1 -> partition(T, [A|R]);
partition(L, P) -> [lists:reverse(P)|partition(L)].
Edit: Just for curiosity I have compared mine and Lukas's version and mine seems about 10% faster either in native either in bytecode version on testing set what I generated by lists:usort([random:uniform(1000000)||_<-lists:seq(1,1000000)]) on R14B01 64b version at mine notebook. (Testing set is 669462 long and has been partitioned to 232451 sublists.)
Edit2: Another test data lists:usort([random:uniform(1000000)||_<-lists:seq(1,10000000)]), length 999963 and 38 partitions makes bigger diference in native code. Mine version finish in less than half of time. Bytecode version is only about 20% faster.
Edit3: Some microoptimizations which provides additional performance but leads to more ugly and less maintainable code:
part4([]) -> [];
part4([A|T]) -> part4(T, A, []).
part4([A|T], B, R) when A =:= B+1 -> part4(T, A, [B|R]);
part4([A|T], B, []) -> [[B]|part4(T, A, [])];
part4([A|T], B, R) -> [lists:reverse(R, [B])|part4(T, A, [])];
part4([], B, R) -> [lists:reverse(R,[B])].
Here's an attempt from a haskell noob
ranges ls = let (a, r) = foldl (\(r, a#(h:t)) e -> if h + 1 == e then (r, e:a) else (a:r, [e])) ([], [head ls]) (tail ls)
in reverse . map reverse $ r : a

Resources