/extra/quadtrees/quadtrees-tests.factor

http://github.com/abeaumont/factor · Factor · 241 lines · 216 code · 24 blank · 1 comment · 0 complexity · 2ff6195ec48525dd9d6a55dfca454bae MD5 · raw file 

    

  1. ! (c) 2009 Joe Groff, see BSD license
    2. 

  2. USING: accessors assocs kernel tools.test quadtrees math.rectangles sorting ;
    3. 

  3. IN: quadtrees.tests
    4. 

  4. 

  5. : unit-bounds ( -- rect ) { -1.0 -1.0 } { 2.0 2.0 } <rect> ;
    6. 

  6. 

  7. : value>>key ( assoc value key -- assoc )
    8. 

  8.     pick set-at ; inline
    9. 

  9. : delete>>key ( assoc key -- assoc )
    10. 

  10.     over delete-at ; inline
    11. 

  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. 

  13. [
    14. 

  14.     unit-bounds <quadtree>
    15. 

  15.         "a" {  0.0  -0.25 } value>>key
    16. 

  16. ] unit-test
    17. 

  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. 

  19. [
    20. 

  20.     unit-bounds <quadtree>
    21. 

  21.         "a" {  0.0  -0.25 } value>>key
    22. 

  22.         "b" {  0.0  -0.25 } value>>key
    23. 

  23. ] unit-test
    24. 

  24. 

  25. [ T{ quadtree f T{ rect f { -1.0 -1.0 } { 2.0 2.0 } } f f
    26. 

  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. 

  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. 

  28.     T{ quadtree f T{ rect f { -1.0  0.0 } { 1.0 1.0 } } f               f   f f f f t }
    29. 

  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. 

  30.     f 
    31. 

  31. } ] [
    32. 

  32.     unit-bounds <quadtree>
    33. 

  33.         "a" {  0.0  -0.25 } value>>key
    34. 

  34.         "b" {  0.25  0.25 } value>>key
    35. 

  35.         "c" { -0.5  -0.75 } value>>key
    36. 

  36. ] unit-test
    37. 

  37. 

  38. [ T{ quadtree f T{ rect f { -1.0 -1.0 } { 2.0 2.0 } } f f
    39. 

  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. 

  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. 

  41.     T{ quadtree f T{ rect f { -1.0  0.0 } { 1.0 1.0 } } f               f   f f f f t }
    42. 

  42.     T{ quadtree f T{ rect f {  0.0  0.0 } { 1.0 1.0 } } f f
    43. 

  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. 

  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. 

  45.         T{ quadtree f T{ rect f {  0.0  0.5 } { 0.5 0.5 } } f               f   f f f f t }
    46. 

  46.         T{ quadtree f T{ rect f {  0.5  0.5 } { 0.5 0.5 } } f               f   f f f f t }
    47. 

  47.     }
    48. 

  48.     f
    49. 

  49. } ] [
    50. 

  50.     unit-bounds <quadtree>
    51. 

  51.         "a" {  0.0  -0.25 } value>>key
    52. 

  52.         "b" {  0.25  0.25 } value>>key
    53. 

  53.         "c" { -0.5  -0.75 } value>>key
    54. 

  54.         "d" {  0.75  0.25 } value>>key
    55. 

  55. ] unit-test
    56. 

  56. 

  57. [ "b" t ] [
    58. 

  58.     unit-bounds <quadtree>
    59. 

  59.         "a" {  0.0  -0.25 } value>>key
    60. 

  60.         "b" {  0.25  0.25 } value>>key
    61. 

  61.         "c" { -0.5  -0.75 } value>>key
    62. 

  62.         "d" {  0.75  0.25 } value>>key
    63. 

  63. 

  64.     {  0.25  0.25 } swap at*
    65. 

  65. ] unit-test
    66. 

  66. 

  67. [ f f ] [
    68. 

  68.     unit-bounds <quadtree>
    69. 

  69.         "a" {  0.0  -0.25 } value>>key
    70. 

  70.         "b" {  0.25  0.25 } value>>key
    71. 

  71.         "c" { -0.5  -0.75 } value>>key
    72. 

  72.         "d" {  0.75  0.25 } value>>key
    73. 

  73. 

  74.     {  1.0   1.0  } swap at*
    75. 

  75. ] unit-test
    76. 

  76. 

  77. [ { "a" "c" } ] [
    78. 

  78.     unit-bounds <quadtree>
    79. 

  79.         "a" {  0.0  -0.25 } value>>key
    80. 

  80.         "b" {  0.25  0.25 } value>>key
    81. 

  81.         "c" { -0.5  -0.75 } value>>key
    82. 

  82.         "d" {  0.75  0.25 } value>>key
    83. 

  83. 

  84.     { -0.6 -0.8 } { 0.8 1.0 } <rect> swap in-rect natural-sort
    85. 

  85. ] unit-test
    86. 

  86. 

  87. [ T{ quadtree f T{ rect f { -1.0 -1.0 } { 2.0 2.0 } } f f
    88. 

  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. 

  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. 

  90.     T{ quadtree f T{ rect f { -1.0  0.0 } { 1.0 1.0 } } f               f   f f f f t }
    91. 

  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. 

  92.     f
    93. 

  93. } ] [
    94. 

  94.     unit-bounds <quadtree>
    95. 

  95.         "a" {  0.0  -0.25 } value>>key
    96. 

  96.         "b" {  0.25  0.25 } value>>key
    97. 

  97.         "c" { -0.5  -0.75 } value>>key
    98. 

  98.         "d" {  0.75  0.25 } value>>key
    99. 

  99. 

  100.         {  0.25  0.25 } delete>>key
    101. 

  101.         prune-quadtree
    102. 

  102. ] unit-test
    103. 

  103. 

  104. [ T{ quadtree f T{ rect f { -1.0 -1.0 } { 2.0 2.0 } } f f
    105. 

  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. 

  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. 

  107.     T{ quadtree f T{ rect f { -1.0  0.0 } { 1.0 1.0 } } f               f   f f f f t }
    108. 

  108.     T{ quadtree f T{ rect f {  0.0  0.0 } { 1.0 1.0 } } f               f   f f f f t }
    109. 

  109.     f
    110. 

  110. } ] [
    111. 

  111.     unit-bounds <quadtree>
    112. 

  112.         "a" {  0.0  -0.25 } value>>key
    113. 

  113.         "b" {  0.25  0.25 } value>>key
    114. 

  114.         "c" { -0.5  -0.75 } value>>key
    115. 

  115.         "d" {  0.75  0.25 } value>>key
    116. 

  116. 

  117.         {  0.25  0.25 } delete>>key
    118. 

  118.         {  0.75  0.25 } delete>>key
    119. 

  119.         prune-quadtree
    120. 

  120. ] unit-test
    121. 

  121. 

  122. [ T{ quadtree f T{ rect f { -1.0 -1.0 } { 2.0 2.0 } } f f
    123. 

  123.     T{ quadtree f T{ rect f { -1.0 -1.0 } { 1.0 1.0 } } f f
    124. 

  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. 

  125.         T{ quadtree f T{ rect f { -0.5 -1.0 } { 0.5 0.5 } } f               f   f f f f t }
    126. 

  126.         T{ quadtree f T{ rect f { -1.0 -0.5 } { 0.5 0.5 } } f               f   f f f f t }
    127. 

  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. 

  128.         f
    129. 

  129.     }
    130. 

  130.     T{ quadtree f T{ rect f {  0.0 -1.0 } { 1.0 1.0 } } f f
    131. 

  131.         T{ quadtree f T{ rect f {  0.0 -1.0 } { 0.5 0.5 } } f               f   f f f f t }
    132. 

  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. 

  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. 

  134.         T{ quadtree f T{ rect f {  0.5 -0.5 } { 0.5 0.5 } } f               f   f f f f t }
    135. 

  135.         f
    136. 

  136.     }
    137. 

  137.     T{ quadtree f T{ rect f { -1.0  0.0 } { 1.0 1.0 } } f f
    138. 

  138.         T{ quadtree f T{ rect f { -1.0  0.0 } { 0.5 0.5 } } f               f   f f f f t }
    139. 

  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. 

  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. 

  141.         T{ quadtree f T{ rect f { -0.5  0.5 } { 0.5 0.5 } } f               f   f f f f t }
    142. 

  142.         f
    143. 

  143.     }
    144. 

  144.     T{ quadtree f T{ rect f {  0.0  0.0 } { 1.0 1.0 } } f f
    145. 

  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. 

  146.         T{ quadtree f T{ rect f {  0.5  0.0 } { 0.5 0.5 } } f               f   f f f f t }
    147. 

  147.         T{ quadtree f T{ rect f {  0.0  0.5 } { 0.5 0.5 } } f               f   f f f f t }
    148. 

  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. 

  149.         f
    150. 

  150.     }
    151. 

  151.     f
    152. 

  152. } ] [
    153. 

  153.     unit-bounds <quadtree>
    154. 

  154.         "a" { -0.25 -0.25 } value>>key
    155. 

  155.         "b" { -0.75 -0.75 } value>>key
    156. 

  156.         "c" { -0.25  0.25 } value>>key
    157. 

  157.         "d" { -0.75  0.75 } value>>key
    158. 

  158.         "e" {  0.25 -0.25 } value>>key
    159. 

  159.         "f" {  0.75 -0.75 } value>>key
    160. 

  160.         "g" {  0.25  0.25 } value>>key
    161. 

  161.         "h" {  0.75  0.75 } value>>key
    162. 

  162. 

  163.         prune-quadtree
    164. 

  164. ] unit-test
    165. 

  165. 

  166. [ 8 ] [
    167. 

  167.     unit-bounds <quadtree>
    168. 

  168.         "a" { -0.25 -0.25 } value>>key
    169. 

  169.         "b" { -0.75 -0.75 } value>>key
    170. 

  170.         "c" { -0.25  0.25 } value>>key
    171. 

  171.         "d" { -0.75  0.75 } value>>key
    172. 

  172.         "e" {  0.25 -0.25 } value>>key
    173. 

  173.         "f" {  0.75 -0.75 } value>>key
    174. 

  174.         "g" {  0.25  0.25 } value>>key
    175. 

  175.         "h" {  0.75  0.75 } value>>key
    176. 

  176. 

  177.         assoc-size
    178. 

  178. ] unit-test
    179. 

  179. 

  180. [ {
    181. 

  181.     { { -0.75 -0.75 } "b" }
    182. 

  182.     { { -0.75  0.75 } "d" }
    183. 

  183.     { { -0.25 -0.25 } "a" }
    184. 

  184.     { { -0.25  0.25 } "c" }
    185. 

  185.     { {  0.25 -0.25 } "e" }
    186. 

  186.     { {  0.25  0.25 } "g" }
    187. 

  187.     { {  0.75 -0.75 } "f" }
    188. 

  188.     { {  0.75  0.75 } "h" }
    189. 

  189. } ] [
    190. 

  190.     unit-bounds <quadtree>
    191. 

  191.         "a" { -0.25 -0.25 } value>>key
    192. 

  192.         "b" { -0.75 -0.75 } value>>key
    193. 

  193.         "c" { -0.25  0.25 } value>>key
    194. 

  194.         "d" { -0.75  0.75 } value>>key
    195. 

  195.         "e" {  0.25 -0.25 } value>>key
    196. 

  196.         "f" {  0.75 -0.75 } value>>key
    197. 

  197.         "g" {  0.25  0.25 } value>>key
    198. 

  198.         "h" {  0.75  0.75 } value>>key
    199. 

  199. 

  200.         >alist natural-sort
    201. 

  201. ] unit-test
    202. 

  202. 

  203. TUPLE: pointy-thing center ;
    204. 

  204. 

  205. [ {
    206. 

  206.     T{ pointy-thing f { 0 0 } }
    207. 

  207.     T{ pointy-thing f { 1 0 } }
    208. 

  208.     T{ pointy-thing f { 0 1 } }
    209. 

  209.     T{ pointy-thing f { 1 1 } }
    210. 

  210.     T{ pointy-thing f { 2 0 } }
    211. 

  211.     T{ pointy-thing f { 3 0 } }
    212. 

  212.     T{ pointy-thing f { 2 1 } }
    213. 

  213.     T{ pointy-thing f { 3 1 } }
    214. 

  214.     T{ pointy-thing f { 0 2 } }
    215. 

  215.     T{ pointy-thing f { 1 2 } }
    216. 

  216.     T{ pointy-thing f { 0 3 } }
    217. 

  217.     T{ pointy-thing f { 1 3 } }
    218. 

  218.     T{ pointy-thing f { 2 2 } }
    219. 

  219.     T{ pointy-thing f { 3 2 } }
    220. 

  220.     T{ pointy-thing f { 2 3 } }
    221. 

  221.     T{ pointy-thing f { 3 3 } }
    222. 

  222. } ] [
    223. 

  223.     {
    224. 

  224.         T{ pointy-thing f { 3 1 } }
    225. 

  225.         T{ pointy-thing f { 2 3 } }
    226. 

  226.         T{ pointy-thing f { 3 2 } }
    227. 

  227.         T{ pointy-thing f { 0 1 } }
    228. 

  228.         T{ pointy-thing f { 2 2 } }
    229. 

  229.         T{ pointy-thing f { 1 1 } }
    230. 

  230.         T{ pointy-thing f { 3 0 } }
    231. 

  231.         T{ pointy-thing f { 3 3 } }
    232. 

  232.         T{ pointy-thing f { 1 3 } }
    233. 

  233.         T{ pointy-thing f { 2 1 } }
    234. 

  234.         T{ pointy-thing f { 0 0 } }
    235. 

  235.         T{ pointy-thing f { 2 0 } }
    236. 

  236.         T{ pointy-thing f { 1 0 } }
    237. 

  237.         T{ pointy-thing f { 0 2 } }
    238. 

  238.         T{ pointy-thing f { 1 2 } }
    239. 

  239.         T{ pointy-thing f { 0 3 } }
    240. 

  240.     } [ center>> ] swizzle
    241. 

  241. ] unit-test
    242.