1 USING: kernel tools.test trees trees.avl math random sequences
2 assocs accessors trees.avl.private trees.private ;
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>>
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>>
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>>
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>>
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
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
84 <avl> "seven" 7 pick set-at
85 "eight" 8 pick set-at "nine" 9 pick set-at
89 { "another eight" } [ ! ERROR!
90 <avl> "seven" 7 pick set-at
91 "another eight" 8 pick set-at 8 of
94 : test-tree ( -- tree )
100 { 7 "replaced seven" }
103 ! test set-at, at, at*
104 { t } [ test-tree avl? ] unit-test
105 { "seven" } [ <avl> "seven" 7 pick set-at 7 of ] unit-test
106 { "seven" t } [ <avl> "seven" 7 pick set-at 7 ?of ] unit-test
107 { 8 f } [ <avl> "seven" 7 pick set-at 8 ?of ] unit-test
108 { "seven" } [ <avl> "seven" 7 pick set-at 7 of ] unit-test
109 { "replacement" } [ <avl> "seven" 7 pick set-at "replacement" 7 pick set-at 7 of ] unit-test
110 { "nine" } [ test-tree 9 of ] unit-test
111 { "replaced four" } [ test-tree 4 of ] unit-test
112 { "replaced seven" } [ test-tree 7 of ] unit-test
114 ! test delete-at--all errors!
115 { f } [ test-tree 9 over delete-at 9 of ] unit-test
116 { "replaced seven" } [ test-tree 9 over delete-at 7 of ] unit-test
117 { "nine" } [ test-tree 7 over delete-at 4 over delete-at 9 of ] unit-test