Cartesian product of infinite lists in Haskell - list

I have a function for finite lists
> kart :: [a] -> [b] -> [(a,b)]
> kart xs ys = [(x,y) | x <- xs, y <- ys]
but how to implement it for infinite lists? I have heard something about Cantor and set theory.
I also found a function like
> genFromPair (e1, e2) = [x*e1 + y*e2 | x <- [0..], y <- [0..]]
But I'm not sure if it helps, because Hugs only gives out pairs without ever stopping.
Thanks for help.

Your first definition, kart xs ys = [(x,y) | x <- xs, y <- ys], is equivalent to
kart xs ys = xs >>= (\x ->
ys >>= (\y -> [(x,y)]))
where
(x:xs) >>= g = g x ++ (xs >>= g)
(x:xs) ++ ys = x : (xs ++ ys)
are sequential operations. Redefine them as alternating operations,
(x:xs) >>/ g = g x +/ (xs >>/ g)
(x:xs) +/ ys = x : (ys +/ xs)
[] +/ ys = ys
and your definition should be good to go for infinite lists as well:
kart_i xs ys = xs >>/ (\x ->
ys >>/ (\y -> [(x,y)]))
testing,
Prelude> take 20 $ kart_i [1..] [101..]
[(1,101),(2,101),(1,102),(3,101),(1,103),(2,102),(1,104),(4,101),(1,105),(2,103)
,(1,106),(3,102),(1,107),(2,104),(1,108),(5,101),(1,109),(2,105),(1,110),(3,103)]
courtesy of "The Reasoned Schemer". (see also conda, condi, conde, condu).
another way, more explicit, is to create separate sub-streams and combine them:
kart_i2 xs ys = foldr g [] [map (x,) ys | x <- xs]
where
g a b = head a : head b : g (tail a) (tail b)
this actually produces exactly the same results. But now we have more control over how we combine the sub-streams. We can be more diagonal:
kart_i3 xs ys = g [] [map (x,) ys | x <- xs]
where -- works both for finite
g [] [] = [] -- and infinite lists
g a b = concatMap (take 1) a
++ g (filter (not . null) (take 1 b ++ map (drop 1) a))
(drop 1 b)
so that now we get
Prelude> take 20 $ kart_i3 [1..] [101..]
[(1,101),(2,101),(1,102),(3,101),(2,102),(1,103),(4,101),(3,102),(2,103),(1,104)
,(5,101),(4,102),(3,103),(2,104),(1,105),(6,101),(5,102),(4,103),(3,104),(2,105)]
With some searching on SO I've also found an answer by Norman Ramsey with seemingly yet another way to generate the sequence, splitting these sub-streams into four areas - top-left tip, top row, left column, and recursively the rest. His merge there is the same as our +/ here.
Your second definition,
genFromPair (e1, e2) = [x*e1 + y*e2 | x <- [0..], y <- [0..]]
is equivalent to just
genFromPair (e1, e2) = [0*e1 + y*e2 | y <- [0..]]
Because the list [0..] is infinite there's no chance for any other value of x to come into play. This is the problem that the above definitions all try to avoid.

Prelude> let kart = (\xs ys -> [(x,y) | ls <- map (\x -> map (\y -> (x,y)) ys) xs, (x,y) <- ls])
Prelude> :t kart
kart :: [t] -> [t1] -> [(t, t1)]
Prelude> take 10 $ kart [0..] [1..]
[(0,1),(0,2),(0,3),(0,4),(0,5),(0,6),(0,7),(0,8),(0,9),(0,10)]
Prelude> take 10 $ kart [0..] [5..10]
[(0,5),(0,6),(0,7),(0,8),(0,9),(0,10),(1,5),(1,6),(1,7),(1,8)]

you can think of the sequel as
0: (0, 0)
/ \
1: (1,0) (0,1)
/ \ / \
2: (2,0) (1, 1) (0,2)
...
Each level can be expressed by level n: [(n,0), (n-1, 1), (n-2, 2), ..., (0, n)]
Doing this to n <- [0..]
We have
cartesianProducts = [(n-m, m) | n<-[0..], m<-[0..n]]

Related

Standard ML :How to cycle through a list?

