extra/quadtrees/quadtrees-tests.factor

   1 ! (c) 2009 Joe Groff, see BSD license
   2 USING: accessors assocs kernel tools.test quadtrees math.rectangles sorting ;
   3 IN: 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 } ?of
  65 ] unit-test
  66
  67 { { 1.0 1.0 } 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  } ?of
  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
 203 TUPLE: 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