## Smallest Consecutive Four-Factor Composites

### September 17, 2013

I found this problem on a discussion board for beginning programmers. It feels like a Project Euler problem, but I looked and didn’t find it there:

The smallest pair of consecutive natural numbers that each have two distinct prime factors are 14 = 2 * 7 and 15 = 3 * 5. The smallest triplet of consecutive natural numbers that each have three distinct prime factors are 644 = 2^2 * 7 * 23, 645 = 3 * 5 * 43 and 646 = 2 * 17 * 19. What is the smallest set of four consecutive natural numbers that each have four distinct prime factors?

Your task is to write a program that finds the set of four natural numbers. When you are finished, you are welcome to read or run a suggested solution, or to post your own solution or discuss the exercise in the comments below.

Pages: 1 2

### 8 Responses to “Smallest Consecutive Four-Factor Composites”

1. mvaneerde said

Now try finding the smallest run of three consecutive numbers with exactly one prime factor. ;-)

```use strict;

unless (@ARGV == 3) {
print "perl -w four-factor.pl max target-primes target-consecutive\n";
exit(0);
}

my (\$max, \$target_primes, \$target_consecutive) = @ARGV;

my @u = (0, 0); # 0 and 1 each have no unique prime factors

my \$start = 1;
my \$consecutive = 0;
my \$found = 0;
for (my \$i = 1; \$i = 2 and not \$u[\$i]) {
# i is prime; increment u[k] for k = all multiples of i
for (my \$k = \$i; \$k <= \$max; \$k += \$i) {
\$u[\$k]++;
}
}

if (\$u[\$i] == \$target_primes) {
\$consecutive++;

if (\$target_consecutive == \$consecutive) {
print \$start, " through ", \$i, " each have ", \$target_primes, " unique prime ", ((\$target_primes == 1) ? "factor" : "factors"), ".\n";
\$found = 1;
last;
}
} else {
\$start = \$i + 1;
\$consecutive = 0;
}
}

unless (\$found) {
print "Did not find any run of \$target_consecutive numbers <= \$max with \$target_primes unique prime ", ((\$target_primes == 1) ? "factor" : "factors"), ".\n";
}
```
2. mvaneerde said

Well, that didn’t quite work. Let’s try that again.

```use strict;

unless (@ARGV == 3) {
print "perl -w four-factor.pl max target-primes target-consecutive\n";
exit(0);
}

my (\$max, \$target_primes, \$target_consecutive) = @ARGV;

my @u = (0, 0); # 0 and 1 each have no unique prime factors

my \$start = 1;
my \$consecutive = 0;
my \$found = 0;
for (my \$i = 1; \$i <= \$max; \$i++) {
if (\$i >= 2 and not \$u[\$i]) {
# i is prime; increment u[k] for k = all multiples of i
for (my \$k = \$i; \$k <= \$max; \$k += \$i) {
\$u[\$k]++;
}
}

if (\$u[\$i] == \$target_primes) {
\$consecutive++;

if (\$target_consecutive == \$consecutive) {
print \$start, " through ", \$i, " each have ", \$target_primes, " unique prime ", ((\$target_primes == 1) ? "factor" : "factors"), ".\n";
\$found = 1;
last;
}
} else {
\$start = \$i + 1;
\$consecutive = 0;
}
}

unless (\$found) {
print "Did not find any run of \$target_consecutive numbers <= \$max with \$target_primes unique prime ", ((\$target_primes == 1) ? "factor" : "factors"), ".\n";
}
```
3. Paul said

A version in Python. The generator fac_gen generates pairs (i, number of distinct factors of i) and is in principle unlimited, as long as it fits in memory. It works up to n=5.

```from collections import defaultdict
from itertools import count

def fac_gen():
""" generates (i, number of distinct factors for i)
(limited by memory)
"""
facs = defaultdict(list)
for f in count(2):
if f not in facs: # a prime
yield (f, 1)
facs[2 * f].append(f)
else:
factors = facs[f]
yield (f, len(factors))
for p in factors:
facs[f + p].append(p)
del facs[f]

def find_conseq(n_target):
factors = fac_gen()
counts = 0
for i, n in factors:
if n == n_target:
counts += 1
if counts == n_target:
return i - n_target + 1
else:
counts = 0

print find_conseq(4) # 134043 (0.24 sec)
print find_conseq(5) # 129963314 (407 sec)
print find_conseq(6) # memory error
```
4. Jamie Hope said

