; k'th largest item
(define pq-empty '())
(define pq-empty? null?)
(define (pq-first pq)
(if (null? pq)
(error 'pq-first "can't extract from null queue")
(car pq)))
(define (pq-merge lt? p1 p2)
(cond ((null? p1) p2)
((null? p2) p1)
((lt? (car p2) (car p1))
(cons (car p2) (cons p1 (cdr p2))))
(else (cons (car p1) (cons p2 (cdr p1))))))
(define (pq-insert lt? x pq)
(pq-merge lt? (list x) pq))
(define (pq-merge-pairs lt? ps)
(cond ((null? ps) '())
((null? (cdr ps)) (car ps))
(else (pq-merge lt? (pq-merge lt? (car ps) (cadr ps))
(pq-merge-pairs lt? (cddr ps))))))
(define (pq-rest lt? pq)
(if (null? pq)
(error 'pq-rest "can't delete from null queue")
(pq-merge-pairs lt? (cdr pq))))
(define rand
(let ((a 69069) (c 1234567) (m (expt 2 32))
(seed 20140801))
(lambda ()
(set! seed (modulo (+ (* a seed) c) m))
(display seed) (newline) ; make visible for debugging
seed)))
(define (insert-in-order x xs)
(let loop ((xs xs) (zs (list)))
(if (null? xs) (reverse (cons x zs))
(if (< x (car xs))
(append (reverse zs) (list x) xs)
(loop (cdr xs) (cons (car xs) zs))))))
(define (kth-largest-list n k)
(let loop ((xs (list)) (i k))
(if (positive? i)
(loop (insert-in-order (rand) xs) (- i 1))
(let loop ((xs xs) (n (- n k)))
(if (zero? n) (car xs)
(let ((x (rand)))
(if (< x (car xs)) (loop xs (- n 1))
(loop (insert-in-order x (cdr xs)) (- n 1)))))))))
(define (kth-largest-heap n k)
(let loop ((pq pq-empty) (i k))
(if (positive? i)
(loop (pq-insert < (rand) pq) (- i 1))
(let loop ((pq pq) (n (- n k)))
(if (zero? n) (pq-first pq)
(let ((x (rand)))
(if (< x (pq-first pq)) (loop pq (- n 1))
(loop (pq-insert < x (pq-rest < pq)) (- n 1)))))))))
(display (kth-largest-list 10 3))
(newline) (newline)
(display (kth-largest-heap 10 3))