Generating all combinations of 6 Xs with 3 Qs in Haskell - haskell

I am trying to generate a list of all strings that consist of 6 Xs and 3 Qs.
A subset of the list I am trying to generate is as follows:
["XXXXXXQQQ", "XQXXQXXQX", "QXQXQXXXX",...
What is a good way to go about this?

Here is a dynamic programming solution using Data.Array. mem just stores memoized values.
import Data.Array
strings :: Int -> Int -> [String]
strings n m = strings' n m
where
mem :: Array (Int,Int) [String]
mem = array ((0,0),(n,m)) [ ((i,j), strings' i j) | i <- [0..n], j <- [0..m] ]
strings' 0 m = [replicate m 'X']
strings' n 0 = [replicate n 'Q']
strings' n m = (('Q':) <$> mem ! (n-1,m)) ++ (('X':) <$> mem ! (n,m-1))

The naive solution is to recursively choose one of X or Q until we run out of choices to make. This is especially convenient when using the list monad to model the nondeterministic choice, and leads to quite short code:
stringsNondet m 0 = [replicate m 'X']
stringsNondet 0 n = [replicate n 'Q']
stringsNondet m n = do
(char, m', n') <- [('X', m-1, n), ('Q', m, n-1)]
rest <- stringsNondet m' n'
return (char:rest)
The disadvantage of this approach is that it does a lot of extra work. If we choose an X and then choose a Q, the continuations are the same as if we had chosen a Q and then an X, but these continuations will be recomputed in the above. (And similarly for other choice paths that lead to shared continuations.)
Alec has posted a dynamic programming solution which solves this problem by introducing a recursively-defined array to share the subcomputations. I like this solution, but the recursive definition is a bit mind-bending. The following solution is also a dynamic programming solution -- subcomputations are also shared -- but uses no hand-written recursion. It does make use of standard recursive patterns (map, zip, iterate, ++, and !!) but notably does not require "tying the knot" as Alec's solution does.
As a warmup, let's discuss the type of the function of interest to us:
step :: [[String]] -> [[String]]
The final result of interest to us is [String], a collection of strings with a fixed number m of 'X's and a fixed number n of 'Q's. The step function will expect a collection of results, all of the same length, and will assume that the result at index m has m copies of 'X'. It will also produce a result with these properties, and where each result is one longer than the input results.
We implement step by producing two intermediate [[String]]s, one with an extra 'X' compared to the input results and one with an extra 'Q'. These two intermediates can then be zipped together with a little "stutter" to represent the slight difference in 'X' count between them. Thus:
step css = zipWith (++)
([[]] ++ map (map ('X':)) css)
(map (map ('Q':)) css ++ [[]])
The top-level function is now easy to write: we simply index into the iterated version of step by the length of the final string we want, then index into the list of results we get that way by the number of 'X's we want.
strings m n = iterate step [[[]]] !! (m+n) !! m
A bonus of this approach is the single, aesthetically pleasing base case of [[[]]].

Use permutations and nub functions from Data.List:
Prelude Data.List> nub $ permutations "XXXXXXQQQ"
["XXXXXXQQQ","QXXXXXXQQ","XQXXXXXQQ","XXQXXXXQQ","XXXQXXXQQ","XXXXQXXQQ","XXXXXQXQQ","QQXXXXXXQ","QXQXXXXXQ","QXXQXXXXQ","QXXXQXXXQ","QXXXXQXXQ","QXXXXXQXQ","XQQXXXXXQ","XQXQXXXXQ","XQXXQXXXQ","XQXXXQXXQ","XQXXXXQXQ","XXQQXXXXQ","XXQXQXXXQ","XXQXXQXXQ","XXQXXXQXQ","XXXQQXXXQ","XXXQXQXXQ","XXXQXXQXQ","XXXXQQXXQ","XXXXQXQXQ","XXXXXQQXQ","QQQXXXXXX","QQXQXXXXX","QQXXQXXXX","QQXXXQXXX","QQXXXXQXX","QQXXXXXQX","QXQQXXXXX","XQQQXXXXX","XQQXQXXXX","XQQXXQXXX","XQQXXXQXX","XQQXXXXQX","QXQXQXXXX","QXQXXQXXX","QXQXXXQXX","QXQXXXXQX","QXXQQXXXX","XQXQQXXXX","XXQQQXXXX","XXQQXQXXX","XXQQXXQXX","XXQQXXXQX","XQXQXQXXX","XQXQXXQXX","XQXQXXXQX","QXXQXQXXX","QXXQXXQXX","QXXQXXXQX","QXXXQQXXX","XQXXQQXXX","XXQXQQXXX","XXXQQQXXX","XXXQQXQXX","XXXQQXXQX","XXQXQXQXX","XXQXQXXQX","XQXXQXQXX","XQXXQXXQX","QXXXQXQXX","QXXXQXXQX","QXXXXQQXX","XQXXXQQXX","XXQXXQQXX","XXXQXQQXX","XXXXQQQXX","XXXXQQXQX","XXXQXQXQX","XQXXXQXQX","QXXXXQXQX","XXQXXQXQX","QXXXXXQQX","XQXXXXQQX","XXQXXXQQX","XXXQXXQQX","XXXXQXQQX","XXXXXQQQX"]
We can have a faster implementation as well:
insertAtEvery x [] = [[x]]
insertAtEvery x (y:ys) = (x:y:ys) : map (y:) (insertAtEvery x ys)
combinations [] = [[]]
combinations (x:xs) = nub . concatMap (insertAtEvery x) . combinations $ xs
Comparison with the previous solution in ghci:
Prelude Data.List> (sort . nub . permutations $ "XXXXXXQQQ") == (sort . combinations $ "XXXXXXQQQ")
True
Prelude Data.List> :set +s
Prelude Data.List> combinations "XXXXXXQQQ"
["XXXXXXQQQ","XXXXXQXQQ","XXXXXQQXQ","XXXXXQQQX","XXXXQXXQQ","XXXXQXQXQ","XXXXQXQQX","XXXXQQXXQ","XXXXQQXQX","XXXXQQQXX","XXXQXXXQQ","XXXQXXQXQ","XXXQXXQQX","XXXQXQXXQ","XXXQXQXQX","XXXQXQQXX","XXXQQXXXQ","XXXQQXXQX","XXXQQXQXX","XXXQQQXXX","XXQXXXXQQ","XXQXXXQXQ","XXQXXXQQX","XXQXXQXXQ","XXQXXQXQX","XXQXXQQXX","XXQXQXXXQ","XXQXQXXQX","XXQXQXQXX","XXQXQQXXX","XXQQXXXXQ","XXQQXXXQX","XXQQXXQXX","XXQQXQXXX","XXQQQXXXX","XQXXXXXQQ","XQXXXXQXQ","XQXXXXQQX","XQXXXQXXQ","XQXXXQXQX","XQXXXQQXX","XQXXQXXXQ","XQXXQXXQX","XQXXQXQXX","XQXXQQXXX","XQXQXXXXQ","XQXQXXXQX","XQXQXXQXX","XQXQXQXXX","XQXQQXXXX","XQQXXXXXQ","XQQXXXXQX","XQQXXXQXX","XQQXXQXXX","XQQXQXXXX","XQQQXXXXX","QXXXXXXQQ","QXXXXXQXQ","QXXXXXQQX","QXXXXQXXQ","QXXXXQXQX","QXXXXQQXX","QXXXQXXXQ","QXXXQXXQX","QXXXQXQXX","QXXXQQXXX","QXXQXXXXQ","QXXQXXXQX","QXXQXXQXX","QXXQXQXXX","QXXQQXXXX","QXQXXXXXQ","QXQXXXXQX","QXQXXXQXX","QXQXXQXXX","QXQXQXXXX","QXQQXXXXX","QQXXXXXXQ","QQXXXXXQX","QQXXXXQXX","QQXXXQXXX","QQXXQXXXX","QQXQXXXXX","QQQXXXXXX"]
(0.01 secs, 3,135,792 bytes)
Prelude Data.List> nub $ permutations "XXXXXXQQQ"
["XXXXXXQQQ","QXXXXXXQQ","XQXXXXXQQ","XXQXXXXQQ","XXXQXXXQQ","XXXXQXXQQ","XXXXXQXQQ","QQXXXXXXQ","QXQXXXXXQ","QXXQXXXXQ","QXXXQXXXQ","QXXXXQXXQ","QXXXXXQXQ","XQQXXXXXQ","XQXQXXXXQ","XQXXQXXXQ","XQXXXQXXQ","XQXXXXQXQ","XXQQXXXXQ","XXQXQXXXQ","XXQXXQXXQ","XXQXXXQXQ","XXXQQXXXQ","XXXQXQXXQ","XXXQXXQXQ","XXXXQQXXQ","XXXXQXQXQ","XXXXXQQXQ","QQQXXXXXX","QQXQXXXXX","QQXXQXXXX","QQXXXQXXX","QQXXXXQXX","QQXXXXXQX","QXQQXXXXX","XQQQXXXXX","XQQXQXXXX","XQQXXQXXX","XQQXXXQXX","XQQXXXXQX","QXQXQXXXX","QXQXXQXXX","QXQXXXQXX","QXQXXXXQX","QXXQQXXXX","XQXQQXXXX","XXQQQXXXX","XXQQXQXXX","XXQQXXQXX","XXQQXXXQX","XQXQXQXXX","XQXQXXQXX","XQXQXXXQX","QXXQXQXXX","QXXQXXQXX","QXXQXXXQX","QXXXQQXXX","XQXXQQXXX","XXQXQQXXX","XXXQQQXXX","XXXQQXQXX","XXXQQXXQX","XXQXQXQXX","XXQXQXXQX","XQXXQXQXX","XQXXQXXQX","QXXXQXQXX","QXXXQXXQX","QXXXXQQXX","XQXXXQQXX","XXQXXQQXX","XXXQXQQXX","XXXXQQQXX","XXXXQQXQX","XXXQXQXQX","XQXXXQXQX","QXXXXQXQX","XXQXXQXQX","QXXXXXQQX","XQXXXXQQX","XXQXXXQQX","XXXQXXQQX","XXXXQXQQX","XXXXXQQQX"]
(0.71 secs, 161,726,128 bytes)

Related

How to efficiently generate all lists of length `n^2` containing `n` copies of every `x < n`?

Given an integer n, how can I build the list containing all lists of length n^2 containing exactly n copies of each integer x < n? For example, for n = 2, we have:
[0,0,1,1], [0,1,0,1], [1,0,0,1], [0,1,1,0], [1,0,1,0], [1,1,0,0]
This can be easily done combining permutations and nub:
f :: Int -> [[Int]]
f n = nub . permutations $ concatMap (replicate n) [0..n-1]
But that is way too inefficient. Is there any simple way to encode the efficient/direct algorithm?
Sure, it's not too hard. We'll start with a list of n copies of each number less than n, and repeatedly choose one to start our result with. First, a function for choosing an element from a list:
zippers :: [a] -> [([a], a, [a])]
zippers = go [] where
go l (h:r) = (l,h,r) : go (h:l) r
go _ [] = []
Now we'll write a function that produces all possible interleavings of some input lists. Internally we'll maintain the invariant that each [a] is non-empty; hence we'll have to establish that invariant before we start recursing. In fact, this will be wasted work in the way we intend to call this function, but for good abstraction we might as well handle all inputs correctly, right?
interleavings :: [[a]] -> [[a]]
interleavings = go . filter (not . null) where
go [] = [[]]
go xss = do
(xssl, x:xs, xssr) <- zippers xss
(x:) <$> interleavings ([xs | not (null xs)] ++ xssl ++ xssr)
And now we're basically done. All we have to do is feed in an appropriate starting list.
f :: Int -> [[Int]]
f n = interleavings (replicate n <$> [1..n])
Try it in ghci:
> f 2
[[1,1,2,2],[1,2,2,1],[1,2,1,2],[2,2,1,1],[2,1,1,2],[2,1,2,1]]

Long working of program that count Ints

I want to write program that takes array of Ints and length and returns array that consist in position i all elements, that equals i, for example
[0,0,0,1,3,5,3,2,2,4,4,4] 6 -> [[0,0,0],[1],[2,2],[3,3],[4,4,4],[5]]
[0,0,4] 7 -> [[0,0],[],[],[],[4],[],[]]
[] 3 -> [[],[],[]]
[2,2] 3 -> [[],[],[2,2]]
So, that's my solution
import Data.List
import Data.Function
f :: [Int] -> Int -> [[Int]]
f ls len = g 0 ls' [] where
ls' = group . sort $ ls
g :: Int -> [[Int]] -> [[Int]] -> [[Int]]
g val [] accum
| len == val = accum
| otherwise = g (val+1) [] (accum ++ [[]])
g val (x:xs) accum
| len == val = accum
| val == head x = g (val+1) xs (accum ++ [x])
| otherwise = g (val+1) (x:xs) (accum ++ [[]])
But query f [] 1000000 works really long, why?
I see we're accumulating over some data structure. I think foldMap. I ask "Which Monoid"? It's some kind of lists of accumulations. Like this
newtype Bunch x = Bunch {bunch :: [x]}
instance Semigroup x => Monoid (Bunch x) where
mempty = Bunch []
mappend (Bunch xss) (Bunch yss) = Bunch (glom xss yss) where
glom [] yss = yss
glom xss [] = xss
glom (xs : xss) (ys : yss) = (xs <> ys) : glom xss yss
Our underlying elements have some associative operator <>, and we can thus apply that operator pointwise to a pair of lists, just like zipWith does, except that when we run out of one of the lists, we don't truncate, rather we just take the other. Note that Bunch is a name I'm introducing for purposes of this answer, but it's not that unusual a thing to want. I'm sure I've used it before and will again.
If we can translate
0 -> Bunch [[0]] -- single 0 in place 0
1 -> Bunch [[],[1]] -- single 1 in place 1
2 -> Bunch [[],[],[2]] -- single 2 in place 2
3 -> Bunch [[],[],[],[3]] -- single 3 in place 3
...
and foldMap across the input, then we'll get the right number of each in each place. There should be no need for an upper bound on the numbers in the input to get a sensible output, as long as you are willing to interpret [] as "the rest is silence". Otherwise, like Procrustes, you can pad or chop to the length you need.
Note, by the way, that when mappend's first argument comes from our translation, we do a bunch of ([]++) operations, a.k.a. ids, then a single ([i]++), a.k.a. (i:), so if foldMap is right-nested (which it is for lists), then we will always be doing cheap operations at the left end of our lists.
Now, as the question works with lists, we might want to introduce the Bunch structure only when it's useful. That's what Control.Newtype is for. We just need to tell it about Bunch.
instance Newtype (Bunch x) [x] where
pack = Bunch
unpack = bunch
And then it's
groupInts :: [Int] -> [[Int]]
groupInts = ala' Bunch foldMap (basis !!) where
basis = ala' Bunch foldMap id [iterate ([]:) [], [[[i]] | i <- [0..]]]
What? Well, without going to town on what ala' is in general, its impact here is as follows:
ala' Bunch foldMap f = bunch . foldMap (Bunch . f)
meaning that, although f is a function to lists, we accumulate as if f were a function to Bunches: the role of ala' is to insert the correct pack and unpack operations to make that just happen.
We need (basis !!) :: Int -> [[Int]] to be our translation. Hence basis :: [[[Int]]] is the list of images of our translation, computed on demand at most once each (i.e., the translation, memoized).
For this basis, observe that we need these two infinite lists
[ [] [ [[0]]
, [[]] , [[1]]
, [[],[]] , [[2]]
, [[],[],[]] , [[3]]
... ...
combined Bunchwise. As both lists have the same length (infinity), I could also have written
basis = zipWith (++) (iterate ([]:) []) [[[i]] | i <- [0..]]
but I thought it was worth observing that this also is an example of Bunch structure.
Of course, it's very nice when something like accumArray hands you exactly the sort of accumulation you need, neatly packaging a bunch of grungy behind-the-scenes mutation. But the general recipe for an accumulation is to think "What's the Monoid?" and "What do I do with each element?". That's what foldMap asks you.
The (++) operator copies the left-hand list. For this reason, adding to the beginning of a list is quite fast, but adding to the end of a list is very slow.
In summary, avoid adding things to the end of a list. Try to always add to the beginning instead. One simple way to do that is to build the list backwards, and then reverse it at the end. A more devious trick is to use "difference lists" (Google it). Another possibility is to use Data.Sequence rather than a list.
The first thing that should be noted is the most obvious way to implement this is use a data structure that allows random access, an array is an obviously choice. Note that you need to add the elements to the array multiple times and somehow "join them".
accumArray is perfect for this.
So we get:
f l i = elems $ accumArray (\l e -> e:l) [] (0,i-1) (map (\e -> (e,e)) l)
And we're good to go (see full code here).
This approach does involve converting the final array back into a list, but that step is very likely faster than say sorting the list, which often involves scanning the list at least a few times for a list of decent size.
Whenever you use ++ you have to recreate the entire list, since lists are immutable.
A simple solution would be to use :, but that builds a reversed list. However that can be fixed using reverse, which results in only building two lists (instead of 1 million in your case).
Your concept of glomming things onto an accumulator is a very useful one, and both MathematicalOrchid and Guvante show how you can use that concept reasonably efficiently. But in this case, there is a simpler approach that is likely also faster. You started with
group . sort $ ls
and this was a very good place to start! You get a list that's almost the one you want, except that you need to fill in some blanks. How can we figure those out? The simplest way, though probably not quite the most efficient, is to work with a list of all the numbers you want to count up to: [0 .. len-1].
So we start with
f ls len = g [0 .. len-1] (group . sort $ ls)
where
?
How do we define g? By pattern matching!
f ls len = g [0 .. len-1] (group . sort $ ls)
where
-- We may or may not have some lists left,
-- but we counted as high as we decided we
-- would
g [] _ = []
-- We have no lists left, so the rest of the
-- numbers are not represented
g ns [] = map (const []) ns
-- This shouldn't be possible, because group
-- doesn't make empty lists.
g _ ([]:_) = error "group isn't working!"
-- Finally, we have some work to do!
g (n:ns) xls#(xl#(x:_):xls')
| n == x = xl : g ns xls'
| otherwise = [] : g ns xls
That was nice, but making the list of numbers isn't free, so you might be wondering how you can optimize it. One method I invite you to try is using your original technique of keeping a separate counter, but following this same sort of structure.

Dovetail iteration over infinite lists in Haskell

I want to iterate 2 (or 3) infinite lists and find the "smallest" pair that satisfies a condition, like so:
until pred [(a,b,c) | a<-as, b<-bs, c<-cs]
where pred (a,b,c) = a*a + b*b == c*c
as = [1..]
bs = [1..]
cs = [1..]
The above wouldn't get very far, as a == b == 1 throughout the run of the program.
Is there a nice way to dovetail the problem, e.g. build the infinite sequence [(1,1,1),(1,2,1),(2,1,1),(2,1,2),(2,2,1),(2,2,2),(2,2,3),(2,3,2),..] ?
Bonus: is it possible to generalize to n-tuples?
There's a monad for that, Omega.
Prelude> let as = each [1..]
Prelude> let x = liftA3 (,,) as as as
Prelude> let x' = mfilter (\(a,b,c) -> a*a + b*b == c*c) x
Prelude> take 10 $ runOmega x'
[(3,4,5),(4,3,5),(6,8,10),(8,6,10),(5,12,13),(12,5,13),(9,12,15),(12,9,15),(8,15,17),(15,8,17)]
Using it's applicative features, you can generalize to arbitrary tuples:
quadrupels = (,,,) <$> as <*> as <*> as <*> as -- or call it liftA4
But: this alone does not eliminate duplication, of course. It only gives you proper diagonalization. Maybe you could use monad comprehensions together with an approach like Thomas's, or just another mfilter pass (restricting to b /= c, in this case).
List comprehensions are great (and concise) ways to solve such problems. First, you know you want all combinations of (a,b,c) that might satisfy a^2 + b^2 = c^2 - a helpful observation is that (considering only positive numbers) it will always be the case that a <= c && b <= c.
To generate our list of candidates we can thus say c ranges from 1 to infinity while a and b range from one to c.
[(a,b,c) | c <- [1..], a <- [1..c], b <- [1..c]]
To get to the solution we just need to add your desired equation as a guard:
[(a,b,c) | c <- [1..], a <- [1..c], b <- [1..c], a*a+b*b == c*c]
This is inefficient, but the output is correct:
[(3,4,5),(4,3,5),(6,8,10),(8,6,10),(5,12,13),(12,5,13),(9,12,15)...
There are more principled methods than blind testing that can solve this problem.
{- It depends on what is "smallest". But here is a solution for a concept of "smallest" if tuples were compared first by their max. number and then by their total sum. (You can just copy and paste my whole answer into a file as I write the text in comments.)
We will need nub later. -}
import Data.List (nub)
{- Just for illustration: the easy case with 2-tuples. -}
-- all the two-tuples where 'snd' is 'n'
tuples n = [(i, n) | i <- [1..n]]
-- all the two-tuples where 'snd' is in '1..n'
tuplesUpTo n = concat [tuples i | i <- [1..n]]
{-
To get all results, you will need to insert the flip of each tuple into the stream. But let's do that later and generalize first.
Building tuples of arbitrary length is somewhat difficult, so we will work on lists. I call them 'kList's, if they have a length 'k'.
-}
-- just copied from the tuples case, only we need a base case for k=1 and
-- we can combine all results utilizing the list monad.
kLists 1 n = [[n]]
kLists k n = do
rest <- kLists (k-1) n
add <- [1..head rest]
return (add:rest)
-- same as above. all the klists with length k and max number of n
kListsUpTo k n = concat [kLists k i | i <- [1..n]]
-- we can do that unbounded as well, creating an infinite list.
kListsInf k = concat [kLists k i | i <- [1..]]
{-
The next step is rotating these lists around, because until now the largest number is always in the last place. So we just look at all rotations to get all the results. Using nub here is admittedly awkward, you can improve that. But without it, lists where all elements are the same are repeated k times.
-}
rotate n l = let (init, end) = splitAt n l
in end ++ init
rotations k l = nub [rotate i l | i <- [0..k-1]]
rotatedKListsInf k = concatMap (rotations k) $ kListsInf k
{- What remains is to convert these lists into tuples. This is a bit awkward, because every n-tuple is a separate type. But it's straightforward, of course. -}
kListToTuple2 [x,y] = (x,y)
kListToTuple3 [x,y,z] = (x,y,z)
kListToTuple4 [x,y,z,t] = (x,y,z,t)
kListToTuple5 [x,y,z,t,u] = (x,y,z,t,u)
kListToTuple6 [x,y,z,t,u,v] = (x,y,z,t,u,v)
{- Some tests:
*Main> take 30 . map kListToTuple2 $ rotatedKListsInf 2
[(1,1),(1,2),(2,1),(2,2),(1,3),(3,1),(2,3),(3,2),(3,3),(1,4),(4,1),(2,4),(4,2),(3,4),
(4,3),(4,4),(1,5),(5,1),(2,5),(5,2),(3,5),(5,3),(4,5),(5,4),(5,5),(1,6),(6,1),
(2,6), (6,2), (3,6)]
*Main> take 30 . map kListToTuple3 $ rotatedKListsInf 3
[(1,1,1),(1,1,2),(1,2,1),(2,1,1),(1,2,2),(2,2,1),(2,1,2),(2,2,2),(1,1,3),(1,3,1),
(3,1,1),(1,2,3),(2,3,1),(3,1,2),(2,2,3),(2,3,2),(3,2,2),(1,3,3),(3,3,1),(3,1,3),
(2,3,3),(3,3,2),(3,2,3),(3,3,3),(1,1,4),(1,4,1),(4,1,1),(1,2,4),(2,4,1),(4,1,2)]
Edit:
I realized there is a bug: Just rotating the ordered lists isn't enough of course. The solution must be somewhere along the lines of having
rest <- concat . map (rotations (k-1)) $ kLists (k-1) n
in kLists, but then some issues with repeated outputs arise. You can figure that out, I guess. ;-)
-}
It really depends on what you mean by "smallest", but I assume you want to find a tuple of numbers with respect to its maximal element - so (2,2) is less than (1,3) (while standard Haskell ordering is lexicographic).
There is package data-ordlist, which is aimed precisely at working with ordered lists. It's function mergeAll (and mergeAllBy) allows you to combine a 2-dimensional matrix ordered in each direction into an ordered list.
First let's create a desired comparing function on tuples:
import Data.List (find)
import Data.List.Ordered
compare2 :: (Ord a) => (a, a) -> (a, a) -> Ordering
compare2 x y = compare (max2 x, x) (max2 y, y)
where
max2 :: Ord a => (a, a) -> a
max2 (x, y) = max x y
Then using mergeAll we create a function that takes a comparator, a combining function (which must be monotonic in both arguments) and two sorted lists. It combines all possible elements from the two lists using the function and produces a result sorted list:
mergeWith :: (b -> b -> Ordering) -> (a -> a -> b) -> [a] -> [a] -> [b]
mergeWith cmp f xs ys = mergeAllBy cmp $ map (\x -> map (f x) xs) ys
With this function, it's very simple to produce tuples ordered according to their maximum:
incPairs :: [(Int,Int)]
incPairs = mergeWith compare2 (,) [1..] [1..]
Its first 10 elements are:
> take 10 incPairs
[(1,1),(1,2),(2,1),(2,2),(1,3),(2,3),(3,1),(3,2),(3,3),(1,4)]
and when we (for example) look for the first pair whose sum of squares is equal to 65:
find (\(x,y) -> x^2+y^2 == 65) incPairs
we get the correct result (4,7) (as opposed to (1,8) if lexicographic ordering were used).
This answer is for a more general problem for a unknown predicate. If the predicate is known, more efficient solutions are possible, like others have listed solutions based on knowledge that you don't need to iterate for all Ints for a given c.
When dealing with infinite lists, you need to perform breadth-first search for solution. The list comprehension only affords depth-first search, that is why you never arrive at a solution in your original code.
counters 0 xs = [[]]
counters n xs = concat $ foldr f [] gens where
gens = [[x:t | t <- counters (n-1) xs] | x <- xs]
f ys n = cat ys ([]:n)
cat (y:ys) (x:xs) = (y:x): cat ys xs
cat [] xs = xs
cat xs [] = [xs]
main = print $ take 10 $ filter p $ counters 3 [1..] where
p [a,b,c] = a*a + b*b == c*c
counters generates all possible counters for values from the specified range of digits, including a infinite range.
First, we obtain a list of generators of valid combinations of counters - for each permitted digit, combine it with all permitted combinations for counters of smaller size. This may result in a generator that produces a infinite number of combinations. So, we need to borrow from each generator evenly.
So gens is a list of generators. Think of this as a list of all counters starting with one digit: gens !! 0 is a list of all counters starting with 1, gens !! 1 is a list of all counters starting with 2, etc.
In order to borrow from each generator evenly, we could transpose the list of generators - that way we would get a list of first elements of the generators, followed by a list of second elements of the generators, etc.
Since the list of generators may be infinite, we cannot afford to transpose the list of generators, because we may never get to look at the second element of any generator (for a infinite number of digits we'd have a infinite number of generators). So, we enumerate the elements from the generators "diagonally" - take first element from the first generator; then take the second element from the first generator and the first from the second generator; then take the third element from the first generator, the second from the second, and the first element from the third generator, etc. This can be done by folding the list of generators with a function f, which zips together two lists - one list is the generator, the other is the already-zipped generators -, the beginning of one of them being offset by one step by adding []: to the head. This is almost zipWith (:) ys ([]:n) - the difference is that if n or ys is shorter than the other one, we don't drop the remainder of the other list. Note that folding with zipWith (:) ys n would be a transpose.
For this answer I will take "smallest" to refer to the sum of the numbers in the tuple.
To list all possible pairs in order, you can first list all of the pairs with a sum of 2, then all pairs with a sum of 3 and so on. In code
pairsWithSum n = [(i, n-i) | i <- [1..n-1]]
xs = concatMap pairsWithSum [2..]
Haskell doesn't have facilities for dealing with n-tuples without using Template Haskell, so to generalize this you will have to switch to lists.
ntuplesWithSum 1 s = [[s]]
ntuplesWithSum n s = concatMap (\i -> map (i:) (ntuplesWithSum (n-1) (s-i))) [1..s-n+1]
nums n = concatMap (ntuplesWithSum n) [n..]
Here's another solution, with probably another slightly different idea of "smallest". My order is just "all tuples with max element N come before all tuples with max element N+1". I wrote the versions for pairs and triples:
gen2_step :: Int -> [(Int, Int)]
gen2_step s = [(x, y) | x <- [1..s], y <- [1..s], (x == s || y == s)]
gen2 :: Int -> [(Int, Int)]
gen2 n = concatMap gen2_step [1..n]
gen2inf :: [(Int, Int)]
gen2inf = concatMap gen2_step [1..]
gen3_step :: Int -> [(Int, Int, Int)]
gen3_step s = [(x, y, z) | x <- [1..s], y <- [1..s], z <- [1..s], (x == s || y == s || z == s)]
gen3 :: Int -> [(Int, Int, Int)]
gen3 n = concatMap gen3_step [1..n]
gen3inf :: [(Int, Int, Int)]
gen3inf = concatMap gen3_step [1..]
You can't really generalize it to N-tuples, though as long as you stay homogeneous, you may be able to generalize it if you use arrays. But I don't want to tie my brain into that knot.
I think this is the simplest solution if "smallest" is defined as x+y+z because after you find your first solution in the space of Integral valued pythagorean triangles, your next solutions from the infinite list are bigger.
take 1 [(x,y,z) | y <- [1..], x <- [1..y], z <- [1..x], z*z + x*x == y*y]
-> [(4,5,3)]
It has the nice property that it returns each symmetrically unique solution only once. x and z are also infinite, because y is infinite.
This does not work, because the sequence for x never finishes, and thus you never get a value for y, not to mention z. The rightmost generator is the innermost loop.
take 1 [(z,y,x)|z <- [1..],y <- [1..],x <- [1..],x*x + y*y == z*z]
Sry, it's quite a while since I did haskell, so I'm going to describe it with words.
As I pointed out in my comment. It is not possible to find the smallest anything in an infinite list, since there could always be a smaller one.
What you can do is, have a stream based approach that takes the lists and returns a list with only 'valid' elements, i. e. where the condition is met. Lets call this function triangle
You can then compute the triangle list to some extent with take n (triangle ...) and from this n elements you can find the minium.

How to select every n-th element from a list [duplicate]

This question already has answers here:
Closed 11 years ago.
Possible Duplicate:
How to get every Nth element of an infinite list in Haskell?
Simple task - we have a list and want to leave only each nth element in that list.
What is the most idiomatic way to do it in haskell?
off the top of my head it is something like:
dr n [] = []
dr n (x : xs) = x : (dr n $ drop n xs)
but I have a strong feeling that I'm overcomplicating the problem.
My variant would be:
each :: Int -> [a] -> [a]
each n = map head . takeWhile (not . null) . iterate (drop n)
Fast and plays well with laziness.
Your solution is fine, but here are three other solutions using functions from Haskell's base library.
dr1 m = concatMap (take 1) . iterate (drop m)
Of coarse, this will never terminate (because iterate never terminates). So perhaps a better solution would be to use unfoldr:
{-# LANGUAGE TupleSections #-}
import Data.Maybe
dr2 m = unfoldr ((\x-> fmap (,drop m x) (listToMaybe x)))
The function you pass to an unfold can get a bit ugly if you don't know GHC extensions and concepts such as functors, here's that solution again without the fancy foot-work (untested):
dr2 m = unfoldr ((\x -> case listToMaybe x of
Nothing -> Nothing
Just i -> Just (i,drop m x)))
If you don't like unfolds then consider a zip and a filter:
dr3 m = map snd . filter ((== 1) . fst) . zip (cycle [1..m])
Review
Understand all these solutions are slightly different. Learning why will make you a better Haskell progammer. dr1 uses iterate and will thus never terminate (perhaps this is ok for infinite lists, but probably not a good overall solution):
> dr1 99 [1..400]
[1,100,199,298,397^CInterrupted.
The dr2 solution will show every mth value by skipping values in the unfold. The unfold passes both the value to be used for the next unfolding and the result of the current unfolding in a single tuple.
> dr2 99 [1..400]
[1,100,199,298,397]
The dr3 solution is slightly longer but probably easier for a beginner to understand. First you tag every element in the list with a cycle of [1..n, 1..n, 1..n ...]. Second, you select only the numbers tagged with a 1, effectively skipping n-1 of the elements. Third you remove the tags.
> dr3 99 [1..400]
[1,100,199,298,397]
Lots of ways to shave this yak! Here's yet another:
import Data.List.Split -- from the "split" package on Hackage
dr n = map head . chunk n
Try this:
getEach :: Int -> [a] -> [a]
getEach _ [] = []
getEach n list
| n < 1 = []
| otherwise = foldr (\i acc -> list !! (i - 1):acc) [] [n, (2 * n)..(length list)]
Then in GHC:
*Main> getEach 2 [1..10]
[10,8,6,4,2]

Can you create more than one element of a list at a time with a list comprehension in haskell?

So, for example, say I had a list of numbers and I wanted to create a list that contained each number multiplied by 2 and 3. Is there any way to do something like the following, but get back a single list of numbers instead of a list of lists of numbers?
mult_nums = [ [(n*2),(n*3)] | n <- [1..5]]
-- this returns [[2,3],[4,6],[6,9],[8,12],[10,15]]
-- but we want [2,3,4,6,6,9,8,12,10,15]
I find that extending the list comprehension makes this easier to read:
[ m | n <- [1..5], m <- [2*n,3*n] ]
It might be helpful to examine exactly what this does, and how it relates to other solutions. Let's define it as a function:
mult lst = [ m | n <- lst, m <- [2*n,3*n] ]
After a fashion, this desugars to
mult' lst =
concatMap (\n -> concatMap (\m -> [m]) [2*n,3*n]) lst
The expression concatMap (\m -> [m]) is wrapping m up in a list in order to immediately flatten it—it is equivalent to map id.
Compare this to #FunctorSalad's answer:
mult1 lst = concatMap (\n -> [n*2,n*3]) lst
We've optimized away concatMap (\m -> [m]).
Now #vili's answer:
mult2 lst = concat [ [(n*2),(n*3)] | n <- lst]
This desugars to:
mult2' lst = concat (concatMap (\n -> [[2*n,3*n]]) lst)
As in the first solution above, we are unnecessarily creating a list of lists that we have to concat away.
I don't think there is a solution that uses list comprehensions, but desugars to mult1. My intuition is that Haskell compilers are generally clever enough that this wouldn't matter (or, alternatively, that unnecessary concats are cheap due to lazy evaluation (whereas they're lethal in eager languages)).
you could use concat.
concat [ [(n*2),(n*3)] | n <- [1..5]]
output: [2,3,4,6,6,9,8,12,10,15]
In some similar cases concatMap can also be convenient, though here it doesn't change much:
concatMap (\n -> [n*2,n*3]) [1..5]

Resources