steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Update heaps to store key/value pairs instead of objects comparable by <=> 

Update docs
Add heap-length
release
Doug Coleman 2007-11-05 11:10:26 -06:00
parent bf32fb7a53
commit 29afe48d32
3 changed files with 48 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
core/heaps/heaps-docs.factor
View File

@ -4,7 +4,7 @@ IN: heaps
ARTICLE: "heaps" "Heaps"
"A heap is an implementation of a " { $emphasis "priority queue" } ", which is a structure that maintains a sorted set of elements. The key property is that insertion of an arbitrary element and removal of the first element (determined by order) is performed in O(log n) time."
$nl
"Heap elements are compared using the " { $link <=> } " generic word."
"Heap elements are key/value pairs and are compared using the " { $link <=> } " generic word on the first element of the pair."
$nl
"There are two classes of heaps. Min-heaps sort their elements so that the minimum element is first:"
{ $subsection min-heap }
@ -18,6 +18,7 @@ $nl
$nl
"Queries:"
{ $subsection heap-empty? }
{ $subsection heap-length }
{ $subsection heap-peek }
"Insertion:"
{ $subsection heap-push }
@ -31,33 +32,44 @@ ABOUT: "heaps"
HELP: <min-heap>
{ $values { "min-heap" min-heap } }
{ $description "Create a new " { $link min-heap } "." }
;
{ $see-also <max-heap> } ;
HELP: <max-heap>
{ $values { "max-heap" max-heap } }
{ $description "Create a new " { $link max-heap } "." }
;
{ $see-also <min-heap> } ;
HELP: heap-push
{ $values { "obj" "an object" } { "heap" "a heap" } }
{ $description "Push an object onto a heap." } ;
{ $values { "pair" "a key/value pair" } { "heap" "a heap" } }
{ $description "Push an pair onto a heap. The first element of the pair must be comparable to the rest of the heap by the " { $link <=> } " word." }
{ $see-also heap-push-all heap-pop } ;
HELP: heap-push-all
{ $values { "seq" "a sequence" } { "heap" "a heap" } }
{ $description "Push a sequence onto a heap." } ;
{ $values { "seq" "a sequence of pairs" } { "heap" "a heap" } }
{ $description "Push a sequence of pairs onto a heap." }
{ $see-also heap-push heap-pop } ;
HELP: heap-peek
{ $values { "heap" "a heap" } { "obj" "an object" } }
{ $description "Returns the first element in the heap and leaves it in the heap." } ;
{ $values { "heap" "a heap" } { "pair" "a key/value pair" } }
{ $description "Returns the first element in the heap and leaves it in the heap." }
{ $see-also heap-pop heap-pop* } ;
HELP: heap-pop*
{ $values { "heap" "a heap" } }
{ $description "Removes the first element from the heap." } ;
{ $description "Removes the first element from the heap." }
{ $see-also heap-pop heap-push heap-peek } ;
HELP: heap-pop
{ $values { "heap" "a heap" } { "obj" "an object" } }
{ $description "Returns the first element in the heap and removes it from the heap." } ;
{ $values { "heap" "a heap" } { "pair" "an key/value pair" } }
{ $description "Returns the first element in the heap and removes it from the heap." }
{ $see-also heap-pop* heap-push heap-peek } ;
HELP: heap-empty?
{ $values { "heap" "a heap" } { "?" "a boolean" } }
{ $description "Tests if a " { $link heap } " has no nodes." } ;
{ $description "Tests if a " { $link heap } " has no nodes." }
{ $see-also heap-length heap-peek } ;
HELP: heap-length
{ $values { "heap" "a heap" } { "n" "an integer" } }
{ $description "Returns the number of key/value pairs in the heap." }
{ $see-also heap-empty? } ;

25
core/heaps/heaps-tests.factor
View File

