Language: C C++ D Haskell Lua OCaml PHP Perl Plain Text Python Ruby Scheme Tcl ; maxiphobic heaps (define mh-node vector) ; size item lkid rkid (define-syntax mh-size (syntax-rules () ((_ mh) (vector-ref mh 0)))) (define-syntax mh-item (syntax-rules () ((_ mh) (vector-ref mh 1)))) (define-syntax mh-lkid (syntax-rules () ((_ mh) (vector-ref mh 2)))) (define-syntax mh-rkid (syntax-rules () ((_ mh) (vector-ref mh 3)))) (define mh-empty (mh-node 0 'mh-empty 'mh-empty 'mh-empty)) (define (mh-empty? mh) (eqv? mh mh-empty)) (define (mh-merge lt? mh1 mh2) (cond ((mh-empty? mh1) mh2) ((mh-empty? mh2) mh1) (else (if (lt? (mh-item mh1) (mh-item mh2)) (let ((mhs (mh-biggest (mh-lkid mh1) (mh-rkid mh1) mh2))) (mh-node (+ (mh-size mh1) (mh-size mh2)) (mh-item mh1) (car mhs) (apply mh-merge lt? (cdr mhs)))) (let ((mhs (mh-biggest mh1 (mh-lkid mh2) (mh-rkid mh2)))) (mh-node (+ (mh-size mh1) (mh-size mh2)) (mh-item mh2) (car mhs) (apply mh-merge lt? (cdr mhs)))))))) (define (mh-biggest mh1 mh2 mh3) (if (< (mh-size mh1) (mh-size mh2)) (if (< (mh-size mh2) (mh-size mh3)) (list mh3 mh1 mh2) (list mh2 mh1 mh3)) (if (< (mh-size mh1) (mh-size mh3)) (list mh3 mh1 mh2) (list mh1 mh2 mh3)))) (define (mh-insert lt? x mh) (mh-merge lt? (mh-node 1 x mh-empty mh-empty) mh)) (define (mh-find-min mh) (if (mh-empty? mh) (error 'mh-find-min "empty maxiphobic heap") (mh-item mh))) (define (mh-delete-min lt? mh) (if (mh-empty? mh) (error 'mh-delete-min "empty maxiphobic heap") (mh-merge lt? (mh-lkid mh) (mh-rkid mh)))) (define (mh-sort lt? xs) (let loop1 ((xs xs) (mh mh-empty)) (if (pair? xs) (loop1 (cdr xs) (mh-insert lt? (car xs) mh)) (let loop2 ((mh mh) (zs '())) (if (mh-empty? mh) (reverse zs) (loop2 (mh-delete-min lt? mh) (cons (mh-find-min mh) zs))))))) (display (mh-sort > '(3 1 7 2 5 6 4))) Private [?] Run code