1 ! Copyright 2007, 2008 Ryan Murphy, Slava Pestov
2 ! See https://factorcode.org/license.txt for BSD license.
3 USING: arrays kernel math namespaces tools.test
4 heaps heaps.private math.parser random assocs sequences sorting
5 accessors math.order locals ;
8 [ <min-heap> heap-pop ] must-fail
9 [ <max-heap> heap-pop ] must-fail
11 { t } [ <min-heap> heap-empty? ] unit-test
12 { f } [ <min-heap> 1 t pick heap-push heap-empty? ] unit-test
13 { t } [ <max-heap> heap-empty? ] unit-test
14 { f } [ <max-heap> 1 t pick heap-push heap-empty? ] unit-test
17 { 1 2 3 4 5 6 } [ 0 left 0 right 1 left 1 right 2 left 2 right ] unit-test
18 { t } [ t 5 f <entry> t 3 f <entry> T{ min-heap } heap-compare ] unit-test
19 { f } [ t 5 f <entry> t 3 f <entry> T{ max-heap } heap-compare ] unit-test
21 { t 2 } [ <min-heap> t 300 pick heap-push t 200 pick heap-push t 400 pick heap-push t 3 pick heap-push t 2 pick heap-push heap-pop ] unit-test
23 { t 1 } [ <min-heap> t 300 pick heap-push t 200 pick heap-push t 400 pick heap-push t 3 pick heap-push t 2 pick heap-push t 1 pick heap-push heap-pop ] unit-test
25 { t 400 } [ <max-heap> t 300 pick heap-push t 200 pick heap-push t 400 pick heap-push t 3 pick heap-push t 2 pick heap-push t 1 pick heap-push heap-pop ] unit-test
27 { 0 } [ <max-heap> heap-size ] unit-test
28 { 1 } [ <max-heap> t 1 pick heap-push heap-size ] unit-test
30 DEFER: (assert-heap-invariant)
32 : heapdata-compare ( m n heap -- ? )
33 [ data>> [ nth ] curry bi@ ] keep heap-compare ; inline
35 : ((assert-heap-invariant)) ( parent child heap heap-size -- )
37 [ [ heapdata-compare f assert= ] 2keep ] dip
38 (assert-heap-invariant)
41 : (assert-heap-invariant) ( n heap heap-size -- )
42 [ dup left dup 1 + ] 2dip
43 [ ((assert-heap-invariant)) ] 2curry bi-curry@ bi ;
45 : assert-heap-invariant ( heap -- )
46 dup heap-empty? [ drop ]
47 [ 0 swap dup heap-size (assert-heap-invariant) ] if ;
49 : heap-sort ( alist heap -- keys )
50 [ heap-push-all ] keep dup assert-heap-invariant heap-pop-all ;
52 : random-alist ( n -- alist )
54 drop 32 random-bits dup number>string
55 ] H{ } map>assoc >alist ;
57 :: test-heap-sort ( n heap reverse? -- ? )
59 [ sort-keys reverse? [ reverse ] when ] keep
62 : test-minheap-sort ( n -- ? )
63 <min-heap> f test-heap-sort ;
65 : test-maxheap-sort ( n -- ? )
66 <max-heap> t test-heap-sort ;
69 [ t ] swap [ 2^ <min-heap> f test-heap-sort ] curry unit-test
73 [ t ] swap [ 2^ <max-heap> t test-heap-sort ] curry unit-test
76 : test-entry-indices ( n -- ? )
78 <min-heap> [ heap-push-all ] keep
79 dup assert-heap-invariant
80 data>> dup length <iota> swap [ index>> ] map sequence= ;
83 [ t ] swap [ 2^ test-entry-indices ] curry unit-test
86 : delete-test ( n -- obj1 obj2 )
89 <min-heap> [ heap-push-all ] keep
91 ] keep 3 /i [ 2dup [ delete-random ] dip heap-delete ] times
92 dup assert-heap-invariant
95 [ natural-sort ] bi@ ;
98 [ t ] swap [ 2^ delete-test sequence= ] curry unit-test
103 t 1 heap heap-push* :> entry
106 entry heap heap-delete ] [ bad-heap-delete? ] must-fail-with
110 t 1 heap heap-push* :> entry
113 entry heap heap-delete ] [ bad-heap-delete? ] must-fail-with
117 t 1 heap heap-push* :> entry
119 entry heap heap-delete
120 entry heap heap-delete ] [ bad-heap-delete? ] must-fail-with
125 t 1 heap heap-push* :> entry
126 entry heap heap-delete
127 entry heap heap-delete ] [ bad-heap-delete? ] must-fail-with