; 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))))))