extra/trees/avl/avl-tests.factor

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