Scheme solution for Project-Euler problem 50

problem-50.scm

;; The prime 41, can be written as the sum of six consecutive primes: 41
;; = 2 + 3 + 5 + 7 + 11 + 13
;;
;; This is the longest sum of consecutive primes that adds to a prime
;; below one-hundred.
;;
;; The longest sum of consecutive primes below one-thousand that adds to
;; a prime, contains 21 terms, and is equal to 953.
;;
;; Which prime, below one-million, can be written as the sum of the most
;; consecutive primes?
(define (is-prime? number)
  (let ((max (sqrt number)))
    (let loop ((i 2))
      (if (<= i max) (if (eq? (modulo number i) 0) #f (loop (+ i 1))) #t))))

(define (next-prime from)
  (let loop ((i from))
    (if (is-prime? i) i (loop (+ i 2)))))

(define (prev-prime from)
  (let loop ((i from))
    (if (is-prime? i) i (loop (- i 2)))))

(define (problem-50)
  ;; First find largest sum of primes below million
  (let prime-summer ((i 3)(sum 2)(last-prime 2))
    (if (< (+ sum i) 1000000)
        (if (is-prime? i)
            (prime-summer (+ i 2) (+ sum i) i)
            (prime-summer (+ i 2) sum last-prime))
        ;; Make binary tree search kind of algorithm for finding the
        ;; prime with longest sequence using depth-first search
        ;; Stop immediately after we find largest prime.
        (let max-prime ((c (list sum 2 last-prime))(nodes '()))
          (if (is-prime? (car c))
              c
              (if (null? nodes)
                  (max-prime (list (- (car c) (cadr c)) (next-prime (cadr c)) (caddr c))
                             (list (list (- (car c) (caddr c)) (cadr c) (prev-prime (caddr c)))))
                  (max-prime (car nodes)
                             (append
                                     (list
                                      (list (- (car c) (cadr c)) (next-prime (cadr c)) (caddr c)) ;; Left branch
                                      (list (- (car c) (caddr c)) (cadr c) (prev-prime (caddr c)))) ;; Right branch
                                     (cdr nodes)))))))))