Related
I have to split the given list into non-empty sub-lists each of which
is either in strictly ascending order, in strictly descending order, or contains all equal elements. For example, [5,6,7,2,1,1,1] should become [[5,6,7],[2,1],[1,1]].
Here is what I have done so far:
splitSort :: Ord a => [a] -> [[a]]
splitSort ns = foldr k [] ns
where
k a [] = [[a]]
k a ns'#(y:ys) | a <= head y = (a:y):ys
| otherwise = [a]:ns'
I think I am quite close but when I use it it outputs [[5,6,7],[2],[1,1,1]] instead of [[5,6,7],[2,1],[1,1]].
Here is a kinda ugly solution, with three reverse in one line of code :).
addElement :: Ord a => a -> [[a]] -> [[a]]
addElement a [] = [[a]]
addElement a (x:xss) = case x of
(x1:x2:xs)
| any (check a x1 x2) [(==),(<),(>)] -> (a:x1:x2:xs):xss
| otherwise -> [a]:(x:xss)
_ -> (a:x):xss
where
check x1 x2 x3 op = (x1 `op` x2) && (x2 `op` x3)
splitSort xs = reverse $ map reverse $ foldr addElement [] (reverse xs)
You can possibly get rid of all the reversing if you modify addElement a bit.
EDIT:
Here is a less reversing version (even works for infinite lists):
splitSort2 [] = []
splitSort2 [x] = [[x]]
splitSort2 (x:y:xys) = (x:y:map snd here):splitSort2 (map snd later)
where
(here,later) = span ((==c) . uncurry compare) (zip (y:xys) xys)
c = compare x y
EDIT 2:
Finally, here is a solution based on a single decorating/undecorating, that avoids comparing any two values more than once and is probably a lot more efficient.
splitSort xs = go (decorate xs) where
decorate :: Ord a => [a] -> [(Ordering,a)]
decorate xs = zipWith (\x y -> (compare x y,y)) (undefined:xs) xs
go :: [(Ordering,a)] -> [[a]]
go ((_,x):(c,y):xys) = let (here, later) = span ((==c) . fst) xys in
(x : y : map snd here) : go later
go xs = map (return . snd) xs -- Deal with both base cases
Every ordered prefix is already in some order, and you don't care in which, as long as it is the longest:
import Data.List (group, unfoldr)
foo :: Ord t => [t] -> [[t]]
foo = unfoldr f
where
f [] = Nothing
f [x] = Just ([x], [])
f xs = Just $ splitAt (length g + 1) xs
where
(g : _) = group $ zipWith compare xs (tail xs)
length can be fused in to make the splitAt count in unary essentially, and thus not be as strict (unnecessarily, as Jonas Duregård rightly commented):
....
f xs = Just $ foldr c z g xs
where
(g : _) = group $ zipWith compare xs (tail xs)
c _ r (x:xs) = let { (a,b) = r xs } in (x:a, b)
z (x:xs) = ([x], xs)
The initial try turned out to be lengthy probably inefficient but i will keep it striked for the sake of integrity with the comments. You best just skip to the end for the answer.
Nice question... but turns out to be a little hard candy. My approach is in segments, those of each i will explain;
import Data.List (groupBy)
splitSort :: Ord a => [a] -> [[a]]
splitSort (x:xs) = (:) <$> (x :) . head <*> tail $ interim
where
pattern = zipWith compare <$> init <*> tail
tuples = zipWith (,) <$> tail <*> pattern
groups = groupBy (\p c -> snd p == snd c) . tuples $ (x:xs)
interim = groups >>= return . map fst
*Main> splitSort [5,6,7,2,1,1,1]
[[5,6,7],[2,1],[1,1]]
The pattern function (zipWith compare <$> init <*> tail) is of type Ord a => [a] -> [Ordering] when fed with [5,6,7,2,1,1,1] compares the init of it by the tail of it by zipWith. So the result would be [LT,LT,GT,GT,EQ,EQ]. This is the pattern we need.
The tuples function will take the tail of our list and will tuple up it's elements with the corresponding elements from the result of pattern. So we will end up with something like [(6,LT),(7,LT),(2,GT),(1,GT),(1,EQ),(1,EQ)].
The groups function utilizes Data.List.groupBy over the second items of the tuples and generates the required sublists such as [[(6,LT),(7,LT)],[(2,GT),(1,GT)],[(1,EQ),(1,EQ)]]
Interim is where we monadically get rid of the Ordering type values and tuples. The result of interim is [[6,7],[2,1],[1,1]].
Finally at the main function body (:) <$> (x :) . head <*> tail $ interim appends the first item of our list (x) to the sublist at head (it has to be there whatever the case) and gloriously present the solution.
Edit: So investigating the [0,1,0,1] resulting [[0,1],[0],[1]] problem that #Jonas Duregård discovered, we can conclude that in the result there shall be no sub lists with a length of 1 except for the last one when singled out. I mean for an input like [0,1,0,1,0,1,0] the above code produces [[0,1],[0],[1],[0],[1],[0]] while it should [[0,1],[0,1],[0,1],[0]]. So I believe adding a squeeze function at the very last stage should correct the logic.
import Data.List (groupBy)
splitSort :: Ord a => [a] -> [[a]]
splitSort [] = []
splitSort [x] = [[x]]
splitSort (x:xs) = squeeze $ (:) <$> (x :) . head <*> tail $ interim
where
pattern = zipWith compare <$> init <*> tail
tuples = zipWith (,) <$> tail <*> pattern
groups = groupBy (\p c -> snd p == snd c) $ tuples (x:xs)
interim = groups >>= return . map fst
squeeze [] = []
squeeze [y] = [y]
squeeze ([n]:[m]:ys) = [n,m] : squeeze ys
squeeze ([n]:(m1:m2:ms):ys) | compare n m1 == compare m1 m2 = (n:m1:m2:ms) : squeeze ys
| otherwise = [n] : (m1:m2:ms) : squeeze ys
squeeze (y:ys) = y : squeeze s
*Main> splitSort [0,1, 0, 1, 0, 1, 0]
[[0,1],[0,1],[0,1],[0]]
*Main> splitSort [5,6,7,2,1,1,1]
[[5,6,7],[2,1],[1,1]]
*Main> splitSort [0,0,1,0,-1]
[[0,0],[1,0,-1]]
Yes; as you will also agree the code has turned out to be a little too lengthy and possibly not so efficient.
The Answer: I have to trust the back of my head when it keeps telling me i am not on the right track. Sometimes, like in this case, the problem reduces down to a single if then else instruction, much simpler than i had initially anticipated.
runner :: Ord a => Maybe Ordering -> [a] -> [[a]]
runner _ [] = []
runner _ [p] = [[p]]
runner mo (p:q:rs) = let mo' = Just (compare p q)
(s:ss) = runner mo' (q:rs)
in if mo == mo' || mo == Nothing then (p:s):ss
else [p] : runner Nothing (q:rs)
splitSort :: Ord a => [a] -> [[a]]
splitSort = runner Nothing
My test cases
*Main> splitSort [0,1, 0, 1, 0, 1, 0]
[[0,1],[0,1],[0,1],[0]]
*Main> splitSort [5,6,7,2,1,1,1]
[[5,6,7],[2,1],[1,1]]
*Main> splitSort [0,0,1,0,-1]
[[0,0],[1,0,-1]]
*Main> splitSort [1,2,3,5,2,0,0,0,-1,-1,0]
[[1,2,3,5],[2,0],[0,0],[-1,-1],[0]]
For this solution I am making the assumption that you want the "longest rally". By that I mean:
splitSort [0, 1, 0, 1] = [[0,1], [0,1]] -- This is OK
splitSort [0, 1, 0, 1] = [[0,1], [0], [1]] -- This is not OK despite of fitting your requirements
Essentially, There are two pieces:
Firstly, split the list in two parts: (a, b). Part a is the longest rally considering the order of the two first elements. Part b is the rest of the list.
Secondly, apply splitSort on b and put all list into one list of list
Taking the longest rally is surprisingly messy but straight. Given the list x:y:xs: by construction x and y will belong to the rally. The elements in xs belonging to the rally depends on whether or not they follow the Ordering of x and y. To check this point, you zip every element with the Ordering is has compared against its previous element and split the list when the Ordering changes. (edge cases are pattern matched) In code:
import Data.List
import Data.Function
-- This function split the list in two (Longest Rally, Rest of the list)
splitSort' :: Ord a => [a] -> ([a], [a])
splitSort' [] = ([], [])
splitSort' (x:[]) = ([x],[])
splitSort' l#(x:y:xs) = case span ( (o ==) . snd) $ zip (y:xs) relativeOrder of
(f, s) -> (x:map fst f, map fst s)
where relativeOrder = zipWith compare (y:xs) l
o = compare y x
-- This applies the previous recursively
splitSort :: Ord a => [a] -> [[a]]
splitSort [] = []
splitSort (x:[]) = [[x]]
splitSort (x:y:[]) = [[x,y]]
splitSort l#(x:y:xs) = fst sl:splitSort (snd sl)
where sl = splitSort' l
I wonder whether this question can be solve using foldr if splits and groups a list from
[5,6,7,2,1,1,1]
to
[[5,6,7],[2,1],[1,1]]
instead of
[[5,6,7],[2],[1,1,1]]
The problem is in each step of foldr, we only know the sorted sub-list on right-hand side and a number to be processed. e.g. after read [1,1] of [5,6,7,2,1,1,1] and next step, we have
1, [[1, 1]]
There are no enough information to determine whether make a new group of 1 or group 1 to [[1,1]]
And therefore, we may construct required sorted sub-lists by reading elements of list from left to right, and why foldl to be used. Here is a solution without optimization of speed.
EDIT:
As the problems that #Jonas Duregård pointed out on comment, some redundant code has been removed, and beware that it is not a efficient solution.
splitSort::Ord a=>[a]->[[a]]
splitSort numList = foldl step [] numList
where step [] n = [[n]]
step sublists n = groupSublist (init sublists) (last sublists) n
groupSublist sublists [n1] n2 = sublists ++ [[n1, n2]]
groupSublist sublists sortedList#(n1:n2:ns) n3
| isEqual n1 n2 = groupIf (isEqual n2 n3) sortedList n3
| isAscen n1 n2 = groupIfNull isAscen sortedList n3
| isDesce n1 n2 = groupIfNull isDesce sortedList n3
| otherwise = mkNewGroup sortedList n3
where groupIfNull check sublist#(n1:n2:ns) n3
| null ns = groupIf (check n2 n3) [n1, n2] n3
| otherwise = groupIf (check (last ns) n3) sublist n3
groupIf isGroup | isGroup = addToGroup
| otherwise = mkNewGroup
addToGroup gp n = sublists ++ [(gp ++ [n])]
mkNewGroup gp n = sublists ++ [gp] ++ [[n]]
isEqual x y = x == y
isAscen x y = x < y
isDesce x y = x > y
My initial thought looks like:
ordruns :: Ord a => [a] -> [[a]]
ordruns = foldr extend []
where
extend a [ ] = [ [a] ]
extend a ( [b] : runs) = [a,b] : runs
extend a (run#(b:c:etc) : runs)
| compare a b == compare b c = (a:run) : runs
| otherwise = [a] : run : runs
This eagerly fills from the right, while maintaining the Ordering in all neighbouring pairs for each sublist. Thus only the first result can end up with a single item in it.
The thought process is this: an Ordering describes the three types of subsequence we're looking for: ascending LT, equal EQ or descending GT. Keeping it the same every time we add on another item means it will match throughout the subsequence. So we know we need to start a new run whenever the Ordering does not match. Furthermore, it's impossible to compare 0 or 1 items, so every run we create contains at least 1 and if there's only 1 we do add the new item.
We could add more rules, such as a preference for filling left or right. A reasonable optimization is to store the ordering for a sequence instead of comparing the leading two items twice per item. And we could also use more expressive types. I also think this version is inefficient (and inapplicable to infinite lists) due to the way it collects from the right; that was mostly so I could use cons (:) to build the lists.
Second thought: I could collect the lists from the left using plain recursion.
ordruns :: Ord a => [a] -> [[a]]
ordruns [] = []
ordruns [a] = [[a]]
ordruns (a1:a2:as) = run:runs
where
runs = ordruns rest
order = compare a1 a2
run = a1:a2:runcontinuation
(runcontinuation, rest) = collectrun a2 order as
collectrun _ _ [] = ([], [])
collectrun last order (a:as)
| order == compare last a =
let (more,rest) = collectrun a order as
in (a:more, rest)
| otherwise = ([], a:as)
More exercises. What if we build the list of comparisons just once, for use in grouping?
import Data.List
ordruns3 [] = []
ordruns3 [a] = [[a]]
ordruns3 xs = unfoldr collectrun marked
where
pairOrder = zipWith compare xs (tail xs)
marked = zip (head pairOrder : pairOrder) xs
collectrun [] = Nothing
collectrun ((o,x):xs) = Just (x:map snd markedgroup, rest)
where (markedgroup, rest) = span ((o==).fst) xs
And then there's the part where there's a groupBy :: (a -> a -> Bool) -> [a] -> [[a]] but no groupOn :: Eq b => (a -> b) -> [a] -> [[a]]. We can use a wrapper type to handle that.
import Data.List
data Grouped t = Grouped Ordering t
instance Eq (Grouped t) where
(Grouped o1 _) == (Grouped o2 _) = o1 == o2
ordruns4 [] = []
ordruns4 [a] = [[a]]
ordruns4 xs = unmarked
where
pairOrder = zipWith compare xs (tail xs)
marked = group $ zipWith Grouped (head pairOrder : pairOrder) xs
unmarked = map (map (\(Grouped _ t) -> t)) marked
Of course, the wrapper type's test can be converted into a function to use groupBy instead:
import Data.List
ordruns5 [] = []
ordruns5 [a] = [[a]]
ordruns5 xs = map (map snd) marked
where
pairOrder = zipWith compare xs (tail xs)
marked = groupBy (\a b -> fst a == fst b) $
zip (head pairOrder : pairOrder) xs
These marking versions arrive at the same decoration concept Jonas Duregård applied.
I'm trying to write some code in Haskell and there is problem that i can't solve
f 0 = []
f n = do
x <- [0..4]
y <- x:(f (n-1))
return y
The output is:
[0,0,0,1,2,3,4,1,0,1,2,3,4,2,0,1,2,3,4,3,0,1,2,3,4,4,0,1,2,3,4,1,0,0,1,2,3,4,1,0,1,2,3,4,2,0,1,2,3,4,3,0,1,2,3,4,4,0,1,2,3,4,2,0,0,1,2,3,4,1,0,1,2,3,4,2,0,1,2,3,4,3,0,1,2,3,4,4,0,1,2,3,4,3,0,0,1,2,3,4,1,0,1,2,3,4,2,0,1,2,3,4,3,0,1,2,3,4,4,0,1,2,3,4,4,0,0,1,2,3,4,1,0,1,2,3,4,2,0,1,2,3,4,3,0,1,2,3,4,4,0,1,2,3,4]
but I need it to be:
[[0,0,0],[0,0,1],[0,0,2],[0,0,3],[0,0,4],[0,1,0],[0,1,1]...
Any ideas?
Others have already answered, but you may wish to know there's already a function like yours in the standard library:
> import Control.Monad
> replicateM 3 [0..4]
[[0,0,0],[0,0,1],[0,0,2],[0,0,3],[0,0,4],[0,1,0],[0,1,1], ...
So you want the elements of your final list to be lists themselves ?
In the List monad, each <- remove one enclosing from the type, in other words :
(x :: a) <- (xs :: [a])
So it is clear that x :: Int in your code. And you wish for your function to return [[Int]] so what should be the type of x:(f (n-1)) ? You see that this expression shouldn't typecheck if f type was correct so there is your problem : you don't want to cons x to the result of f (n-1) but to each of the results of f (n-1) thus :
f n = do
x <- [0..4]
xs <- f (n-1)
return (x : xs)
If you try this you should see it doesn't work, this is because your f 0 should contain one possibility :
f 0 = return [] -- or [[]]
Let's desugar first:
f 0 = []
f n = [0 .. 4] >>= \x -> x : (f (n - 1)) >>= \y -> return y
Note
xs >>= f = concat (map f xs)
[0..4] >>= \x -> x : (f (n - 1)) will simply return [0..4] when n is 1. However, it need to be [[0], [1], [2], [3], [4]],
Thus, the following will do:
f 0 = [[]]
f n = [0 .. 4] >>= \x -> map (x:) (f (n - 1)) >>= \y -> return y
cross = do
x <- [0..4]
y <- [0..4]
z <- [0..4]
return [x,y,z]
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 want to filter a string with a string.
What I want is to use delete every first occurring char.
myFunc :: String -> String -> String
Like:
myFunc "dddog" "bigdddddog" = "biddg"
In "dddog": 3x d, 1x o, 1x g
In the second string it removed 3x d, 1x o and 1x g
So the output: biddg
I can't use filter for it, because it will delete all occurring chars.
And I struggled a long time with it.
Thanks in advance:)
How about
Prelude> :m +Data.List
Prelude Data.List> "bigdddddog" \\ "dddog"
"biddg"
Not the nicest solution, but you can understand easier what's going on:
myfunc :: String -> String -> String
myfunc [] xs = xs
myfunc (x:xs) ys = myfunc xs $ remove x ys
where
remove _ [] = []
remove x (y:ys) = if x == y then ys else y : remove x ys
As you commented, you want to use guards. Do you mean this?
myfunc :: String -> String -> String
myfunc [] xs = xs
myfunc (x:xs) ys = myfunc xs $ remove x ys
remove :: Char -> String -> String
remove _ [] = []
remove x (y:ys)
| x == y = ys
| otherwise = y : remove x ys
some of the other solutions don't seem to produce the same result you posted. I think I have a simple solution that does what you asked for but I may be misunderstanding what you want. All I do in the following code is go though the list and apply 'delete' to every element in the list. It's not exactly efficient but it gets the job done.
import Data.List
myFunc (x:xs) ys = myFunc xs (delete x ys)
myFunc [] ys = ys
There are perhaps more efficient solutions like storing the "to remove" list in a tree with the number of occurences stored as the value then traversing the main list testing to see if the count at that key was still greater than zero. I think that would give you O(n*lg(m)) (where n is the size of the list to be removed from and m is the size of the "to remove" list) rather than O(n*m) as is the case above. This version could also be maid to be lazy I think.
edit:
Here is the tree version I was talking abut using Data.Map. It's a bit complex but should be more efficient for large lists and it is somewhat lazy
myFunc l ys = myFunc' (makeCount l) ys
where makeCount xs = foldr increment (Map.fromList []) xs
increment x a = Map.insertWith (+) x 1 a
decrement x a = Map.insertWith (flip (-)) x 1 a
getCount x a = case Map.lookup x a of
Just c -> c
Nothing -> 0
myFunc' counts (x:xs) = if (getCount x counts) > 0
then myFunc' (decrement x counts) xs
else x : myFunc' counts xs
myFunc' _ [] = []
I am not quite sure about how you want your function to behave, how about this?
import Data.List (isPrefixOf)
myFunc :: String -> String -> String
myFunc _ [] = []
myFunc y x'#(x:xs) | y `isPrefixOf` x' = drop (length y) x'
| otherwise = x : myFilter xs y
This gives the following output in GHCi:
> myFunc "dddog" "bigdddddog"
> "bigdd"
If this is not what you had in mind, please give another input/output example.
I like kaan's elegant solution. In case you meant this...here's one where the "ddd" would only be removed if matched as a whole:
import Data.List (group,isPrefixOf,delete)
f needles str = g (group needles) str where
g needles [] = []
g needles xxs#(x:xs)
| null needle' = [x] ++ g needles xs
| otherwise = let needle = head needle'
in g (delete needle needles) (drop (length needle) xxs)
where needle' = dropWhile (not . flip isPrefixOf xxs) needles
Output:
*Main> f "dddog" "bigdddddog"
"biddg"
*Main> f "dddog" "bdigdogd"
"bdidgd"
No monadic solution yet, there you go:
import Control.Monad.State
myFunc :: String -> State String String
myFunc [] = return ""
myFunc (x:xs) = get >>= f where
f [] = return (x:xs)
f (y:ys) = if y == x then put ys >> myFunc xs
else myFunc xs >>= return . (x:)
main = do
let (a,b) = runState (myFunc "bigdddddog") "dddog" in
putStr a
Using predefined functions from Data.List,
-- mapAccumL :: (acc -> x -> (acc, y)) -> acc -> [x] -> (acc, [y])
-- lookup :: (Eq a) => a -> [(a, b)] -> Maybe b
{-# LANGUAGE PatternGuards #-}
import Data.List
picks [] = [] -- http://stackoverflow.com/a/9889702/849891
picks (x:xs) = (x,xs) : [ (y,x:ys) | (y,ys) <- picks xs]
myFunc a b = concat . snd $ mapAccumL f (picks a) b
where
f acc x | Just r <- lookup x acc = (picks r,[])
f acc x = (acc,[x])
Testing:
Prelude Data.List> myFunc "dddog" "bigdddddog"
"biddg"
edit: this is of course a bit more complex than (\\). I'll let it stand as an illustration. There could be some merit to it still, as it doesn't copy the 2nd (longer?) string over and over, for each non-matching character from the 1st (shorter) string, as delete apparently does, used in (\\) = foldl (flip delete).
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]