improved-prime-seive.ros

#!/bin/sh
#|-*- mode:lisp -*-|#
#|
exec ros -Q -- $0 "$@"
|#

(eval-when (:execute :load-toplevel :compile-toplevel)
  (ql:quickload :cl-lazy)
  (ql:quickload :cl-prime-number)
  (ql:quickload :anaphora))

(defpackage :ros.script.improved-prime-seive.ros.3661078750
  (:use :cl
        :cl-lazy
        :anaphora))
(in-package :ros.script.improved-prime-seive.ros.3661078750)

(enable-series-processing-syntax)

(let ((next-prime nil)
      (prime-series (llist 3)))
  (defparameter *sieve* #<a[n] = 
                #<b[k] =  (1+ (* (+ k 2) 2))>,
                (progn
                  (setf next-prime (lcar prime-series))
                  (setf prime-series (lcdr prime-series))
                  (let ((head-prime next-prime))
                    (multiple-value-bind (prime rest) 
                        (lspan (lambda (x) (< x (expt head-prime 2)))
                               a[n-1])
                      (setf prime-series (lappend prime-series prime))
                      (filter-series (lambda (x) (< 0 (mod x head-prime))) rest))))>))

(labels ((get-next (&optional (extracted-prime nil) (sieve *sieve*) (head-primes (llist 3)))
           (aif (lcar extracted-prime)
                (lcons it (get-next (lcdr extracted-prime) sieve head-primes))
                (let* ((expt-prime (expt (lcar head-primes) 2))
                       (new-extracted (lspan (lambda (x)
                                               (< x expt-prime))
                                             (lcar sieve))))
                  (get-next new-extracted
                            (lcdr sieve)
                            (lcdr (lappend head-primes new-extracted)))))))
  (defparameter *prime-series* (lappend (llist 2 3) (get-next))))

(labels ((get-next (&optional (extracted-prime nil)
                              (for-sieve (make-simple-series nil (lambda (n) (+ (* (+ n 2) 2) 1)))) 
                              (head-primes (llist 3)))
           (aif (lcar extracted-prime)
                (lcons it (get-next (lcdr extracted-prime) for-sieve head-primes))
                (let* ((prime (lcar head-primes))
                       (expt-prime (expt prime 2)))
                  (multiple-value-bind (new-extracted for-sieve-next)
                      (lspan (lambda (x) (< x expt-prime))
                             for-sieve)
                    (get-next new-extracted
                              (filter-series (lambda (x) (< 0 (mod x prime))) for-sieve-next)
                              (lcdr (lappend head-primes new-extracted))))))))
  (defparameter *prime-series%* (lappend (llist 2 3) (get-next))))

(defparameter *sieve2* #<a[n] =
              #<b[k] = 2, (1+ (* k 2))>, (let ((factor a[n-1][0]))
                                           (filter-series
                                            #'(lambda (val)
                                                (< 0 (mod val factor)))
                                            a[n-1]))>)

(defun main (&rest argv)
  (declare (ignorable argv))
  (time (print (lnth 10000 *prime-series*)))
  (time (print (lnth 10000 *prime-series%*)))
  (time (print (lnth 10000 cl-prime-number:*prime-series*)))
  (time (print #{*sieve2*[281][0]}))
  (dotimes (i 11)
    (format t "[~4D]" (lnth i *prime-series*))
    (do-series (var (lnth i *sieve*) to 10)
      (format t "~5D" var))
    (fresh-line))
  (format t "~%"))