How do you find the list of all numbers that are multiples of only powers of 2, 3, and 5?

1.8k views Asked by At

I am trying to generate a list of all multiples which can be represented by the form 2^a*3^b*5^c, 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.

6

There are 6 answers

2
KacperFKorban On

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.

3
Manoj R On

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].

3
Jorge Adriano Branco Aires On

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..]]
0
chi On

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
1
melpomene On

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:

  1. Initialize the accumulator to {1}.
  2. Find and remove the smallest element from the accumulator; call it n.
  3. Emit n.
  4. Add {2n, 3n, 5n} to the accumulator.
  5. 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.
3
Dannyu NDos On

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