So I'm learning haskell right now, and I'm having trouble understanding what I'm doing wrong for the following function that emulates zip
1.ziplike xs ys = [(x,y)|c<-[0..(min (length xs) (length ys))-1],x<-xs!!c,y<-ys!!c]
2.ziplike xs ys = [(xs!!c,ys!!c)|c<-[0..(min (length xs) (length ys))-1]]
Now, I know that the correct answer is number 2, but I don't understand why number 1 is wrong for the call ziplike [1,2,3] ['a', 'b', 'c', 'd']. I THINK it's because it's trying to select the index for an individual char, but I'm not sure why.
The error is "Couldn't match expected type ‘[t1]’ with actual type ‘Char’"
To a first approximation:
If e::[a],
and x <- e appears to the right of the | in a list comprehension,
then x :: a wherever it is bound.
This leads to a bit of a problem in your case. You have ys :: [Char] and c :: Int, so that ys!!c :: Char. Hence:
We have ys!!c :: Char
and y <- ys!!c appears to the right of the | in a list comprehension,
so y :: ??? wherever it is bound.
But now we are stuck when trying to write the conclusion about what type y should have: Char is not a list of as, no matter what a we pick.
There are several possible fixes; one is to use let instead of <-, as in
ziplike xs ys = [(x,y)|c<-[0..min (length xs) (length ys)-1],let x=xs!!c; y=ys!!c]
It's a type error.
When you write "x from xs get-index c" (i.e. x <- xs !! c) the thing that you are getting "from" xs !! c is not necessarily a list. It's a technical detail, but it's important. The "from" arrow comes from monad syntax/do-notation. A list comprehension is actually just a do-expression specialized to the List monad; so the right hand side of an arrow <- needs to be a list in the List monad.
You can fix this, first off, by "cheating" with singleton lists, a la:
ziplike xs ys = [ (x,y) | c <- [0 .. min (length xs) (length ys) - 1],
x <- [xs !! c],
y <- [ys !! c]]
So these left-arrows are not "let" variable bindings, but they make Cartesian products: but the Cartesian product of n things with 1 thing with 1 thing is just n * 1 * 1 == n things. So this is great, if a little weird and possibly inefficient.
To do what you were trying to do (bind x and y inside of the list comprehension) you could also write something like:
ziplike xs ys = [let x = xs !! c; y = ys !! c in (x, y)
| c <- [0 .. min (length xs) (length ys) - 1]]
-- or --
ziplike xs ys = [(x, y)
| c <- [0 .. min (length xs) (length ys) - 1],
let x = xs !! c, let y = ys !! c]
-- or --
ziplike xs ys = [(x, y)
| c <- [0 .. min (length xs) (length ys) - 1],
let x = xs !! c; y = ys !! c]
Notice that these are all do-notation ideas tacked together with commas. Of course all of these look more clumsy than
ziplike xs ys = [(xs !! c, ys !! c) | c <- [0..min (length xs) (length ys) - 1]
which does the exact same thing.
With that said, all of this stuff is much more inefficient than the zip function's recursive character: if I double the size of the list, your implementations take 4 times as long to process the whole list; zip only takes twice as long. So be mindful of this "hidden O(n2) factor" in your programming.
Related
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]]
I was trying to come up with a "one-liner" for generating permutations of a list in Haskell. This is what I have so far:
perms xs = if length xs == 0 then [[]] else [x:ys | x <- xs, ys <- perms $ delete x xs]
The problem is that I am having to use if which I don't like very much in Haskell. Is it possible to avoid using if, or a multi-part definition, or a case statement etc. and only "higher-order" functions (e.g. foldr etc.) to achieve this? (and also ideally keep it relatively small one-liner)
If you find it satisfactory to just get rid of the if without any interesting changes to the function, base-4.7.0.0 (bundled with GHC 7.8) includes bool in Data.Bool.
perms xs = bool [[]] [x:ys | x <- xs, ys <- perms $ delete x xs] $ not (null xs)
I manage to implement this perms by using foldr, but it becomes more complex. It is hardly to believe this is what you are looking for:
perms xs = filter (\l -> length l == length xs) $ foldr step [[]] xs
where step x acc = (map (x:) . perms $ delete x xs) ++ acc
[ghci] let perms1 xs = [x:ys | x <- xs, (not . null) xs ,ys <- perms $ delete x xs]
[ghci] perms1 []
[]
[ghci] perms1 [1,2,3]
[[1,2,3],[1,3,2],[2,1,3],[2,3,1],[3,1,2],[3,2,1]]
The higher function you need is the one that does the same thing as your if expression: check a given predicate, if true, then evaluate to expression1, else evaluate to expression2.
I didn't find this in the standard library, but this is the function you are looking for:
myBranchFunction :: t -> t -> [a] -> t
myBranchFunction e1 e2 xs = if length xs == 0 then e1 else e2
(you could generalize this further by having length be an argument to myBranchFunction if you would like.)
Then you could define perms' like so:
perms' :: Eq a => [a] -> [[a]]
perms' xs = myBranchFunction [[]] [x:ys | x <- xs, ys <- perms $ delete x xs] xs
Note that all we are doing is moving the if expression out to another function. For this function, however, I think I would prefer not to try to fit it on one line and just use a case expression for readability.
function x i xs = let l = i `mod` length xs in take l xs ++ x : drop (l + 1) xs
can anyone explain to me what does let do here, what it stands for and what does in do here, what it stands for, and what is l
This defines a function (unimaginatively) called function. It takes 3 arguments, x, i and xs. It's worth noting the type signature
function :: Int -> a -> [a] -> [a]
The body of the function is to the right of the =. Let's reindent it for clarity
let l = i `mod` length xs
in take l xs ++ x : drop (l + 1) xs
So l is i modded with the length of xs, and we take l elements from xs and append that to x : drop (l+1) xs. This will drop l + 1 elements from xs and put x in front.
Now rather than telling you what it's for, here are some sample inputs and their results
function 2 2 [1, 2, 3]
> [1, 2, 2]
function 0 (-1) [3, 3, 3]
> [-1, 3, 3]
Since this looks like homework, I'll let you figure out the pattern.
This is pretty basic Haskell, and if this is for a class, I strongly urge you to read Learn You A Haskell, it's great for learning the basics.
You can perhaps read the code better when it is presented with some whitespace added:
function x i xs = let l = i `mod` length xs
in take l xs ++ x : drop (l + 1) xs
let binds the variable l to the expression i `mod` length xs. The value of the overall expression is then
take l xs ++ x : drop (l + 1) xs
where here you use the value for l as given above. There's another way of expressing this in Haskell:
function x i xs = take l xs ++ x : drop (l + 1) xs
where l = i `mod` length xs
This way round it can often read more naturally.
In haskell I have a list comprehension like this:
sq = [(x,y,z) | x <- v, y <- v, z <- v, x*x + y*y == z*z, x < y, y < z]
where v = [1..]
However when I try take 10 sq, it just freezes...
Is there a way to handle multiple infinite ranges?
Thanks
In addition to the other answers explaining the problem, here is an alternative solution, generalized to work with level-monad and stream-monad that lend themselves for searches over infinite search spaces (It is also compatible with the list monad and logict, but those won't play nicely with infinite search spaces, as you already found out):
{-# LANGUAGE MonadComprehensions #-}
module Triples where
import Control.Monad
sq :: MonadPlus m => m (Int, Int, Int)
sq = [(x, y, z) | x <- v, y <- v, z <- v, x*x + y*y == z*z, x < y, y < z]
where v = return 0 `mplus` v >>= (return . (1+))
Now, for a fast breadth first search:
*Triples> :m +Control.Monad.Stream
*Triples Control.Monad.Stream> take 10 $ runStream sq
[(3,4,5),(6,8,10),(5,12,13),(9,12,15),(8,15,17),(12,16,20),(7,24,25),
(15,20,25),(10,24,26),(20,21,29)]
Alternatively:
*Triples> :m +Control.Monad.Levels
*Triples Control.Monad.Levels> take 5 $ bfs sq -- larger memory requirements
[(3,4,5),(6,8,10),(5,12,13),(9,12,15),(8,15,17)]
*Triples Control.Monad.Levels> take 5 $ idfs sq -- constant space, slower, lazy
[(3,4,5),(5,12,13),(6,8,10),(7,24,25),(8,15,17)]
List comprehensions are translated into nested applications of the concatMap function:
concatMap :: (a -> [b]) -> [a] -> [b]
concatMap f xs = concat (map f xs)
concat :: [[a]] -> [a]
concat [] = []
concat (xs:xss) = xs ++ concat xss
-- Shorter definition:
--
-- > concat = foldr (++) []
Your example is equivalent to this:
sq = concatMap (\x -> concatMap (\y -> concatMap (\z -> test x y z) v) v) v
where v = [1..]
test x y z =
if x*x + y*y == z*z
then if x < y
then if y < z
then [(x, y, z)]
else []
else []
else []
This is basically a "nested loops" approach; it'll first try x = 1, y = 1, z = 1, then move on to x = 1, y = 1, z = 2 and so on, until it tries all of the list's elements as values for z; only then can it move on to try combinations with y = 2.
But of course you can see the problem—since the list is infinite, we never run out of values to try for z. So the combination (3, 4, 5) can only occur after infinitely many other combinations, which is why your code loops forever.
To solve this, we need to generate the triples in a smarter way, such that for any possible combination, the generator reaches it after some finite number of steps. Study this code (which handles only pairs, not triples):
-- | Take the Cartesian product of two lists, but in an order that guarantees
-- that all combinations will be tried even if one or both of the lists is
-- infinite:
cartesian :: [a] -> [b] -> [(a, b)]
cartesian [] _ = []
cartesian _ [] = []
cartesian (x:xs) (y:ys) =
[(x, y)] ++ interleave3 vertical horizontal diagonal
where
-- The trick is to split the problem into these four pieces:
--
-- |(x0,y0)| (x0,y1) ... horiz
-- +-------+------------
-- |(x1,y0)| .
-- | . | .
-- | . | .
-- | . | .
-- vert diag
vertical = map (\x -> (x,y)) xs
horizontal = map (\y -> (x,y)) ys
diagonal = cartesian xs ys
interleave3 :: [a] -> [a] -> [a] -> [a]
interleave3 xs ys zs = interleave xs (interleave ys zs)
interleave :: [a] -> [a] -> [a]
interleave xs [] = xs
interleave [] ys = ys
interleave (x:xs) (y:ys) = x : y : interleave xs ys
To understand this code (and fix it if I messed up!) look at this blog entry on how to count infinite sets, and at the fourth diagram in particular—the function is an algorithm based on that "zigzag"!
I just tried a simple version of your sq using this; it finds (3,4,5) almost instantly, but then takes very long to get to any other combination (in GHCI at least). But I think the key lessons to take away from this are:
List comprehensions just don't work well for nested infinite lists.
Don't spend too much time playing around with list comprehensions. Everything that they can do, functions like map, filter and concatMap can do—plus there are many other useful functions in the list library, so concentrate your effort on that.
Your code freeze because yours predicate will never been satisfied.
Why ?
Let's take an example without any predicate to understand.
>>> let v = [1..] in take 10 $ [ (x, y, z) | x <- v, y <- v, z <- v ]
[(1,1,1),(1,1,2),(1,1,3),(1,1,4),(1,1,5),(1,1,6),(1,1,7),(1,1,8),(1,1,9),(1,1,10)]
As you see x and y will always be evaluated to 1 as z will never stop to rise.
Then your predicate can't be.
Any workaround ?
Try "Nested list" comprehension.
>>> [[ fun x y | x <- rangeX, predXY] | y <- rangeY, predY ]
Or parallel list comprehension which can be activated using,
>>> :set -XParallelListComp
lookup on the doc
This is possible, but you'll have to come up with an order in which to generate the numbers. The following generates the numbers you want; note that the x < y test can be replaced by generating only y that are >x and similarly for z (which is determined once x and y are bound):
[(x, y, z) | total <- [1..]
, x <- [1..total-2]
, y <- [x..total-1]
, z <- [total - x - y]
, x*x + y*y == z*z]
I'd like to know why Haskell accepts this
perms xs = [ x:y | i <- [0..(length xs - 1)], x <- [xs!!i], y <- perms (takeOut i xs)]
but won't accept that:
perms xs = [ x:(perms y) | i <- [0..(length xs - 1)], x <- [xs!!i], y <- (takeOut i xs)]
It complains that
[1 of 1] Compiling Main ( abc.hs, interpreted )
Occurs check: cannot construct the infinite type: t = [t]
Expected type: t -> [t]
Inferred type: [t] -> [[a]]
In the second argument of `(:)', namely `(perms y)'
In the expression: x : (perms y)
I can understand what it says, I just cannot is on why the first one is OK and the second one is not!
EDIT: Ah, of course I also have
perms [] = [[]]
at the top.
Thanks
In the first expression you have x:y which means, that if x :: a then y :: [a].
In x : perms y if x :: a then it must be that perms y :: [a], but perms y :: [[a]] (list of permutations).
Typechecker tries to unify [a] and [[a]] and fails.
My brain hurts and I'm not an expert, but I think:
In
perms xs = [ x:y | i <- [0..(length xs - 1)], x <- [xs!!i], y <- perms (takeOut i xs)]
perms (takeOut i xs) is a list of lists. x is consed onto each element of that list. Perms is invoked on the list as a whole, so perms is a function taking list-of-thing.
In
perms xs = [ x:(perms y) | i <- [0..(length xs - 1)], x <- [xs!!i], y <- (takeOut i xs)]
(takeOut i xs) is a list, and for each element of that list x is consed onto perms of that element. Perms is invoked on each element of the list, so perms is a function taking thing.
Only the former case is internally consistent, and the typechecker loves you.
In a list comprehension, x <- ys binds x to each element in ys. Essentially, you are trying to transform:
[ f foo | foo <- bar ]
Into
[ f bar ]
The phrase
y <- perms (takeOut i xs)
Means "for each permutation y of takeOut i xs". So the [ x:y | ... ] prepends x to each permutation.
Correspondingly, the phrase
y <- takeOut i xs
Means "for each element y of takeOut i xs". So the [ x:perms y | ... ] is attempting to find all permutations of the element y (not even a list), and then prepend x to that list of permutations. The permutations of something is a list of lists, so x must be a list to do this, which it is not. So, basically, the second one makes no sense.
I can see why you would be thrown off. Just remember, <- isn't the same as let, it means for each.