[ create a new paste ] login | about

Link: http://codepad.org/qmGTnhrL    [ raw code | output | fork ]

programmingpraxis - Scheme, pasted on Jul 30:
; 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))


Output:
3831782228
1483160779
1168102422
3001731621
4236220200
1142155663
1886396682
3700739465
4281623100
1748929683
3831782228

870309694
3354181933
3752186000
1409427927
2344960690
874400017
2400859684
586417499
1729871718
3110684981
3110684981


Create a new paste based on this one


Comments: