PageRenderTime 87ms CodeModel.GetById 1ms app.highlight 82ms RepoModel.GetById 1ms app.codeStats 0ms

/extra/quadtrees/quadtrees-tests.factor

http://github.com/abeaumont/factor
Unknown | 241 lines | 217 code | 24 blank | 0 comment | 0 complexity | 2ff6195ec48525dd9d6a55dfca454bae MD5 | raw file
  1! (c) 2009 Joe Groff, see BSD license
  2USING: accessors assocs kernel tools.test quadtrees math.rectangles sorting ;
  3IN: quadtrees.tests
  4
  5: unit-bounds ( -- rect ) { -1.0 -1.0 } { 2.0 2.0 } <rect> ;
  6
  7: value>>key ( assoc value key -- assoc )
  8    pick set-at ; inline
  9: delete>>key ( assoc key -- assoc )
 10    over delete-at ; inline
 11
 12[ T{ quadtree f T{ rect f { -1.0 -1.0 } { 2.0 2.0 } } {  0.0  -0.25 } "a" f f f f t } ]
 13[
 14    unit-bounds <quadtree>
 15        "a" {  0.0  -0.25 } value>>key
 16] unit-test
 17
 18[ T{ quadtree f T{ rect f { -1.0 -1.0 } { 2.0 2.0 } } {  0.0  -0.25 } "b" f f f f t } ]
 19[
 20    unit-bounds <quadtree>
 21        "a" {  0.0  -0.25 } value>>key
 22        "b" {  0.0  -0.25 } value>>key
 23] unit-test
 24
 25[ T{ quadtree f T{ rect f { -1.0 -1.0 } { 2.0 2.0 } } f f
 26    T{ quadtree f T{ rect f { -1.0 -1.0 } { 1.0 1.0 } } { -0.5  -0.75 } "c" f f f f t }
 27    T{ quadtree f T{ rect f {  0.0 -1.0 } { 1.0 1.0 } } {  0.0  -0.25 } "a" f f f f t }
 28    T{ quadtree f T{ rect f { -1.0  0.0 } { 1.0 1.0 } } f               f   f f f f t }
 29    T{ quadtree f T{ rect f {  0.0  0.0 } { 1.0 1.0 } } {  0.25  0.25 } "b" f f f f t }
 30    f 
 31} ] [
 32    unit-bounds <quadtree>
 33        "a" {  0.0  -0.25 } value>>key
 34        "b" {  0.25  0.25 } value>>key
 35        "c" { -0.5  -0.75 } value>>key
 36] unit-test
 37
 38[ T{ quadtree f T{ rect f { -1.0 -1.0 } { 2.0 2.0 } } f f
 39    T{ quadtree f T{ rect f { -1.0 -1.0 } { 1.0 1.0 } } { -0.5  -0.75 } "c" f f f f t }
 40    T{ quadtree f T{ rect f {  0.0 -1.0 } { 1.0 1.0 } } {  0.0  -0.25 } "a" f f f f t }
 41    T{ quadtree f T{ rect f { -1.0  0.0 } { 1.0 1.0 } } f               f   f f f f t }
 42    T{ quadtree f T{ rect f {  0.0  0.0 } { 1.0 1.0 } } f f
 43        T{ quadtree f T{ rect f {  0.0  0.0 } { 0.5 0.5 } } {  0.25  0.25 } "b" f f f f t }
 44        T{ quadtree f T{ rect f {  0.5  0.0 } { 0.5 0.5 } } {  0.75  0.25 } "d" f f f f t }
 45        T{ quadtree f T{ rect f {  0.0  0.5 } { 0.5 0.5 } } f               f   f f f f t }
 46        T{ quadtree f T{ rect f {  0.5  0.5 } { 0.5 0.5 } } f               f   f f f f t }
 47    }
 48    f
 49} ] [
 50    unit-bounds <quadtree>
 51        "a" {  0.0  -0.25 } value>>key
 52        "b" {  0.25  0.25 } value>>key
 53        "c" { -0.5  -0.75 } value>>key
 54        "d" {  0.75  0.25 } value>>key
 55] unit-test
 56
 57[ "b" t ] [
 58    unit-bounds <quadtree>
 59        "a" {  0.0  -0.25 } value>>key
 60        "b" {  0.25  0.25 } value>>key
 61        "c" { -0.5  -0.75 } value>>key
 62        "d" {  0.75  0.25 } value>>key
 63
 64    {  0.25  0.25 } swap at*
 65] unit-test
 66
 67[ f f ] [
 68    unit-bounds <quadtree>
 69        "a" {  0.0  -0.25 } value>>key
 70        "b" {  0.25  0.25 } value>>key
 71        "c" { -0.5  -0.75 } value>>key
 72        "d" {  0.75  0.25 } value>>key
 73
 74    {  1.0   1.0  } swap at*
 75] unit-test
 76
 77[ { "a" "c" } ] [
 78    unit-bounds <quadtree>
 79        "a" {  0.0  -0.25 } value>>key
 80        "b" {  0.25  0.25 } value>>key
 81        "c" { -0.5  -0.75 } value>>key
 82        "d" {  0.75  0.25 } value>>key
 83
 84    { -0.6 -0.8 } { 0.8 1.0 } <rect> swap in-rect natural-sort
 85] unit-test
 86
 87[ T{ quadtree f T{ rect f { -1.0 -1.0 } { 2.0 2.0 } } f f
 88    T{ quadtree f T{ rect f { -1.0 -1.0 } { 1.0 1.0 } } { -0.5  -0.75 } "c" f f f f t }
 89    T{ quadtree f T{ rect f {  0.0 -1.0 } { 1.0 1.0 } } {  0.0  -0.25 } "a" f f f f t }
 90    T{ quadtree f T{ rect f { -1.0  0.0 } { 1.0 1.0 } } f               f   f f f f t }
 91    T{ quadtree f T{ rect f {  0.0  0.0 } { 1.0 1.0 } } {  0.75  0.25 } "d" f f f f t }
 92    f
 93} ] [
 94    unit-bounds <quadtree>
 95        "a" {  0.0  -0.25 } value>>key
 96        "b" {  0.25  0.25 } value>>key
 97        "c" { -0.5  -0.75 } value>>key
 98        "d" {  0.75  0.25 } value>>key
 99
100        {  0.25  0.25 } delete>>key
101        prune-quadtree
102] unit-test
103
104[ T{ quadtree f T{ rect f { -1.0 -1.0 } { 2.0 2.0 } } f f
105    T{ quadtree f T{ rect f { -1.0 -1.0 } { 1.0 1.0 } } { -0.5  -0.75 } "c" f f f f t }
106    T{ quadtree f T{ rect f {  0.0 -1.0 } { 1.0 1.0 } } {  0.0  -0.25 } "a" f f f f t }
107    T{ quadtree f T{ rect f { -1.0  0.0 } { 1.0 1.0 } } f               f   f f f f t }
108    T{ quadtree f T{ rect f {  0.0  0.0 } { 1.0 1.0 } } f               f   f f f f t }
109    f
110} ] [
111    unit-bounds <quadtree>
112        "a" {  0.0  -0.25 } value>>key
113        "b" {  0.25  0.25 } value>>key
114        "c" { -0.5  -0.75 } value>>key
115        "d" {  0.75  0.25 } value>>key
116
117        {  0.25  0.25 } delete>>key
118        {  0.75  0.25 } delete>>key
119        prune-quadtree
120] unit-test
121
122[ T{ quadtree f T{ rect f { -1.0 -1.0 } { 2.0 2.0 } } f f
123    T{ quadtree f T{ rect f { -1.0 -1.0 } { 1.0 1.0 } } f f
124        T{ quadtree f T{ rect f { -1.0 -1.0 } { 0.5 0.5 } } { -0.75 -0.75 } "b" f f f f t }
125        T{ quadtree f T{ rect f { -0.5 -1.0 } { 0.5 0.5 } } f               f   f f f f t }
126        T{ quadtree f T{ rect f { -1.0 -0.5 } { 0.5 0.5 } } f               f   f f f f t }
127        T{ quadtree f T{ rect f { -0.5 -0.5 } { 0.5 0.5 } } { -0.25 -0.25 } "a" f f f f t }
128        f
129    }
130    T{ quadtree f T{ rect f {  0.0 -1.0 } { 1.0 1.0 } } f f
131        T{ quadtree f T{ rect f {  0.0 -1.0 } { 0.5 0.5 } } f               f   f f f f t }
132        T{ quadtree f T{ rect f {  0.5 -1.0 } { 0.5 0.5 } } {  0.75 -0.75 } "f" f f f f t }
133        T{ quadtree f T{ rect f {  0.0 -0.5 } { 0.5 0.5 } } {  0.25 -0.25 } "e" f f f f t }
134        T{ quadtree f T{ rect f {  0.5 -0.5 } { 0.5 0.5 } } f               f   f f f f t }
135        f
136    }
137    T{ quadtree f T{ rect f { -1.0  0.0 } { 1.0 1.0 } } f f
138        T{ quadtree f T{ rect f { -1.0  0.0 } { 0.5 0.5 } } f               f   f f f f t }
139        T{ quadtree f T{ rect f { -0.5  0.0 } { 0.5 0.5 } } { -0.25  0.25 } "c" f f f f t }
140        T{ quadtree f T{ rect f { -1.0  0.5 } { 0.5 0.5 } } { -0.75  0.75 } "d" f f f f t }
141        T{ quadtree f T{ rect f { -0.5  0.5 } { 0.5 0.5 } } f               f   f f f f t }
142        f
143    }
144    T{ quadtree f T{ rect f {  0.0  0.0 } { 1.0 1.0 } } f f
145        T{ quadtree f T{ rect f {  0.0  0.0 } { 0.5 0.5 } } {  0.25  0.25 } "g" f f f f t }
146        T{ quadtree f T{ rect f {  0.5  0.0 } { 0.5 0.5 } } f               f   f f f f t }
147        T{ quadtree f T{ rect f {  0.0  0.5 } { 0.5 0.5 } } f               f   f f f f t }
148        T{ quadtree f T{ rect f {  0.5  0.5 } { 0.5 0.5 } } {  0.75  0.75 } "h" f f f f t }
149        f
150    }
151    f
152} ] [
153    unit-bounds <quadtree>
154        "a" { -0.25 -0.25 } value>>key
155        "b" { -0.75 -0.75 } value>>key
156        "c" { -0.25  0.25 } value>>key
157        "d" { -0.75  0.75 } value>>key
158        "e" {  0.25 -0.25 } value>>key
159        "f" {  0.75 -0.75 } value>>key
160        "g" {  0.25  0.25 } value>>key
161        "h" {  0.75  0.75 } value>>key
162
163        prune-quadtree
164] unit-test
165
166[ 8 ] [
167    unit-bounds <quadtree>
168        "a" { -0.25 -0.25 } value>>key
169        "b" { -0.75 -0.75 } value>>key
170        "c" { -0.25  0.25 } value>>key
171        "d" { -0.75  0.75 } value>>key
172        "e" {  0.25 -0.25 } value>>key
173        "f" {  0.75 -0.75 } value>>key
174        "g" {  0.25  0.25 } value>>key
175        "h" {  0.75  0.75 } value>>key
176
177        assoc-size
178] unit-test
179
180[ {
181    { { -0.75 -0.75 } "b" }
182    { { -0.75  0.75 } "d" }
183    { { -0.25 -0.25 } "a" }
184    { { -0.25  0.25 } "c" }
185    { {  0.25 -0.25 } "e" }
186    { {  0.25  0.25 } "g" }
187    { {  0.75 -0.75 } "f" }
188    { {  0.75  0.75 } "h" }
189} ] [
190    unit-bounds <quadtree>
191        "a" { -0.25 -0.25 } value>>key
192        "b" { -0.75 -0.75 } value>>key
193        "c" { -0.25  0.25 } value>>key
194        "d" { -0.75  0.75 } value>>key
195        "e" {  0.25 -0.25 } value>>key
196        "f" {  0.75 -0.75 } value>>key
197        "g" {  0.25  0.25 } value>>key
198        "h" {  0.75  0.75 } value>>key
199
200        >alist natural-sort
201] unit-test
202
203TUPLE: pointy-thing center ;
204
205[ {
206    T{ pointy-thing f { 0 0 } }
207    T{ pointy-thing f { 1 0 } }
208    T{ pointy-thing f { 0 1 } }
209    T{ pointy-thing f { 1 1 } }
210    T{ pointy-thing f { 2 0 } }
211    T{ pointy-thing f { 3 0 } }
212    T{ pointy-thing f { 2 1 } }
213    T{ pointy-thing f { 3 1 } }
214    T{ pointy-thing f { 0 2 } }
215    T{ pointy-thing f { 1 2 } }
216    T{ pointy-thing f { 0 3 } }
217    T{ pointy-thing f { 1 3 } }
218    T{ pointy-thing f { 2 2 } }
219    T{ pointy-thing f { 3 2 } }
220    T{ pointy-thing f { 2 3 } }
221    T{ pointy-thing f { 3 3 } }
222} ] [
223    {
224        T{ pointy-thing f { 3 1 } }
225        T{ pointy-thing f { 2 3 } }
226        T{ pointy-thing f { 3 2 } }
227        T{ pointy-thing f { 0 1 } }
228        T{ pointy-thing f { 2 2 } }
229        T{ pointy-thing f { 1 1 } }
230        T{ pointy-thing f { 3 0 } }
231        T{ pointy-thing f { 3 3 } }
232        T{ pointy-thing f { 1 3 } }
233        T{ pointy-thing f { 2 1 } }
234        T{ pointy-thing f { 0 0 } }
235        T{ pointy-thing f { 2 0 } }
236        T{ pointy-thing f { 1 0 } }
237        T{ pointy-thing f { 0 2 } }
238        T{ pointy-thing f { 1 2 } }
239        T{ pointy-thing f { 0 3 } }
240    } [ center>> ] swizzle
241] unit-test