]> gitweb.factorcode.org Git - factor.git/commitdiff
slightly faster heaps, add benchmark
authorSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Sat, 18 Jul 2009 05:52:24 +0000 (00:52 -0500)
committerSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Sat, 18 Jul 2009 05:52:24 +0000 (00:52 -0500)
basis/heaps/heaps.factor
extra/benchmark/heaps/heaps.factor [new file with mode: 0644]

index ae546080a131a12e0698e1d175c5c53fe6235a7d..32ed10d8f26f6c4b043fafb83da462c746916ff5 100644 (file)
@@ -2,7 +2,7 @@
 ! 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 )
@@ -15,14 +15,14 @@ GENERIC: heap-size ( heap -- n )
 
 <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>
 
@@ -109,10 +109,10 @@ DEFER: up-heap
         [ 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
@@ -132,10 +132,10 @@ DEFER: down-heap
         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>
 
@@ -148,7 +148,7 @@ M: heap heap-push* ( value key heap -- entry )
     [ 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< ;
diff --git a/extra/benchmark/heaps/heaps.factor b/extra/benchmark/heaps/heaps.factor
new file mode 100644 (file)
index 0000000..1a63e3d
--- /dev/null
@@ -0,0 +1,19 @@
+! 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