Language: C C++ D Haskell Lua OCaml PHP Perl Plain Text Python Ruby Scheme Tcl ; the first n primes (define-syntax pq-rank (syntax-rules () ((_ pq) (vector-ref pq 0)))) (define-syntax pq-item (syntax-rules () ((_ pq) (vector-ref pq 1)))) (define-syntax pq-lkid (syntax-rules () ((_ pq) (vector-ref pq 2)))) (define-syntax pq-rkid (syntax-rules () ((_ pq) (vector-ref pq 3)))) (define pq-empty (vector 0 'pq-empty 'pq-empty 'pq-empty)) (define (pq-empty? pq) (eqv? pq pq-empty)) (define (pq-merge lt? p1 p2) (define (pq-swap item lkid rkid) (if (< (pq-rank rkid) (pq-rank lkid)) (vector (+ (pq-rank rkid) 1) item lkid rkid) (vector (+ (pq-rank lkid) 1) item rkid lkid))) (cond ((pq-empty? p1) p2) ((pq-empty? p2) p1) ((lt? (pq-item p2) (pq-item p1)) (pq-swap (pq-item p2) (pq-lkid p2) (pq-merge lt? p1 (pq-rkid p2)))) (else (pq-swap (pq-item p1) (pq-lkid p1) (pq-merge lt? (pq-rkid p1) p2))))) (define (pq-insert lt? x pq) (pq-merge lt? (vector 1 x pq-empty pq-empty) pq)) (define (pq-first pq) (if (pq-empty? pq) (error 'pq-first "empty priority queue") (pq-item pq))) (define (pq-rest lt? pq) (if (pq-empty? pq) (error 'pq-rest "empty priority queue") (pq-merge lt? (pq-lkid pq) (pq-rkid pq)))) (define (lt? a b) (or (< (car a) (car b)) (and (= (car a) (car b)) (< (cdr a) (cdr b))))) (define (n-primes n) (let ((pq (pq-insert lt? (cons 9 6) pq-empty))) (let loop1 ((i 5) (pq pq) (ps (list 3 2)) (k 2)) ; (display "loop1 ") (display i) (display " ") (display (pq->list lt? pq)) ; (display " ") (display ps) (display " ") (display k) (newline) (cond ((= n k) (reverse ps)) ((< i (car (pq-first pq))) (let* ((c (* i i)) (s (+ i i)) (pq (pq-insert lt? (cons c s) pq))) (loop1 (+ i 2) pq (cons i ps) (+ k 1)))) (else (let loop2 ((pq pq)) ; (display "loop2 ") (display (pq->list lt? pq)) (newline) (if (< i (car (pq-first pq))) (loop1 (+ i 2) pq ps k) (let* ((c (car (pq-first pq))) (s (cdr (pq-first pq))) (pq (pq-rest lt? pq))) (loop2 (pq-insert lt? (cons (+ c s) s) pq)))))))))) (display (n-primes 168)) Private [?] Run code Submit