Fun with guile, Erastones + goldbach conjecture

[Stefan Israelsson Tampe]

Hi all,

The program below is an interesting variant of a sieve that given an
even number seams to constructs two primes that added together becomes 
the even 
number, the file below does this construction for n = 3 ... 1000.

Have fun!

/Stefan


(use-modules (srfi srfi-1))

(define (analyze k)
  (define n (* k 2))
  (define l (apply circular-list (map (lambda (X) #f) (iota n))))
  (define (shift l k)
    (let loop ((l l) (k k))
      (if (= k 0) 
          l
          (loop (cdr l) (- k 1)))))

  (define (next loop)
    (let lp ((ll l) (i 0))
      (if (= i n)
          l
          (if (car ll)
              (lp (cdr ll) (+ i 1))
              (loop i l 0)))))
          
  (define (M)
    (let lp ((l l) (k n) (M -1))
      (if (= k 0)
          M
          (let ((c (caar l)))
            (if (< M c)
                (lp (cdr l) (- k 1) c)
                (lp (cdr l) (- k 1) M))))))

  (define (place x)
    (let loop ((ll l) (i 0))
      (if (equal? (car ll) x)
          i
          (loop (cdr ll) (+ i 1)))))
      
  (set-car! (cdr l) (cons 1 0))
  (set-car! (shift l (- n 1)) (cons 1 0))
  (let loop ((m 2) (ll l) (k 0))
    (let ((ll (shift ll m)))
      (if (and (pair? (car ll)) (eq? (caar ll) m))
          (next loop)
          (begin
            (unless (car ll) (set-car! ll (cons m k)) (set! k (+ k 1)))
            (loop m ll k)))))

  (let* ((M   (M))
         (ll  (let lp ((ll l) (k n))
                (if (= k 0)
                    '()
                    (cons (car ll) (lp (cdr ll) (- k 1))))))
         (ll  (fold (lambda (k r)(if (eq? (car k) M) (cons k r) r)) '() ll))
         (ll  (sort ll (lambda (x y) (< (cdr x) (cdr y))))))

    (cond 
     ((= (length ll) 1)
      (* (place (car ll)) 2))
     (else
      (+ (place (car ll)) (place (car (last-pair ll))))))))
   
(let lp ((i 3))
  (if (= i 1000)
      (pk 'ok)
      (begin
        (if (not (= (* 2 i) (analyze i)))
            (format #t "~a != (analyze ~a) == ~a~%" (* 2 i) (* 2 i) 
                    (analyze (* 2i))))
        (lp (+ i 1)))))

goldbach.scm
Description: Text Data