basis/heaps/heaps-tests.factor

   1 ! Copyright 2007, 2008 Ryan Murphy, Slava Pestov
   2 ! See http://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 ;
   6 IN: heaps.tests
   7
   8 [ <min-heap> heap-pop ] must-fail
   9 [ <max-heap> heap-pop ] must-fail
  10
  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
  15
  16 ! Binary Min Heap
  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
  20
  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
  22
  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
  24
  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
  26
  27 { 0 } [ <max-heap> heap-size ] unit-test
  28 { 1 } [ <max-heap> t 1 pick heap-push heap-size ] unit-test
  29
  30 DEFER: (assert-heap-invariant)
  31
  32 : heapdata-compare ( m n heap -- ? )
  33     [ data>> [ nth ] curry bi@ ] keep heap-compare ; inline
  34
  35 : ((assert-heap-invariant)) ( parent child heap heap-size -- )
  36     pick over < [
  37         [ [ heapdata-compare f assert= ] 2keep ] dip
  38         (assert-heap-invariant)
  39     ] [ 4drop ] if ;
  40
  41 : (assert-heap-invariant) ( n heap heap-size -- )
  42     [ dup left dup 1 + ] 2dip
  43     [ ((assert-heap-invariant)) ] 2curry bi-curry@ bi ;
  44
  45 : assert-heap-invariant ( heap -- )
  46     dup heap-empty? [ drop ]
  47     [ 0 swap dup heap-size (assert-heap-invariant) ] if ;
  48
  49 : heap-sort ( alist heap -- keys )
  50     [ heap-push-all ] keep dup assert-heap-invariant heap-pop-all ;
  51
  52 : random-alist ( n -- alist )
  53     <iota> [
  54         drop 32 random-bits dup number>string
  55     ] H{ } map>assoc >alist ;
  56
  57 :: test-heap-sort ( n heap reverse? -- ? )
  58     n random-alist
  59     [ sort-keys reverse? [ reverse ] when ] keep
  60     heap heap-sort = ;
  61
  62 : test-minheap-sort ( n -- ? )
  63     <min-heap> f test-heap-sort ;
  64
  65 : test-maxheap-sort ( n -- ? )
  66     <max-heap> t test-heap-sort ;
  67
  68 14 [
  69     [ t ] swap [ 2^ <min-heap> f test-heap-sort ] curry unit-test
  70 ] each-integer
  71
  72 14 [
  73     [ t ] swap [ 2^ <max-heap> t test-heap-sort ] curry unit-test
  74 ] each-integer
  75
  76 : test-entry-indices ( n -- ? )
  77     random-alist
  78     <min-heap> [ heap-push-all ] keep
  79     dup assert-heap-invariant
  80     data>> dup length <iota> swap [ index>> ] map sequence= ;
  81
  82 14 [
  83     [ t ] swap [ 2^ test-entry-indices ] curry unit-test
  84 ] each-integer
  85
  86 : delete-test ( n -- obj1 obj2 )
  87     [
  88         random-alist
  89         <min-heap> [ heap-push-all ] keep
  90         dup data>> clone swap
  91     ] keep 3 /i [ 2dup [ delete-random ] dip heap-delete ] times
  92     dup assert-heap-invariant
  93     data>>
  94     [ [ key>> ] map ] bi@
  95     [ natural-sort ] bi@ ;
  96
  97 11 [
  98     [ t ] swap [ 2^ delete-test sequence= ] curry unit-test
  99 ] each-integer
 100
 101 [| |
 102  <min-heap> :> heap
 103  t 1 heap heap-push* :> entry
 104  heap heap-pop 2drop
 105  t 2 heap heap-push
 106  entry heap heap-delete ] [ bad-heap-delete? ] must-fail-with
 107
 108 [| |
 109  <min-heap> :> heap
 110  t 1 heap heap-push* :> entry
 111  t 2 heap heap-push
 112  heap heap-pop 2drop
 113  entry heap heap-delete ] [ bad-heap-delete? ] must-fail-with
 114
 115 [| |
 116  <min-heap> :> heap
 117  t 1 heap heap-push* :> entry
 118  t 2 heap heap-push
 119  entry heap heap-delete
 120  entry heap heap-delete ] [ bad-heap-delete? ] must-fail-with
 121
 122 [| |
 123  <min-heap> :> heap
 124  t 0 heap heap-push
 125  t 1 heap heap-push* :> entry
 126  entry heap heap-delete
 127  entry heap heap-delete ] [ bad-heap-delete? ] must-fail-with