I am trying to write a program that cycle through a list n times.
Suppose that L = [a1, a2, ... , an]
What I am trying to achieve is [ai+1, a i+2, ... , an, a1, a2, ... , ai].
I referenced to a previous post about this exact problem. However, I am not sure how to obtain the output or [ai+1, a i+2, ... , an, a1, a2, ... , ai].
For the output: I tried
-cycle([1,2,3,4], 5);
However the error that I am getting is that the operand and operator don't match
This is the code I found from the previous post:
fun cycle n i =
if i = 0 then n
else cycle (tl n) (i-1) # [hd(n)];
A way to do this using if-then-else:
fun cycle xs n =
if n = 0
then []
else xs # cycle xs (n - 1)
You might instead like to use pattern matching:
fun cycle xs 0 = []
| cycle xs n = xs # cycle xs (n - 1)
But the most elegant solution, I think, is using higher-order functions:
fun cycle xs n =
List.concat (List.tabulate (n, fn _ => xs))
A slightly harder task is how to write a cycle for lazy lists that cycles infinitely...
datatype 'a lazylist = Cons of 'a * (unit -> 'a lazylist) | Nil
fun fromList [] = Nil
| fromList (x::xs) = Cons (x, fn () => fromList xs)
fun take 0 _ = []
| take _ Nil = []
| take n (Cons (x, tail)) = x :: take (n - 1) (tail ())
local
fun append' (Nil, ys) = ys
| append' (Cons (x, xtail), ys) =
Cons (x, fn () => append' (xtail (), ys))
in
fun append (xs, Nil) = xs
| append (xs, ys) = append' (xs, ys)
end
fun cycle xs = ...
where take 5 (cycle (fromList [1,2])) = [1,2,1,2,1].

Rewriting zipWith function using list comprehension

I've rewritten the zipWith function using recursion, and now I am trying to rewrite it using list comprehension. I have run into quite a few binding errors and I know that my second line is incorrect. This is the function I have that works like zipWith using recursion:
zipW :: (a -> b -> c) -> [a] -> [b] -> [c]
zipW _ [] _ = []
zipW _ _ [] = []
zipW f (x:xs) (y:ys) = f x y : zipW f xs ys
And this is my attempt to rewrite it as list comprehension:
zipW2 :: (a -> b -> c) -> [a] -> [b] -> [c]
zipW2 f xs ys = [f x y | (x, y) <- zipW2 f xs ys]
I am not sure how to correct the second statement so that it works like zipWith and allows me to choose the operator.
You will need Parallel List Comprehensions extension:
{-# LANGUAGE ParallelListComp #-}
zipWith' :: (a -> b -> c) -> [a] -> [b] -> [c]
zipWith' f xs ys = [f x y | x <- xs | y <- ys]
The original zipWith has three cases:
when the first list is empty
when the second list is empty
when the neither list is empty
The third case recursively calls zipWith on the tails of the arguments, which does the case analysis again.
In your definition, you only have one case - the list comprehension, so any recursive calls are going to wrap right back to that. And without case analysis, you could loop forever here:
>>> let myZipWith f xs ys = [ f x y | (x,y) <- myZipWith f xs ys ]
>>> myZipWith (,) [] []
^CInterrupted.
Furthermore because you're using f in the recursive call but requiring that the recursive output be a pair, you're placing the implicit requirement that f x y produce a pair:
>>> :t myZipWith
myZipWith :: (t2 -> t3 -> (t2, t3)) -> t -> t1 -> [(t2, t3)]
The solution is to not recurse, but instead to consider each pair directly.
You can use behzad.nouri's solution of enabling the ParallelListComp language extension:
>>> :set -XParallelListComp
>>> let myZipWith f xs ys = [ f x y | x <- xs | y <- ys ]
>>> myZipWith (+) [1,2,4] [0,10,20]
[1,12,24]
ParallelListComp makes the second (and later) vertical pipe characters (|) in a list comprehension legal syntax, stepping through those lists in parallel (zip-like) with earlier lists.
It's good to know how this differs from normal list comprehensions, where you separate each list you draw from with commas. Using commas does nested iteration which is flattened out in the resulting list:
>>> let notZipWith f xs ys = [ f x y | x <- xs, y <- ys ]
>>> notZipWith (+) [1,2,4] [0,10,20]
[1,11,21,2,12,22,4,14,24]
Using the ParallelListComp extension is really just syntatical sugar for the original zipWith, so you may consider it cheating.
You could also just rely on the original zip:
>>> let myZipWith f xs ys = [ f x y | (x,y) <- zip xs ys ]
>>> myZipWith (+) [1,2,4] [0,10,20]
[1,12,24]
But since zip is defined as zipWith (,), that's probably cheating too.
Another way you could go is to use indices:
>>> let myZipWith f xs ys = [ f x y | i <- [0..min (length xs) (length ys) - 1], let x = xs !! i, let y = ys !! i ]
>>> myZipWith (+) [1,2,4] [0,10,20]
[1,12,24]
But this is going to be horrendously inefficient, as !! is a linear-time operation, making myZipWith quadratic, while zipWith is linear:
>>> :set +s
>>> last $ myZipWith (+) (replicate 10000000 1) (replicate 10000000 2)
3
(4.80 secs, 3282337752 bytes)
>>> last $ zipWith (+) (replicate 10000000 1) (replicate 10000000 2)
3
(0.40 secs, 2161935928 bytes)
I'm sure there's other bad ways to create an equivalent to zipWith with a list comprehension, but I'm not terribly convinced that there's a good way, even from the ones above.

Haskell right-sided recursion to left-sided recursion

In my problem i have list of lists, and i want to find list of lists being selectors (selector - list containing exactly one element from each list), satisfying special condition.
The code to generate all selectors would look like:
selectors :: [[a]] -> [[a]]
selectors [] = [[]]
selectors (y:ys) = [ (x:xs) | x <- y, xs <- selectors ys]
If i wanted to add some extra condition this would be like
selectors :: [[a]] -> ([a] -> Bool) -> [[a]]
selectors [] _ = [[]]
selectors (y:ys) f = [ (x:xs) | x <- y, xs <- selectors ys f, f xs]
However in my problem, i need the condition to be dependable on element being candidate for a list, and what's in list i currently build. So this would be something like:
selectors :: [[a]] -> ( a-> [a] -> Bool) -> [[a]]
selectors [] _ = [[]]
selectors (y:ys) f = [ (x:xs) | x <- y, xs <- selectors ys f, f x xs]
And this is working very slow, because at first the recursion goes in very deeply and real work starts from there, whereas this would be MUCH faster if building list was going from left, so whenever i try to add new element to my list and i know this cannot be added so i'd just try to add new element. How can i make this work this way?
You can change the order of some searches by commuting the loop bodies.
for i in foo foo j in bar
for j in bar versus foo i in foo
do(i, j) do(i, j)
The same effect can be achieved in list comprehension syntax. For the given example, it might be
[ (x:xs) | x <- y, xs <- selectors ys f, f x xs ]
-- versus
[ (x:xs) | xs <- selectors ys f, x <- y, f x xs ]
If we're only considering the result as a set of values (i.e. the order is immaterial) then the values are identical. Regarded as a set, the only rules considering order of list comprehension clauses are that referenced variables must be bound in clauses left of their reference site.
Let's desugar this notation a bit to see the mechanics at work in higher fidelity.
List comprehensions are (almost) equivalent to do-notation in the list monad. Without necessarily diving into what monads are, I'll claim that our list comprehension desugars like this
-- [ (x:xs) | x <- y, xs <- selectors ys f, f x xs ]
-- becomes...
do x <- y
xs <- selectors ys f
guard (f x xs)
return (x:xs)
The translation should be obvious—each generator clause containing (<-) becomes a do-syntax binding form. Each guard clause becomes a do-notation form using the (perfectly normal) function guard :: Bool -> [()]. Finally, the translation preserves order.
But now, do-notation is just syntax sugar itself! It desugars to a series of function applications. Again, to not dive into the meaning of monads, I'll just do this transformation exactly.
-- [ (x:xs) | x <- y, xs <- selectors ys f, f x xs ]
-- becomes...
y >>= (\x -> selectors ys f >>= (\xs -> guard (f x xs) >> return (x:xs)))
In particular, each generator line like x <- E becomes E >>= (\x -> ...) where the ... corresponds to the translation of the remainder of the do block. Lines like E without binding arrows translate to E >> .... We can even simplify this one level further by noting that E >> F is nothing more than E >>= (\_ -> F) so that ultimately we have
y >>= (\x -> selectors ys f >>= (\xs -> guard (f x xs) >>= (\_ -> return (x:xs))))
And as a final step, we can translate the (>>=), guard, and return functions to the format they take for the list monad. In particular ls >>= f is equal to concat (map f ls) and return x = [x]. It's actually convenient to write (>>=) in a prefix instead of infix form, as well, so we'll call it forl :: [a] -> (a -> [b]) -> [b].
The function guard is a little strange. It looks like guard b = if b then [()] else []. We'll see how it works in a moment.
forl y $ \x ->
forl (selectors ys f) $ \xs ->
forl (guard (f x xs)) $ \_ ->
[x:xs]
Now this is a full translation. If we can understand this then we've understood the mechanics of the list comprehension. For comparison, this is how the list comprehension desugars when we switch the order of the generator clauses
forl y $ \x -> forl (selectors ys f) $ \xs ->
forl (selectors ys f) $ \xs -> forl y $ \x ->
forl (guard (f x xs)) $ \_ -> forl (guard (f x xs)) $ \_ ->
[x:xs] [x:xs]
which looks very similar to the imperative example given at the beginning. Let's show that it's actually identical.
First, we can dispatch how forl (guard (f x xs)) $ \_ -> [x:xs] works. We'll just inline the definition of guard and then forl
forl (if (f x xs) then [()] else []) (\_ -> [x:xs])
concat (map (\_ -> [x:xs]) (if (f x xs) then [()] else []))
We can "lift" the if out of the inside by noting that once we've wrapped the whole thing in an outer lift, the value of (f x xs) is fixed in both the then and else branches.
if (f x xs)
then concat (map (\_ -> [x:xs]) [()]
else concat (map (\_ -> [x:xs]) []
And finally, we can inline the maps and then the concats
if f x xs
then concat [(\_ -> [x:xs]) ()]
then concat []
if f x xs then [x:xs] else []
forl y $ \x -> forl (selectors ys f) $ \xs ->
forl (selectors ys f) $ \xs -> forl y $ \x ->
if f x xs then [x:xs] else [] if f x xs then [x:xs] else []
And now it ought to be increasingly clear how these "for" loops work. They loop over a body and produce a list of the results. Since we expect that the body will also be a forl loop, we have to anticipate that the value in the body is a list itself—this we flatten that extra layer of lists using concat.

Monadic way for list comprehension

I have the following function
combinations :: [[a]] -> [[a]]
combinations [] = [[]]
combinations (xs:xss) = concat [map (x:) yss | x <- xs]
where yss = combinations xss
Which produces all combinations between its elements:
*Main> combinations [[1,2],[2,3,4],[5,6]]
[[1,2,5],[1,2,6],[1,3,5],[1,3,6],[1,4,5],[1,4,6],[2,2,5],[2,2,6],[2,3,5],[2,3,6]
,[2,4,5],[2,4,6]]
I some how feel there must be a monadic way to do this
foobar = do
n <- [1,2]
ch <- [3,4,5]
return[n,ch]
This is how far I came. But I am stuck.
Your function is sequence for the list monad.
> :t sequence
sequence :: Monad m => [m a] -> m [a]
> sequence [[1,2],[2,3,4],[5,6]]
[[1,2,5],[1,2,6],[1,3,5],[1,3,6],[1,4,5],[1,4,6],[2,2,5],[2,2,6],[2,3,5],[2,3,6],
[2,4,5],[2,4,6]]
The best I've been able to come up with is
combinations [] = [[]]
combinations (xs:xss) = do
x <- xs
ys <- combinations xss
return $ x : ys
The way I derived this was I first converted the list comprehension into monadic code (which also meant dropping the concat to get it to type check)
combinations (xs:xss) =
let yss = combinations xss
in do
x <- xs
map (x:) yss
Then I realized that map (x:) yss is exactly fmap (x:) yss, which is exactly yss >>= return . (x:), so I knew I could do
combinations (xs:xss) =
let yss = combinations xss
in do
x <- xs
ys <- yss
return $ x : ys
And then it can be inlined as
combinations (xs:xss) = do
x <- xs
ys <- combinations xss
return $ x : ys

Implement insert in haskell with foldr

How to implement insert using foldr in haskell.
I tried:
insert'' :: Ord a => a -> [a] -> [a]
insert'' e xs = foldr (\x -> \y -> if x<y then x:y else y:x) [e] xs
No dice.
I have to insert element e in list so that it goes before first element that is larger or equal to it.
Example:
insert'' 2.5 [1,2,3] => [1.0,2.0,2.5,3.0]
insert'' 2.5 [3,2,1] => [2.5,3.0,2.0,1.0]
insert'' 2 [1,2,1] => [1,2,2,1]
In last example first 2 is inserted one.
EDIT:
Thanks #Lee.
I have this now:
insert'' :: Ord a => a -> [a] -> [a]
insert'' e xs = insert2 e (reverse xs)
insert2 e = reverse . snd . foldr (\i (done, l) -> if (done == False) && (vj e i) then (True, e:i:l) else (done, i:l)) (False, [])
where vj e i = e<=i
But for this is not working:
insert'' 2 [1,3,2,3,3] => [1,3,2,2,3,3]
insert'' 2 [1,3,3,4] => [1,3,2,3,4]
insert'' 2 [4,3,2,1] => [4,2,3,2,1]
SOLUTION:
insert'' :: Ord a => a -> [a] -> [a]
insert'' x xs = foldr pom poc xs False
where
pom y f je
| je || x > y = y : f je
| otherwise = x : y : f True
poc True = []
poc _ = [x]
Thanks #Pedro Rodrigues (It just nedded to change x>=y to x>y.)
(How to mark this as answered?)
You need paramorphism for that:
para :: (a -> [a] -> r -> r) -> r -> [a] -> r
foldr :: (a -> r -> r) -> r -> [a] -> r
para c n (x : xs) = c x xs (para c n xs)
foldr c n (x : xs) = c x (foldr c n xs)
para _ n [] = n
foldr _ n [] = n
with it,
insert v xs = para (\x xs r -> if v <= x then (v:x:xs) else (x:r)) [v] xs
We can imitate paramorphisms with foldr over init . tails, as can be seen here: Need to partition a list into lists based on breaks in ascending order of elements (Haskell).
Thus the solution is
import Data.List (tails)
insert v xs = foldr g [v] (init $ tails xs)
where
g xs#(x:_) r | v <= x = v : xs
| otherwise = x : r
Another way to encode paramorphisms is by a chain of functions, as seen in the answer by Pedro Rodrigues, to arrange for the left-to-right information flow while passing a second copy of the input list itself as an argument (replicating the effect of tails):
insert v xs = foldr g (\ _ -> [v]) xs xs
where
g x r xs | v > x = x : r (tail xs) -- xs =#= (x:_)
| otherwise = v : xs
-- visual aid to how this works, for a list [a,b,c,d]:
-- g a (g b (g c (g d (\ _ -> [v])))) [a,b,c,d]
Unlike the version in his answer, this does not copy the rest of the list structure after the insertion point (which is possible because of paramorphism's "eating the cake and having it too").
Here's my take at it:
insert :: Ord a => a -> [a] -> [a]
insert x xs = foldr aux initial xs False
where
aux y f done
| done || x > y = y : f done
| otherwise = x : y : f True
initial True = []
initial _ = [x]
However IMHO using foldr is not the best fit for this problem, and for me the following solution is easier to understand:
insert :: Int -> [Int] -> [Int]
insert x [] = [x]
insert x z#(y : ys)
| x <= y = x : z
| otherwise = y : insert x ys
I suppose fold isn't handy here. It always processes all elements of list, but you need to stop then first occurence was found.
Of course it is possible, but you probable don't want to use this:
insert' l a = snd $ foldl (\(done, l') b -> if done then (True, l'++[b]) else if a<b then (False, l'++[b]) else (True, l'++[a,b])) (False, []) l