@ -8,25 +8,28 @@ IN: temporary
[ <max-heap> heap-pop ] unit-test-fails
[ t ] [ <min-heap> heap-empty? ] unit-test
[ f ] [ <min-heap> 1 over heap-push heap-empty? ] unit-test
[ f ] [ <min-heap> { 1 t } over heap-push heap-empty? ] unit-test
[ t ] [ <max-heap> heap-empty? ] unit-test
[ f ] [ <max-heap> 1 over heap-push heap-empty? ] unit-test
[ f ] [ <max-heap> { 1 t } over heap-push heap-empty? ] unit-test
! Binary Min Heap
{ 1 2 3 4 5 6 } [ 0 left 0 right 1 left 1 right 2 left 2 right ] unit-test
{ t } [ 5 3 T{ min-heap } heap-compare ] unit-test
{ f } [ 5 3 T{ max-heap } heap-compare ] unit-test
{ t } [ { 5 t } { 3 t } T{ min-heap } heap-compare ] unit-test
{ f } [ { 5 t } { 3 t } T{ max-heap } heap-compare ] unit-test
[ T{ min-heap T{ heap f V{ -6 -4 2 1 5 3 2 4 3 7 6 8 3 4 4 6 5 5 } } } ]
[ <min-heap> { 3 5 4 6 7 8 2 4 3 5 6 1 3 2 4 5 -6 -4 } over heap-push-all ] unit-test
[ T{ min-heap T{ heap f V{ { -6 t } { -4 t } { 2 t } { 1 t } { 5 t } { 3 t } { 2 t } { 4 t } { 3 t } { 7 t } { 6 t } { 8 t } { 3 t } { 4 t } { 4 t } { 6 t } { 5 t } { 5 t } } } } ]
[ <min-heap> { { 3 t } { 5 t } { 4 t } { 6 t } { 7 t } { 8 t } { 2 t } { 4 t } { 3 t } { 5 t } { 6 t } { 1 t } { 3 t } { 2 t } { 4 t } { 5 t } { -6 t } { -4 t } } over heap-push-all ] unit-test
[ T{ min-heap T{ heap f V{ 5 6 6 7 8 } } } ] [
<min-heap> { 3 5 4 6 5 7 6 8 } over heap-push-all
[ T{ min-heap T{ heap f V{ { 5 t } { 6 t } { 6 t } { 7 t } { 8 t } } } } ] [
<min-heap> { { 3 t } { 5 t } { 4 t } { 6 t } { 5 t } { 7 t } { 6 t } { 8 t } } over heap-push-all
3 [ dup heap-pop* ] times
] unit-test
[ 2 ] [ <min-heap> 300 over heap-push 200 over heap-push 400 over heap-push 3 over heap-push 2 over heap-push heap-pop ] unit-test
[ { 2 t } ] [ <min-heap> { 300 t } over heap-push { 200 t } over heap-push { 400 t } over heap-push { 3 t } over heap-push { 2 t } over heap-push heap-pop ] unit-test
[ 1 ] [ <min-heap> 300 over heap-push 200 over heap-push 400 over heap-push 3 over heap-push 2 over heap-push 1 over heap-push heap-pop ] unit-test
[ { 1 t } ] [ <min-heap> { 300 t } over heap-push { 200 t } over heap-push { 400 t } over heap-push { 3 t } over heap-push { 2 t } over heap-push { 1 t } over heap-push heap-pop ] unit-test
[ 400 ] [ <max-heap> 300 over heap-push 200 over heap-push 400 over heap-push 3 over heap-push 2 over heap-push 1 over heap-push heap-pop ] unit-test
[ { 400 t } ] [ <max-heap> { 300 t } over heap-push { 200 t } over heap-push { 400 t } over heap-push { 3 t } over heap-push { 2 t } over heap-push { 1 t } over heap-push heap-pop ] unit-test
[ 0 ] [ <max-heap> heap-length ] unit-test
[ 1 ] [ <max-heap> { 1 t } over heap-push heap-length ] unit-test

16
core/heaps/heaps.factor
View File

@ -6,7 +6,7 @@ IN: heaps
<PRIVATE
TUPLE: heap data ;
: <heap> ( class -- obj )
: <heap> ( class -- heap )
>r V{ } clone heap construct-boa r>
construct-delegate ; inline
PRIVATE>
@ -29,9 +29,10 @@ TUPLE: max-heap ;
: swap-up ( n vec -- ) >r dup up r> exchange ; inline
: last-index ( vec -- n ) length 1- ; inline
GENERIC: heap-compare ( obj1 obj2 heap -- ? )
M: min-heap heap-compare drop <=> 0 > ;
M: max-heap heap-compare drop <=> 0 < ;
GENERIC: heap-compare ( pair1 pair2 heap -- ? )
: (heap-compare) drop [ first ] 2apply <=> 0 ; inline
M: min-heap heap-compare (heap-compare) > ;
M: max-heap heap-compare (heap-compare) < ;
: heap-bounds-check? ( m heap -- ? )
heap-data length >= ; inline
@ -84,12 +85,12 @@ DEFER: down-heap
PRIVATE>
: heap-push ( obj heap -- )
: heap-push ( pair heap -- )
tuck heap-data push [ heap-data ] keep up-heap ;
: heap-push-all ( seq heap -- ) [ heap-push ] curry each ;
: heap-peek ( heap -- obj ) heap-data first ;
: heap-peek ( heap -- pair ) heap-data first ;
: heap-pop* ( heap -- )
dup heap-data length 1 > [
@ -100,5 +101,6 @@ PRIVATE>
heap-data pop*
] if ;
: heap-pop ( heap -- obj ) [ heap-data first ] keep heap-pop* ;
: heap-pop ( heap -- pair ) [ heap-data first ] keep heap-pop* ;
: heap-empty? ( heap -- ? ) heap-data empty? ;
: heap-length ( heap -- n ) heap-data length ;