extra/trees/avl/avl-tests.factor

   1 USING: kernel tools.test trees trees.avl math random sequences
   2 assocs accessors ;
   3 IN: trees.avl.tests
   4
   5 [ "key1" 0 "key2" 0 ] [
   6     T{ avl-node f "key1" f f T{ avl-node f "key2" f f 1 } 2 }
   7     [ single-rotate ] go-left
   8     [ left>> dup key>> swap balance>> ] keep
   9     dup key>> swap balance>>
  10 ] unit-test
  11
  12 [ "key1" 0 "key2" 0 ] [
  13     T{ avl-node f "key1" f f T{ avl-node f "key2" f f f 1 } 2 }
  14     [ select-rotate ] go-left
  15     [ left>> dup key>> swap balance>> ] keep
  16     dup key>> swap balance>>
  17 ] unit-test
  18
  19 [ "key1" 0 "key2" 0 ] [
  20     T{ avl-node f "key1" f T{ avl-node f "key2" f f f -1 } f -2 }
  21     [ single-rotate ] go-right
  22     [ right>> dup key>> swap balance>> ] keep
  23     dup key>> swap balance>>
  24 ] unit-test
  25
  26 [ "key1" 0 "key2" 0 ] [
  27     T{ avl-node f "key1" f T{ avl-node f "key2" f f f -1 } f -2 }
  28     [ select-rotate ] go-right
  29     [ right>> dup key>> swap balance>> ] keep
  30     dup key>> swap balance>>
  31 ] unit-test
  32
  33 [ "key1" -1 "key2" 0 "key3" 0 ]
  34 [ T{ avl-node f "key1" f f
  35         T{ avl-node f "key2" f
  36             T{ avl-node f "key3" f f f 1 } f -1 } 2 }
  37     [ double-rotate ] go-left
  38     [ left>> dup key>> swap balance>> ] keep
  39     [ right>> dup key>> swap balance>> ] keep
  40     dup key>> swap balance>> ] unit-test
  41 [ "key1" 0 "key2" 0 "key3" 0 ]
  42 [ T{ avl-node f "key1" f f
  43         T{ avl-node f "key2" f
  44             T{ avl-node f "key3" f f f 0 } f -1 } 2 }
  45     [ double-rotate ] go-left
  46     [ left>> dup key>> swap balance>> ] keep
  47     [ right>> dup key>> swap balance>> ] keep
  48     dup key>> swap balance>> ] unit-test
  49 [ "key1" 0 "key2" 1 "key3" 0 ]
  50 [ T{ avl-node f "key1" f f
  51         T{ avl-node f "key2" f
  52             T{ avl-node f "key3" f f f -1 } f -1 } 2 }
  53     [ double-rotate ] go-left
  54     [ left>> dup key>> swap balance>> ] keep
  55     [ right>> dup key>> swap balance>> ] keep
  56     dup key>> swap balance>> ] unit-test
  57
  58 [ "key1" 1 "key2" 0 "key3" 0 ]
  59 [ T{ avl-node f "key1" f
  60         T{ avl-node f "key2" f f
  61             T{ avl-node f "key3" f f f -1 } 1 } f -2 }
  62     [ double-rotate ] go-right
  63     [ right>> dup key>> swap balance>> ] keep
  64     [ left>> dup key>> swap balance>> ] keep
  65     dup key>> swap balance>> ] unit-test
  66 [ "key1" 0 "key2" 0 "key3" 0 ]
  67 [ T{ avl-node f "key1" f
  68         T{ avl-node f "key2" f f
  69             T{ avl-node f "key3" f f f 0 } 1 } f -2 }
  70     [ double-rotate ] go-right
  71     [ right>> dup key>> swap balance>> ] keep
  72     [ left>> dup key>> swap balance>> ] keep
  73     dup key>> swap balance>> ] unit-test
  74 [ "key1" 0 "key2" -1 "key3" 0 ]
  75 [ T{ avl-node f "key1" f
  76         T{ avl-node f "key2" f f
  77             T{ avl-node f "key3" f f f 1 } 1 } f -2 }
  78     [ double-rotate ] go-right
  79     [ right>> dup key>> swap balance>> ] keep
  80     [ left>> dup key>> swap balance>> ] keep
  81     dup key>> swap balance>> ] unit-test
  82
  83 [ "eight" ] [
  84     <avl> "seven" 7 pick set-at
  85     "eight" 8 pick set-at "nine" 9 pick set-at
  86     root>> value>>
  87 ] unit-test
  88
  89 [ "another eight" ] [ ! ERROR!
  90     <avl> "seven" 7 pick set-at
  91     "another eight" 8 pick set-at 8 swap at
  92 ] unit-test
  93
  94 : test-tree ( -- tree )
  95     AVL{
  96         { 7 "seven" }
  97         { 9 "nine" }
  98         { 4 "four" }
  99         { 4 "replaced four" }
 100         { 7 "replaced seven" }
 101     } clone ;
 102
 103 ! test set-at, at, at*
 104 [ t ] [ test-tree avl? ] unit-test
 105 [ "seven" ] [ <avl> "seven" 7 pick set-at 7 swap at ] unit-test
 106 [ "seven" t ] [ <avl> "seven" 7 pick set-at 7 swap at* ] unit-test
 107 [ f f ] [ <avl> "seven" 7 pick set-at 8 swap at* ] unit-test
 108 [ "seven" ] [ <avl> "seven" 7 pick set-at 7 swap at ] unit-test
 109 [ "replacement" ] [ <avl> "seven" 7 pick set-at "replacement" 7 pick set-at 7 swap at ] unit-test
 110 [ "nine" ] [ test-tree 9 swap at ] unit-test
 111 [ "replaced four" ] [ test-tree 4 swap at ] unit-test
 112 [ "replaced seven" ] [ test-tree 7 swap at ] unit-test
 113
 114 ! test delete-at--all errors!
 115 [ f ] [ test-tree 9 over delete-at 9 swap at ] unit-test
 116 [ "replaced seven" ] [ test-tree 9 over delete-at 7 swap at ] unit-test
 117 [ "nine" ] [ test-tree 7 over delete-at 4 over delete-at 9 swap at ] unit-test