codepad

Language:

; google treasure hunt 2008 puzzle 4

(define (primes n)
  (let* ((max-index (quotient (- n 3) 2))
         (v (make-vector (+ 1 max-index) #t)))
    (let loop ((i 0) (primes '(2)))
      (cond ((< max-index i) (reverse primes))
            ((vector-ref v i)
              (let ((prime (+ i i 3)))
                (do ((j (+ 3 (* 3 i)) (+ j prime)))
                    ((< max-index j))
                  (vector-set! v j #f))
              (loop (+ 1 i) (cons prime primes))))
            (else (loop (+ 1 i) primes))))))

(define (take n xs)
  (let loop ((n n) (xs xs) (ys '()))
    (if (or (zero? n) (null? xs))
        (reverse ys)
        (loop (- n 1) (cdr xs)
              (cons (car xs) ys)))))

(define (drop n xs)
  (let loop ((n n) (xs xs))
    (if (or (zero? n) (null? xs)) xs
      (loop (- n 1) (cdr xs)))))

(define (sum xs) (apply + xs))

(define big-primes (primes #e1e7))

(define max-prime (car (reverse big-primes)))

(define (sums n)
  (let loop ((ps (take n big-primes))
             (rest (drop n big-primes))
             (s (sum (take n big-primes)))
             (ss '()))
    (if (< max-prime s) (reverse ss)
      (loop (append (cdr ps) (list (car rest)))
            (cdr rest)
            (+ s (car rest) (- (car ps)))
            (cons s ss)))))

(define sum7 (sums 7))
(define sum17 (sums 17))
(define sum41 (sums 41))
(define sum541 (sums 541))

(define (intersect xs ys)
  (cond ((or (null? xs) (null? ys)) '())
        ((< (car xs) (car ys)) (intersect (cdr xs) ys))
        ((< (car ys) (car xs)) (intersect xs (cdr ys)))
        (else (cons (car xs) (intersect (cdr xs) (cdr ys))))))

(display (car (intersect sum7
                (intersect sum17
                  (intersect sum41
                    (intersect sum541 big-primes))))))

Private [?]

Run code