Language: C C++ D Haskell Lua OCaml PHP Perl Plain Text Python Ruby Scheme Tcl ; priority queues (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 (list->pq lt? xs) (let loop ((xs xs) (pq pq-empty)) (if (null? xs) pq (loop (cdr xs) (pq-insert lt? (car xs) pq))))) (define (pq->list lt? pq) (let loop ((pq pq) (xs '())) (if (pq-empty? pq) (reverse xs) (loop (pq-rest lt? pq) (cons (pq-first pq) xs))))) (define (pq-sort lt? xs) (pq->list lt? (list->pq lt? xs))) (display (pq-sort < '(3 7 8 1 2 9 6 4 5))) Private [?] Run code