This question already has answers here:
Generating integers in ascending order using a set of prime numbers
(4 answers)
Closed 4 years ago.
I am trying to generate a list of all multiples which can be represented by the form , where a, b, and c are whole numbers. I tried the following,
[ a * b * c | a <- map (2^) [0..], b <- map (3^) [0..], c <- map (5^) [0..] ]
but it only lists powers of 5 and never goes on to 2 or 3.
Edit: My apologies, it seems that I did not clarify the question enough. What I want is an ordered infinite list, and while I could sort a finite list, I feel as if there may be a solution that is more efficient.
The reason why there are only powers of 5 is that Haskell tries to evaluate every possible c for a = 2^0 and b = 3^0 and only when it is finished it goes for a = 2^0 and b = 3^1.
So this way you can only construct a finite list like this:
[ a * b * c | a <- map (2^) [0..n], b <- map (3^) [0..n], c <- map (5^) [0..n] ]
for a given n.
My first idea was starting from lists of powers of 2, 3 and 5, respectively:
p2 = iterate (2 *) 1
p3 = iterate (3 *) 1
p5 = iterate (5 *) 1
It's also easy to merge two sorted streams:
fuse [] ys = ys
fuse xs [] = xs
fuse xs#(x : xs') ys#(y : ys')
| x <= y = x : fuse xs' ys
| otherwise = y : fuse xs ys'
But then I got stuck because fuse p2 (fuse p3 p5) doesn't do anything useful. It only produces multiples of 2, or 3, or 5, never mixing factors.
I couldn't figure out a purely generative solution, so I added a bit of filtering in the form of a set accumulator. The algorithm (which is quite imperative) is:
Initialize the accumulator to {1}.
Find and remove the smallest element from the accumulator; call it n.
Emit n.
Add {2n, 3n, 5n} to the accumulator.
Go to #2 if you need more elements.
The accumulator is a set because this easily lets me find and extract the smallest element (I'm using it as a priority queue, basically). It also handles duplicates that arise from e.g. computing both 2 * 3 and 3 * 2.
Haskell implementation:
import qualified Data.Set as S
numbers :: [Integer]
numbers = go (S.singleton 1)
where
go acc = case S.deleteFindMin acc of
(n, ns) -> n : go (ns `S.union` S.fromDistinctAscList (map (n *) [2, 3, 5]))
This works, but there are things I don't like about it:
For every element we emit (n : ...), we add up to three new elements to the accumulator (ns `S.union` ... [2, 3, 5]). ("Up to three" because some of them may be duplicates that will be filtered out.)
That means numbers carries around a steadily growing data structure; the more elements we consume from numbers, the bigger the accumulator grows.
In that sense it's not a pure "streaming" algorithm. Even if we ignore the steadily growing numbers themselves, we need more memory and perform more computation the deeper we get into the sequence.
From your code:
[ a * b * c | a <- map (2^) [0..], b <- map (3^) [0..], c <- map (5^) [0..] ]
Since map (5^) [0..] is an infinite list, upon first iterations of a and b, it iterates over the said infinite list, which won't halt. That's why it is stuck at powers of 5.
Here is a solution apart from arithmetics. Note that map (2^) [0..], map (3^) [0..], and map (5^) [0..] are all lists sorted in ascending order. That means the usual merge operation is applicable:
merge [] ys = ys
merge xs [] = xs
merge (x:xs) (y:ys) = if x <= y then x : merge xs (y:ys) else y : merge (x:xs) ys
For convenience, let xs = map (2^) [0..]; let ys = map (3^) [0..]; let zs = map (5^) [0..].
To get multiples of 2 and 3, consider the following organization of said numbers:
1, 2, 4, 8, 16, ...
3, 6, 12, 24, 48, ...
9, 18, 36, 72, 144, ...
...
Judging by this, you might hope the following works:
let xys = foldr (merge . flip fmap xs . (*)) [] ys
But this doesn't work, because from the organization above, merge doesn't know which row contains the resulting head element, infinitely leaving it unevaluated. We know that the upper row contains said head element, so with following little tweak, it finally works:
let xys = foldr ((\(m:ms) ns -> m : merge ms ns) . flip fmap xs . (*)) [] ys
Do the same against zs, and here comes the desired list:
let xyzs = foldr ((\(m:ms) ns -> m : merge ms ns) . flip fmap xys . (*)) [] zs
Full code in summary:
merge [] ys = ys
merge xs [] = xs
merge (x:xs) (y:ys) = if x <= y then x : merge xs (y:ys) else y : merge (x:xs) ys
xyzs = let
xs = map (2^) [0..]
ys = map (3^) [0..]
zs = map (5^) [0..]
xys = foldr ((\(m:ms) ns -> m : merge ms ns) . flip fmap xs . (*)) [] ys
in foldr ((\(m:ms) ns -> m : merge ms ns) . flip fmap xys . (*)) [] zs
but it only lists powers of 5 and never goes on to 2 or 3.
Addressing only this bit.
To calculate numbers 2^a*3^0b*5^c you tried generating the triples (a,b,c), but got stuck producing those of the form (0,0,c). Which is why your numbers are all of the form 2^0*3^0*5^c, i.e. only powers of 5.
It's easier if you start with pairs. To produce all pairs (a,b) you can work along the diagonals of the form,
a+b = k
for each positivek. Each diagonal is easy to define,
diagonal k = [(k-x,x) | x <- [0..k]]
So to produce all pairs you'd just generate all diagonals for k<-[1..]. You want triples (a,b,c) though, but it's similar, just work along the planes,
a+b+c = k
To generate such planes just work along their diagonals,
triagonal k = [(k-x,b,c) | x <- [0..k], (b,c) <- diagonal x]
And there you go. Now just generate all 'triagonals' to get all possible triples,
triples = [triagonal k | k <- [0..]]
The other way to look at it is you wanted the numbers which are only divisible by 2,3 or 5. So check if each number starting from 1 satisfies this condition. If yes it is part of the list.
someList = [x| x<- [1..], isIncluded x]
where isIncluded is the function which decides whether x satisfies the above condition. To do this isIncluded divides the number first by 2 till it can not be divided any further by 2. Then same it does with new divided number for 3 and 5. It at ends there is 1 then we know this number is only divisible by 2,3 or 5 and nothing else.
This may not be the fastest way but still the simplest way.
isIncluded :: Int -> Bool
isIncluded n = if (powRemainder n 2 == 1) then True
else let q = powRemainder n 2
in if (powRemainder q 3 == 1) then True
else let p = powRemainder q 3
in if (powRemainder p 5 == 1) then True else False;
powRemainder is the function which takes number and base and returns the number which can not be further divided by base.
powRemainder :: Int -> Int -> Int
powRemainder 1 b = 1
powRemainder n b = if (n `mod` b) == 0 then powRemainder (n `div` b) b else n
with this when I run take 20 someList it returns [1,2,3,4,5,6,8,9,10,12,15,16,18,20,24,25,27,30,32,36].
As others already commented, your core does not work because it is analogous to the following imperative pseudocode:
for x in 0..infinity:
for y in 0..infinity:
for z in 0..infinity:
print (2^x * 3^y * 5^x)
The innermost for takes infinite time to execute, so the other two loops will never get past their first iteration. Consequently, x and y are both stuck to value 0.
This is a classic dovetailing problem: if we insist on trying all the values of z before taking the next y (or x), we get stuck on a subset of the intended outputs. We need a more "fair" way to choose the values of x,y,z so that we do not get stuck in such way: such techniques are known as "dovetailing".
Others have shown some dovetailing techniques. Here, I'll only mention the control-monad-omega package, which implements an easy to use dovetailing monad. The resulting code is very similar to the one posted in the OP.
import Control.Monad.Omega
powersOf235 :: [Integer]
powersOf235 = runOmega $ do
x <- each [0..]
y <- each [0..]
z <- each [0..]
return $ 2^x * 3^y * 5^z
I've a question regarding list comprehensions in Haskell.
I have an exam later this week and therefore did some old exams where I found this question:
"Write a function that given a positive integer n returns a list of positive integers m ≤ n such that there are two positive integers x and y, such that x^2 + y^3 = m. The list needs to be sorted"
There were two possible answers,
either
squareCube::Int->[Int]
squareCube n =[a|a<-[1..n],x<-[1..n],y<-[1..n],x^2+y^3==a]
or
import Data.List
squareCube::Int->[Int]
squareCube n =
sort [a|x<-[1..n],y<-[1..n],a<-[1..n],x^2+y^3==a]
I wonder why I need to use the sort function when a comes after x and y in my comprehension. Why does the order between the arguments matter?
This list is sorted:
[ 1, 1, 1
, 2, 2, 2
, 3, 3, 3
, 4, 4, 4 ]
This one isn't:
[ 1, 2, 3, 4
, 1, 2, 3, 4
, 1, 2, 3, 4 ]
This is only vaguely related to the question: it addresses the programming challenge, but does not answer the question as asked about why the existing approaches work. But it was too fun to avoid writing a snippet about it, so here goes.
With appropriate imports, you can very efficiently generate even the infinite list of square-cube sums. The basic idea is to make an infinite list of infinite lists; we will maintain the invariant that the outer infinite list is sorted by the heads of the inner infinite lists. Then it's easy and efficient to merge all of these. With the appropriate package it's a one-liner, and very succinctly matches the problem description:
import Data.List.Ordered
squareCubes = unionAll [[x^2+y^3 | x <- [1..]] | y <- [1..]]
We can compare the efficiency of this to the existing two approaches. Here's the test program, which I compiled with -O2:
import Data.List
import Data.List.Ordered
import System.Environment
squareCubes = unionAll [[x^2+y^3 | x <- [1..]] | y <- [1..]]
squareCube n = takeWhile (<=n) squareCubes
squareCube' n = [a|a<-[1..n],x<-[1..n],y<-[1..n],x^2+y^3==a]
squareCube'' n = sort [a|x<-[1..n],y<-[1..n],a<-[1..n],x^2+y^3==a]
main = do
[kind, limit] <- getArgs
let f = case kind of
"inf" -> squareCube
"unsorted" -> squareCube'
"sorted" -> squareCube''
print . sum . f . read $ limit
And here are the timings, which are quite stark indeed:
% /usr/bin/time ./test unsorted 700
57465
9.60user 0.01system 0:09.63elapsed 99%CPU (0avgtext+0avgdata 4156maxresident)k
% /usr/bin/time ./test sorted 700
57465
1.87user 0.00system 0:01.87elapsed 99%CPU (0avgtext+0avgdata 4056maxresident)k
% /usr/bin/time ./test inf 700
50895
0.00user 0.00system 0:00.00elapsed 100%CPU (0avgtext+0avgdata 3616maxresident)k
The others take seconds (aeons in computer time) while the one that's in some ways more capable than the others doesn't even register on the timer! I also experimented to find how large of an input we could give before arriving at the timings for the other two implementations. I found that an input of 500000000 takes 8.88 seconds -- almost six orders of magnitude higher in the roughly the same time.
Wait, wait, you say: those outputs are different. So what gives? Well, it turns out that the slow implementations have what I consider to be a bug: they will spit out a single number multiple times if there are multiple ways to construct it as the sum of squares and cubes. For example,
> squareCube' 17
[2,5,9,10,12,17,17]
> squareCube 17
[2,5,9,10,12,17]
because 3^2 + 2^3 = 4^2 + 1^3. On the other hand, if this is the intended behavior, one can easily achieve it in the efficient, lazy one-liner by replacing unionAll with mergeAll.
We need a sort function when a comes after x and y in the comprehension because of the order of evaluation. If a <- [1..] is called first, each of the subsequent statements will be evaluated against each a in turn, so the a's already form an increasing list:
a = 1
x <- [1..n]
y <- [1..n]
...return a if there's a valid match
a = 2
x <- [1..n]
y <- [1..n]
...return a if there's a valid match
etc.
However, if a <- [1..n] is evaluated last, we may not get an ordered sequence of as:
x = 1
y <- [1..n]
...
y = 1
a <- [1..n]
...
a = 2 2
y = 2
a <- [1..n]
...
a = 9 9
x = 2
y <- [1..n]
...
y = 1
a <- [1..n]
...
a = 5 5
To see clearly what's going on with list comprehensions, try
do { print [ (x,[10..13]) | x <- [1,2]]
; print [ [(x,y) | y <- [10..13]] | x <- [1,2]]
; print [ r | x <- [1,2], r <- [(x,y) | y <- [10..13]]]
; print [ (x,y) | x <- [1,2], y <- [10..13] ]
}
=>
[ (1,[10,11,12,13]), (2,[10,11,12,13]) ]
[[(1,10),(1,11),(1,12),(1,13)], [(2,10),(2,11),(2,12),(2,13)]]
[ (1,10),(1,11),(1,12),(1,13), (2,10),(2,11),(2,12),(2,13) ]
[ (1,10),(1,11),(1,12),(1,13), (2,10),(2,11),(2,12),(2,13) ]
On the other hand,
do { print [ ([1,2],y) | y <- [10..13] ]
; print [ (x,y) | y <- [10..13], x <- [1,2] ]
}
=>
[ ([1,2],10), ([1,2],11), ([1,2],12), ([1,2],13) ]
[ (1,10),(2,10), (1,11),(2,11), (1,12),(2,12), (1,13),(2,13) ]
List comprehensions work in the nested fashion.
You could re-write your first code as
map (\(a,_,_) -> a) $
filter (\(a,x,y) -> x^2+y^3==a) $
liftA3 (,,) [1..n] [1..n] [1..n] -- (1)
and the second as
map (\(_,_,a) -> a) $
filter (\(x,y,a) -> x^2+y^3==a) $
liftA3 (,,) [1..n] [1..n] [1..n] -- (2)
You could be tempted to see (1) and (2) as a very general "all combinations of three elements drawn from same list" thing. But Haskell is a deterministic language. It produces the same results for the same inputs. Thus it imposes a certain order on the resulting list.
And this is what it means when we say that list comprehensions work in a nested fashion — the leftmost list's element changes the slowest, and the rightmost's the fastest, in the resulting combination — like in an odometer.
To solve your problem, you could write
sort [a | x2 <- takeWhile (<= n) [x^2 | x <- [1..]]
, a <- takeWhile (<= n) [x2+y^3 | y <- [1..]] ]
but this requires careful thought, the code doesn't express the original intent as clearly, and isn't still as optimal as the one using Data.List.Ordered.mergeAll (from data-ordlist package) as seen in the answer by Daniel Wagner,
takeWhile (<= n) . mergeAll $ [[x^2+y^3 | x <- [1..]] | y <- [1..]]
although both have the same time complexity, more or less. mergeAll merges the ordered non-decreasing lists it is presented with, by using pairwise merges arranged in a tree slanted to the right.
Come to think of it, we too could write the more natural-looking
sort . concat . map (takeWhile (<= n))
$ [[x^2+y^3 | x <- [1..n]] | y <- [1..n]]
This doesn't work with the infinite list of lists. To fix this, we could write
-- sort . concat . takeWhile (not . null) . map (takeWhile (<= n))
sort . concat . map (takeWhile (<= n)) . takeWhile ((<= n).head)
$ [[x^2+y^3 | x <- [1..]] | y <- [1..]]
In Haskell, it is quite often better not to try too hard to figure it all out ourselves, but leave it to the lazy evaluation to take care of things. Here it didn't quite worked unfortunately, and we had to take special care to be able to deal with infinite list1, with those explicit takeWhiles superfluous to the task's logic.
Indeed it is true, for any n, that
under n (union a b) == nub . sort $ under n a ++ under n b
under n . unionAll . take m == under n . foldl union [] . take m
under n . unionAll == nub . sort . concat
. takeWhile (not.null) . map (under n)
and
under n (merge a b) == sort $ under n a ++ under n b
under n . mergeAll . take m == under n . foldl merge [] . take m
under n . mergeAll == sort . concat
. takeWhile (not.null) . map (under n)
using under n = takeWhile (<= n), with ordered increasing lists.
1Data.List.Ordered.mergeAll takes care of the infinite lists all by itself, and is better in the sense that it is on-line - it starts producing its output much earlier than our tortured constructed function. The point wasn't that the library function isn't needed, but just to see what can be done without it.
I have a fairly basic question, about comparing with infinite lists. The problem is similar to this:
25 `elem` [x^2 | x <- [1..]]
obviously this is true.
However, how do I deal with values that are not int the list, like
26 `elem` [x^2 | x <- [1..]]
Because it's an infinite list, Haskell doesn't have an answer for this, although it seems kinda obvious, that once we are past 6^2 we can't reach 26 anymore, so I want to stop there.
Now I could limit the x like:
[x^2 | x <- [1..6]]
Easy.
But what I do in examples like that:
[prod | k <- [1..], let prod = product [1..k]]
and I want to check if my number is in that list? Or what is an alternative way to get the result of this calculation?
The data-ordlist package has many utility functions for dealing with sorted lists, including member:
Data.List.Ordered> 25 `member` [n^2 | n <- [1..]]
True
Data.List.Ordered> 26 `member` [n^2 | n <- [1..]]
False
Data.List.Ordered> 24 `member` [product [1..k] | k <- [1..]]
True
Data.List.Ordered> 25 `member` [product [1..k] | k <- [1..]]
False
If your list is in increasing order, you can find an element that’s at least what you’re looking for and check separately whether it’s the same:
> let elemIncreasing x l = find (>= x) l == Just x
> let factorials = scanl1 (*) [1..]
> 120 `elemIncreasing` factorials
True
> 121 `elemIncreasing` factorials
False
Suppose that we have some order < and we know that for the lists we are interested in we have a
sortedElem _ _ [] = False
sortedElem (<) y (x:xs) | y == x = True
| x < y = False
| True = sortedElem (<) y xs
And you could define special cases e.g.
elemIncreasing = sortedElem (<)
elemDecreasing = sortedElem (>)
I’m on my phone so I’ve not tested this. It should work in principle but the compiler may have a few issues. I’m sure they can be fixed.