unmaintained/trees/avl/avl-tests.factor

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