basis/heaps/heaps-tests.factor

   1 ! Copyright 2007, 2008 Ryan Murphy, Slava Pestov
   2 ! See http://factorcode.org/license.txt for BSD license.
   3
   4 USING: arrays kernel math namespaces tools.test
   5 heaps heaps.private math.parser random assocs sequences sorting
   6 accessors math.order ;
   7 IN: heaps.tests
   8
   9 [ <min-heap> heap-pop ] must-fail
  10 [ <max-heap> heap-pop ] must-fail
  11
  12 [ t ] [ <min-heap> heap-empty? ] unit-test
  13 [ f ] [ <min-heap> 1 t pick heap-push heap-empty? ] unit-test
  14 [ t ] [ <max-heap> heap-empty? ] unit-test
  15 [ f ] [ <max-heap> 1 t pick heap-push heap-empty? ] unit-test
  16
  17 ! Binary Min Heap
  18 { 1 2 3 4 5 6 } [ 0 left 0 right 1 left 1 right 2 left 2 right ] unit-test
  19 { t } [ t 5 f <entry> t 3 f <entry> T{ min-heap } heap-compare ] unit-test
  20 { f } [ t 5 f <entry> t 3 f <entry> T{ max-heap } heap-compare ] unit-test
  21
  22 [ 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
  24 [ 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
  26 [ 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
  28 [ 0 ] [ <max-heap> heap-size ] unit-test
  29 [ 1 ] [ <max-heap> t 1 pick heap-push heap-size ] unit-test
  30
  31 : heap-sort ( alist -- keys )
  32     <min-heap> [ heap-push-all ] keep heap-pop-all ;
  33
  34 : random-alist ( n -- alist )
  35     [
  36         [
  37             32 random-bits dup number>string swap set
  38         ] times
  39     ] H{ } make-assoc ;
  40
  41 : test-heap-sort ( n -- ? )
  42     random-alist dup >alist sort-keys swap heap-sort = ;
  43
  44 14 [
  45     [ t ] swap [ 2^ test-heap-sort ] curry unit-test
  46 ] each
  47
  48 : test-entry-indices ( n -- ? )
  49     random-alist
  50     <min-heap> [ heap-push-all ] keep
  51     data>> dup length swap [ index>> ] map sequence= ;
  52
  53 14 [
  54     [ t ] swap [ 2^ test-entry-indices ] curry unit-test
  55 ] each
  56
  57 : delete-random ( seq -- elt )
  58     dup length random dup pick nth >r swap delete-nth r> ;
  59
  60 : sort-entries ( entries -- entries' )
  61     [ [ key>> ] compare ] sort ;
  62
  63 : delete-test ( n -- ? )
  64     [
  65         random-alist
  66         <min-heap> [ heap-push-all ] keep
  67         dup data>> clone swap
  68     ] keep 3 /i [ 2dup >r delete-random r> heap-delete ] times
  69     data>>
  70     [ [ key>> ] map ] bi@
  71     [ natural-sort ] bi@ ;
  72
  73 11 [
  74     [ t ] swap [ 2^ delete-test sequence= ] curry unit-test
  75 ] each