A minor optimization to the posted fff2 which, instead of always incrementing the search loop by 1, skips ahead by up to 4 places based upon the values seen so far (inspired by KMP string search):

```(define (fff3 n)
(let ((sieve (make-vector n 0)))
(do ((p 2 (+ p 1))) ((<= n p))
(when (= 0 (vector-ref sieve p))
(do ((i p (+ i p))) ((<= n i))
(vector-set! sieve i (+ (vector-ref sieve i) 1)))))
(let ((n-3 (- n 3)))
(let loop ((i 4))
(if (> i n-3) "failed"
(if (= 4 (vector-ref sieve (+ i 3)))
(if (= 4 (vector-ref sieve (+ i 2)))
(if (= 4 (vector-ref sieve (+ i 1)))
(if (= 4 (vector-ref sieve i))
i
(loop (+ i 1)))
(loop (+ i 2)))
(loop (+ i 3)))
(loop (+ i 4))))))))
```

Under Kawa on my laptop, I see results like

Execution of (fff1) took 1995.53 ms
134043
Execution of (fff2 135000) took 87.817 ms
134043
Execution of (fff3 135000) took 66.956 ms
134043

5. Jamie Hope said

Oops, that should be (let ((n-4 (- n 4))) … (if (> i n-4) …)) otherwise there can be an index out of bounds error.

I decided to see what kind of improvement there would be adding type info and using a primitive int array rather than a vector — this is still with Kawa — and it turns out to be quite substantial (another factor of 10):

```(define (fff4 (n ::int))
(let ((sieve ::int[] (int[] length: n)))
(do ((p ::int 2 (+ p 1))) ((<= n p))
(when (= 0 (sieve p))
(do ((i ::int p (+ i p))) ((<= n i))
(set! (sieve i) (+ (sieve i) 1)))))
(let ((n-4 ::int (- n 4)))
(let loop ((i ::int 4))
(if (> i n-4) "failed"
(if (= 4 (sieve (+ i 3)))
(if (= 4 (sieve (+ i 2)))
(if (= 4 (sieve (+ i 1)))
(if (= 4 (sieve i))
i
(loop (+ i 1)))
(loop (+ i 2)))
(loop (+ i 3)))
(loop (+ i 4))))))))
```

Execution of (fff4 135000) took 6.586 ms
134043

6. Graham said

A version of `fff2` in C++11, making use of my library that (sort of) implements Haskell’s `Maybe`:

```#include <iostream>
#include <vector>
#include "maybe.h"

using namespace maybe;

auto fff2(uintmax_t upper_bound) ->  Maybe<uintmax_t> {
auto sieve = std::vector<uintmax_t>(upper_bound);
// sieve
for (uintmax_t p = 2; p < upper_bound; ++p) {
if (!sieve[p]) {
for (uintmax_t i = p; i < upper_bound; i += p) {
sieve[i] += 1;
}
}
}
// search
for (uintmax_t i = 4; i < upper_bound; ++i) {
if (sieve[i - 3] == 4 && sieve[i - 2] == 4 &&
sieve[i - 1] == 4 && sieve[i] == 4) {
return Just(i - 3);
}
}
return Nothing();
}

auto main(int argc, char *argv[]) -> int {
auto upper_bound = uintmax_t(10000);
if (argc > 1) {
upper_bound = std::stol(argv);
}
std::cout << fff2(upper_bound) << std::endl;
}
```
7. JP said

Straightforward Racket version:

```(define (n-consecutive-with-m-factors n m)
(let loop ([i 1] [count 0])
(cond
[(= count n)
(map (λ (n) (list n (factorize n)))
(range (- i n) i))]
[(= (unique-factors-of i) m)
(loop (+ i 1) (+ count 1))]
[else
(loop (+ i 1) 0)])))
```

I also did a sieved version and one for n consecutive numbers with m total distinct prime factors (since that’s how I originally read the problem :) on my blog: jverkamp.com: Smallest Consecutive Four-Factor Composites