/extra/quadtrees/quadtrees-tests.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