1 USING: kernel tools.test trees trees.avl math random sequences
2 assocs accessors trees.avl.private trees.private arrays ;
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>>
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>>
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>>
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>>
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
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
88 <avl> "seven" 7 pick set-at
89 "eight" 8 pick set-at "nine" 9 pick set-at
93 { "another eight" } [ ! ERROR!
94 <avl> "seven" 7 pick set-at
95 "another eight" 8 pick set-at 8 of
98 : test-tree ( -- tree )
103 { 4 "replaced four" }
104 { 7 "replaced seven" }
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
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
124 { 3 } [ test-tree assoc-size ] unit-test
125 { 2 } [ test-tree 9 over delete-at assoc-size ] unit-test
127 ! test that converting from a balanced tree doesn't reshape
129 { t } [ 10 iota >array reverse dup zip >avl dup >avl = ] unit-test