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

heaps: check heap invariant during tests

freebsd-work
Jon Harper 2019-01-09 17:36:20 +01:00
parent 2a8643e936
commit 8a052aed92
1 changed files with 19 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
basis/heaps/heaps-tests.factor
View File

@ -27,8 +27,24 @@ IN: heaps.tests
{ 0 } [ <max-heap> heap-size ] unit-test { 0 } [ <max-heap> heap-size ] unit-test
{ 1 } [ <max-heap> t 1 pick heap-push heap-size ] unit-test { 1 } [ <max-heap> t 1 pick heap-push heap-size ] unit-test
DEFER: (assert-heap-invariant)
: ((assert-heap-invariant)) ( parent child heap heap-size -- )
pick over < [
[ [ heapdata-compare f assert= ] 2keep ] dip
(assert-heap-invariant)
] [ 4drop ] if ;
: (assert-heap-invariant) ( n heap heap-size -- )
[ dup left dup 1 + ] 2dip
[ ((assert-heap-invariant)) ] 2curry bi-curry@ bi ;
: assert-heap-invariant ( heap -- )
dup heap-empty? [ drop ]
[ 0 swap dup heap-size (assert-heap-invariant) ] if ;
: heap-sort ( alist heap -- keys ) : heap-sort ( alist heap -- keys )
[ heap-push-all ] keep heap-pop-all ; [ heap-push-all ] keep dup assert-heap-invariant heap-pop-all ;
: random-alist ( n -- alist ) : random-alist ( n -- alist )
<iota> [ <iota> [
@ -57,6 +73,7 @@ IN: heaps.tests
: test-entry-indices ( n -- ? ) : test-entry-indices ( n -- ? )
random-alist random-alist
<min-heap> [ heap-push-all ] keep <min-heap> [ heap-push-all ] keep
dup assert-heap-invariant
data>> dup length <iota> swap [ index>> ] map sequence= ; data>> dup length <iota> swap [ index>> ] map sequence= ;
14 [ 14 [
@ -72,6 +89,7 @@ IN: heaps.tests
<min-heap> [ heap-push-all ] keep <min-heap> [ heap-push-all ] keep
dup data>> clone swap dup data>> clone swap
] keep 3 /i [ 2dup [ delete-random ] dip heap-delete ] times ] keep 3 /i [ 2dup [ delete-random ] dip heap-delete ] times
dup assert-heap-invariant
data>> data>>
[ [ key>> ] map ] bi@ [ [ key>> ] map ] bi@
[ natural-sort ] bi@ ; [ natural-sort ] bi@ ;