0. #lang typed/racket
1.  
2. ; a naive hack at quadtrees
3. ; https://www.researchgate.net/profile/Raphael_Finkel/publication/220197855_Quad_Trees_A_Data_Structure_for_Retrieval_on_Composite_Keys/links/0c9605273bba2ece7b000000/Quad-Trees-A-Data-Structure-for-Retrieval-on-Composite-Keys.pdf
4.  
5. ; Mutually recursive with the Quadtree type. The node structure means that
6. ; every node has coordinates embedded, and four children, which may be nodes or nulls.
7. (struct node ([ NE : Quadtree ]
8.               [ NW : Quadtree ]
9.               [ SW : Quadtree ]
10.               [ SE : Quadtree ]
11.               [ coords : coordinate]))
12.  
13. ; A union type: a Quadtree will be null or a node.
14. (define-type Quadtree (U Null node))
15.  
16. ; I don't know if this will help the compiler optimize, but I figure we don't actually
17. ; need this to be an integer, so I'm limiting Quadenum to these five Symbol literals.
18. (define-type Quadenum (U 'NE 'NW 'SW 'SE 'self))
19.  
20. ; X and Y coordinates, since Quadtrees' composite keys are two-dimensional constructs.
21. (struct coordinate ([x : Integer] [y : Integer]))
22.  
23. ; The comparison function, it seems to me, is the beating heart at the center of quadtrees.
24. ; You just gotta discern which quadrant below a node to categorize a set of coordinates in.
25. ; Also, exact match/collisions.
26. (: coordinate-compare (-> coordinate coordinate Quadenum))
27. (define (coordinate-compare a b)
28.   (cond [(and (equal? (coordinate-x a) (coordinate-x b))
29.               (equal? (coordinate-y a) (coordinate-y b))) 'self]
30.         [(and (<= (coordinate-x a) (coordinate-x b))                 ; Why are some of these -or-equals?
31.               (< (coordinate-y a) (coordinate-y b))) 'NE]            ; To keep the tree perfectly balanced, as all things should be.
32.         [(and (> (coordinate-x a) (coordinate-x b))                  ; Otherwise, two quadrants would get all the luck.
33.               (<= (coordinate-y a) (coordinate-y b))) 'NW]           ; Any bias adds up and unbalances the tree.
34.         [(and (>= (coordinate-x a) (coordinate-x b))                 ; Therefore, each quadrant owns a cardinal direction of its own.
35.               (> (coordinate-y a) (coordinate-y b))) 'SW]
36.         [(and (< (coordinate-x a) (coordinate-x b))
37.               (>= (coordinate-y a) (coordinate-y b))) 'SE]
38.         [else (raise "How did you get here that is not how integers work")])) ; I am confident the other options are exhaustive.
39.  
40. ; Determine if a particular coordinate pair is a member of a quadtree.
41. (: quadtree-member? (-> Quadtree coordinate Boolean))
42. (define (quadtree-member? quadtree coords)
43.   (cond [(null? quadtree) #f] ; Nulls have no children.
44.         [else
45.          (let ([quadrant (coordinate-compare (node-coords quadtree) coords)])
46.            (cond [(equal? quadrant 'self) #t]
47.                  [else (quadtree-member? (map-directions quadtree quadrant) coords)]))]))
48.  
49. ; A mapping of struct accessor functions to the non-self enumerators returned by coordinate-compare.
50. (: map-directions (-> node Quadenum Quadtree))
51. (define (map-directions node quadenum)
52.   (cond [(equal? quadenum 'NE) (node-NE node)]
53.         [(equal? quadenum 'NW) (node-NW node)]
54.         [(equal? quadenum 'SW) (node-SW node)]
55.         [(equal? quadenum 'SE) (node-SE node)]
56.         [else (raise "Don't call this on yourself!!")])) ; Self should never get mapped to.
57.  
58. ; Insertion
59. ; Given a null Quadtree, return a new Quadtree with null children, containing the coordinates.
60. ; Given a Quadtree whose coordinates equal those supplied, return the original Quadtree.
61. ; Given a non-null, non-matching node, recursively traverse to a null child and return a new tree with the ocordinates at that location.
62. (: quadtree-insert (-> Quadtree coordinate node))
63. (define (quadtree-insert quadtree coords)
64.   (cond [(null? quadtree) (node null null null null coords)]                              ; You've landed: returning a new leaf on the tree.
65.         [(equal? 'self (coordinate-compare (node-coords quadtree) coords)) quadtree]      ; This quadtree contains the requested coordinates. Return original quadtree.
66.         [else
67.          (let* ([quadrant (coordinate-compare (node-coords quadtree) coords)]             ; The quadrant these coordinates belong to on quadtree.
68.                 [recurse (quadtree-insert (map-directions quadtree quadrant) coords)]     ; Reach down `quadrant' and hand up what's down there.
69.                 [NE (if (equal? quadrant 'NE) recurse (node-NE quadtree))]                ; Ensure correct arity when assembling this node's representation to hand up
70.                 [NW (if (equal? quadrant 'NW) recurse (node-NW quadtree))]                ; the stack. Only one of these will call 'recurse', and that one will
71.                 [SW (if (equal? quadrant 'SW) recurse (node-SW quadtree))]                ; be inserted into the final product in the correct field
72.                 [SE (if (equal? quadrant 'SE) recurse (node-SE quadtree))])
73.            (node NE NW SW SE (node-coords quadtree)))])) ; Here, we package up everything we know about the current Quadtree from this point down and send it up the recursion stack.
74.  
75.  
76. ; The above doesn't seem obviously wrong to me. However:
77. (node-coords (node-NE (quadtree-insert (quadtree-insert (quadtree-insert null (coordinate 0 0))  (coordinate 10 10)) (coordinate 20 20))))
78. ; This fails. Which is odd, because
79. ;(node? (node-NE (quadtree-insert (quadtree-insert (quadtree-insert null (coordinate 0 0))  (coordinate 10 10)) (coordinate 20 20))))
80. ; returns #t.  The type checker says there's a type mismatch because node-coords is expecting a node but is given a Quadtree.

=>