Smallest Consecutive Four-Factor Composites

September 17, 2013

There are two ways to solve this problem. One is to factor each number starting from 2, count the number of distinct prime factors, and stop when you find the desired set (the acronym fff stands for “first four factor”):

(define (factors n)
  (let ((wheel (vector 1 2 2 4 2 4 2 4 6 2 6)))
    (let loop ((n n) (f 2) (w 0) (fs (list)))
      (cond ((< n (* f f))
              (reverse (if (< 1 n) (cons n fs) fs)))
            ((zero? (modulo n f))
              (loop (/ n f) f w (cons f fs)))
            (else (loop n (+ f (vector-ref wheel w))
                        (if (< w 10) (+ w 1) 0) fs)))))))

(define (count n) (length (unique = (factors n))))

(define (fff1)
  (let loop ((n 5) (c1 1) (c2 1) (c3 1))
    (let ((c (count n)))
      (if (= 4 c c1 c2 c3) (- n 3)
        (loop (+ n 1) c c1 c2)))))

> (time (fff1))
(time (fff1))
    63 collections
    1389 ms elapsed cpu time, including 220 ms collecting
    1388 ms elapsed real time, including 208 ms collecting
    531500752 bytes allocated, including 539500144 bytes reclaimed
134043

A better approach uses sieving. Instead of starting with each sieve item #t and changing it to #f when it is a multiple of a prime, start with each sieve item 0 and add 1 each time a prime multiple hits that element of the sieve, then look for four adjacent 4-counts:

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

> (time (fff2 135000))
(time (fff2 135000))
    1 collection
    62 ms elapsed cpu time, including 0 ms collecting
    56 ms elapsed real time, including 3 ms collecting
    3495248 bytes allocated, including 10278656 bytes reclaimed
134043

That’s a twenty-fold improvement. Of course, I was able to minimize sieving time because I already knew the answer. In practice, it would take a little bit longer because I would start with a small n and work my way up; start with 10000, say, and proceed by a sequence of doublings: 20000, 40000, 80000, 160000, bingo!

We used unique from the Standard Prelude. You can run the program at http://programmingpraxis.codepad.org/ZVI08RRU.

About these ads

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[1]);
        }
        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

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

Follow

Get every new post delivered to your Inbox.

Join 635 other followers

%d bloggers like this: