[plt-scheme] Comprehension: An example with five nested loops and four guards

David Einstein skrev:
> Does this give the set with the lowest sum?

Yes.

> Also, where is ec.ss?

Sorry I sent this to the wrong list. I didn't
mean to give away answers.

The version below includes prime?, next-prime
and :primes.

/Jens Axel


(require (planet "42.ss" ("soegaard" "srfi.plt")))

(define prime?
   (let ()
     ; number of cached small primes
     (define N 10000)

     ; n prime <=> (vector-ref primes n)
     (define primes (make-vector N #t))

     (vector-set! primes 0 #f)
     (vector-set! primes 1 #f)

     ; sieve of Eratosthenes
     (do-ec (:range n 2 N)
            (if (vector-ref primes n))
            (:range i (+ n n) N n)
            (vector-set! primes i #f))

     (lambda (n)
       (cond
         [(< n 0) #f]
         [(< n N) (vector-ref primes n)]
         [else    (let ([no-small-factor?
                         (every?-ec
                          (:let sqrt-n (integer-sqrt n))
                          (:while (:vector p-prime? (index p) primes)
                                  (<= p sqrt-n))
                          (if p-prime?)
                          (not (zero? (remainder n p))))])
                    (and no-small-factor?
                         (or (< (sqrt n) N)
                             ; large factors?
                             (every?-ec
                              (:let sqrt-n (+ (integer-sqrt n) 1))
                              (:range f (if (even? N) (+ N 1) N)
                                        sqrt-n 2)
                              (not (zero? (remainder n f)))))))]))))

(define (next-prime n)
   ; find first prime larger than n
   (cond
     [(< n 2) 2]
     [(= n 2) 3]
     [(and (even? n) (not (prime? (+ n 1))))
      (next-prime (+ n 1))]
     [(even? n)
      (+ n 1)]
     [else
      (first-ec 'never-used
                ; Chebyshev's Theorem says (* 2 n) okay
                (:range m (+ n 2) (* 2 n) 2)
                (if (prime? m))
                m)]))

(define-syntax (:primes stx)
   (syntax-case stx (index)
     [(_ cc n (index i) . more)
      #'(:parallel (:integers i) (_ n . more))]
     [(_ cc n)
      #'(:iterate n 2 next-prime (lambda (n) #f))]
     [(_ cc n from)
      #'(:iterate n from next-prime (lambda (n) #f))]
     [(_ cc n from to)
      #'(:iterate cc n from next-prime (let ([t to])
                                         (lambda (n) (> n t))))]
     [_
      (raise-syntax-error
       ':primes
       "expected (:primes from to), where from and to is optional"
       stx)]))


(require mzscheme)

(define (number-append x y)
   (string->number
    (string-append
     (number->string x) (number->string y))))
(define N 10000)

(first-ec 'not-found
           (:primes a 3 N)
           (:primes b (next-prime a) N)
           (if (and (prime? (number-append a b))
                    (prime? (number-append b a))))
           (:primes c (next-prime b) N)
           (if (and (prime? (number-append a c))
                    (prime? (number-append c a))
                    (prime? (number-append b c))
                    (prime? (number-append c b))))
           (:primes d (next-prime c) N)
           (if (and (prime? (number-append a d))
                    (prime? (number-append d a))
                    (prime? (number-append b d))
                    (prime? (number-append d b))
                    (prime? (number-append c d))
                    (prime? (number-append d c))))
           (:primes e (next-prime d) N)
           (if (and (prime? (number-append a e))
                    (prime? (number-append e a))
                    (prime? (number-append b e))
                    (prime? (number-append e b))
                    (prime? (number-append c e))
                    (prime? (number-append e c))
                    (prime? (number-append d e))
                    (prime? (number-append e d))))
           (list a b c d e))