! Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel math sequences arrays assocs sequences.private
-growable accessors math.order summary ;
+growable accessors math.order summary vectors ;
IN: heaps
GENERIC: heap-push* ( value key heap -- entry )
<PRIVATE
-TUPLE: heap data ;
+TUPLE: heap { data vector } ;
: <heap> ( class -- heap )
[ V{ } clone ] dip boa ; inline
TUPLE: entry value key heap index ;
-: <entry> ( value key heap -- entry ) f entry boa ;
+: <entry> ( value key heap -- entry ) f entry boa ; inline
PRIVATE>
[ data-exchange ] 2keep up-heap
] [
3drop
- ] if ;
+ ] if ; inline recursive
: up-heap ( n heap -- )
- over 0 > [ (up-heap) ] [ 2drop ] if ;
+ over 0 > [ (up-heap) ] [ 2drop ] if ; inline recursive
: (child) ( m heap -- n )
2dup right-value
3drop
] [
[ data-exchange ] 2keep down-heap
- ] if ;
+ ] if ; inline recursive
: down-heap ( m heap -- )
- 2dup left-bounds-check? [ 2drop ] [ (down-heap) ] if ;
+ 2dup left-bounds-check? [ 2drop ] [ (down-heap) ] if ; inline recursive
PRIVATE>
[ swapd heap-push ] curry assoc-each ;
: >entry< ( entry -- key value )
- [ value>> ] [ key>> ] bi ;
+ [ value>> ] [ key>> ] bi ; inline
M: heap heap-peek ( heap -- value key )
data-first >entry< ;
--- /dev/null
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: heaps math sequences kernel ;
+IN: benchmark.heaps
+
+: data ( -- seq )
+ 1 6000 [ 13 + 79 * 13591 mod dup ] replicate nip ;
+
+: heap-test ( -- )
+ <min-heap>
+ data
+ [ [ dup pick heap-push ] each ]
+ [ length [ dup heap-pop* ] times ] bi
+ drop ;
+
+: heap-benchmark ( -- )
+ 100 [ heap-test ] times ;
+
+MAIN: heap-benchmark
\ No newline at end of file