|
1 | 1 | ;;;; network/quadtree.lisp |
2 | 2 | ;;;; |
3 | 3 | ;;;; A stock example for a quadtree networked family of couriers in a square grid. |
| 4 | +;;;; |
| 5 | +;;;; A typical family of quadtree routers looks like: |
| 6 | +;;;; |
| 7 | +;;;; +-+-+-+-+ +---+---+ +-------+ |
| 8 | +;;;; /A/B/C/D/ / / / / / |
| 9 | +;;;; +-+-+-+-+ / 1 / 2 / / / |
| 10 | +;;;; /E/F/G/H/ / / / / / |
| 11 | +;;;; +-+-+-+-+ +---+---+ / TOP / |
| 12 | +;;;; /I/J/K/L/ / / / / / |
| 13 | +;;;; +-+-+-+-+ / 3 / 4 / / / |
| 14 | +;;;; /M/N/O/P/ / / / / / |
| 15 | +;;;; +-+-+-+-+ +---+---+ +-------+ |
| 16 | +;;;; |
| 17 | +;;;; where each cell contains a router which is connected to the cell immediately above it in the |
| 18 | +;;;; hierarchy (i.e., to the right) with which contains it and to all the cells immediately below it |
| 19 | +;;;; in the hierarchy (i.e., to the left) which are contained by it. |
| 20 | +;;;; |
| 21 | +;;;; Message routing follows containments rather than spatial structure. For instance, a message |
| 22 | +;;;; sent from A to P takes the following steps: |
| 23 | +;;;; * Inspect A's routing table, which only has an upward connection. Follow it and deliver the |
| 24 | +;;;; message to 1. |
| 25 | +;;;; * Inspect 1's routing table, which has links to A, B, E, F, and upward. P is not contained in |
| 26 | +;;;; any of the downward directions, so default to the upward direction. Follow it and deliver |
| 27 | +;;;; the message to TOP. |
| 28 | +;;;; * Inspect TOP's routing table, which has links to 1, 2, 3, and 4. P is contained in 4, so |
| 29 | +;;;; deliver the message to 4. |
| 30 | +;;;; * Inspect 4's routing table, which has has links to K, L, O, P, and an upward link back to TOP. |
| 31 | +;;;; P is contained in P, so deliver the message to P. |
4 | 32 |
|
5 | 33 | (in-package #:aether) |
6 | 34 |
|
@@ -41,18 +69,26 @@ Returns a VALUES pair: the 2d array of leaf routers (to use as the local courier |
41 | 69 | (make-courier-quadtree-rectangle rectangle nil))) |
42 | 70 |
|
43 | 71 | (defun make-courier-quadtree-rectangle (rectangle parent) |
44 | | - "Makes one quadtree router and its children." |
| 72 | + "Makes one quadtree router and its children. |
| 73 | +
|
| 74 | +Returns a VALUES pair: the 2d array of leaf routers (to use as the local courier for worker processes), then the list of *all* routers (to use to prime the simulator)." |
| 75 | + ;; this actual routine is only responsible for generating the 'root' router. |
| 76 | + ;; all the other routers in the tree are deferred to recursive calls. |
45 | 77 | (with-slots ((max-x right) (max-y top) (min-x left) (min-y bottom)) rectangle |
46 | 78 | (assert (<= min-x max-x)) |
47 | 79 | (assert (<= min-y max-y)) |
48 | | - (let ((courier (%make-courier-quadtree :links `((:otherwise ,parent)))) |
49 | | - (half-width (floor (/ (- max-x min-x) 2))) |
50 | | - (half-height (floor (/ (- max-y min-y) 2))) |
51 | | - subrectangles |
52 | | - ;; NOTE: this is so that :otherwise has lowest precedence order. |
53 | | - ;; could also handle this as a slot on courier-quadtree, which might be nicer. |
54 | | - (leaf-courier-array (make-array `(,(1+ (- max-x min-x)) ,(1+ (- max-y min-y))))) |
55 | | - (flat-courier-list '())) |
| 80 | + ;; the strategy is to divide RECTANGLE up into quarters, stored in SUBRECTANGLES. |
| 81 | + ;; the relevant edge case is when RECTANGLE has width or height 1, in which case subdivision |
| 82 | + ;; doesn't make sense. |
| 83 | + (initialize-and-return |
| 84 | + ((courier (%make-courier-quadtree :links `((:otherwise ,parent)))) |
| 85 | + (half-width (floor (/ (- max-x min-x) 2))) |
| 86 | + (half-height (floor (/ (- max-y min-y) 2))) |
| 87 | + subrectangles |
| 88 | + (flat-courier-list '()) |
| 89 | + ;; NOTE: this is so that :otherwise has lowest precedence order. |
| 90 | + ;; could also handle this as a slot on courier-quadtree, which might be nicer. |
| 91 | + (leaf-courier-array (make-array `(,(1+ (- max-x min-x)) ,(1+ (- max-y min-y)))))) |
56 | 92 | (cond |
57 | 93 | ((and (= max-x min-x) (= max-y min-y)) |
58 | 94 | nil) |
@@ -95,29 +131,39 @@ Returns a VALUES pair: the 2d array of leaf routers (to use as the local courier |
95 | 131 | :left (+ 1 min-x half-width) |
96 | 132 | :bottom (+ 1 min-y half-height)))))) |
97 | 133 |
|
| 134 | + ;; having partitioned RECTANGLE into SUBRECTANGLES, we: |
| 135 | + ;; * recursively build sub-quadtrees for each subrectangle. |
| 136 | + ;; * stash the root of each sub-quadtree for the routing table at the router we're building. |
98 | 137 | (dolist (sr subrectangles) |
99 | 138 | (with-slots ((submax-x right) (submax-y top) (submin-x left) (submin-y bottom)) sr |
| 139 | + ;; each of these calls generates the advertised VALUES pair: |
| 140 | + ;; a 2D array of leaf routers and a flat list of all routers in the subtree. |
100 | 141 | (multiple-value-bind (subcourier-array subcourier-list) |
101 | 142 | (make-courier-quadtree-rectangle |
102 | 143 | (make-rectangle :left submin-x :right submax-x |
103 | 144 | :bottom submin-y :top submax-y) |
104 | 145 | courier) |
| 146 | + ;; stash the routing table entry |
105 | 147 | (push `(,sr ,(first subcourier-list)) (courier-quadtree-links courier)) |
| 148 | + ;; accrue onto the flat list of all routers |
106 | 149 | (setf flat-courier-list (nconc subcourier-list flat-courier-list)) |
| 150 | + ;; copy the 2D array of sub-leaf-routers into the relevant subarray of leaf routers |
107 | 151 | (dotimes (i (1+ (- submax-x submin-x))) |
108 | 152 | (dotimes (j (1+ (- submax-y submin-y))) |
109 | 153 | (setf (aref leaf-courier-array (+ submin-x i (- min-x)) (+ submin-y j (- min-y))) |
110 | 154 | (aref subcourier-array i j))))))) |
111 | 155 |
|
| 156 | + ;; base case: we add the router we're constructing to the two data structures to return. |
| 157 | + ;; we always belong in the flat list of all routers. |
112 | 158 | (push courier flat-courier-list) |
113 | | - ;; base case: poke ourselves into the array as a leaf |
| 159 | + ;; and, if we're a leaf (i.e., we have no subrectangles), we belong in the 2D array. |
114 | 160 | (unless subrectangles |
115 | 161 | (setf (aref leaf-courier-array 0 0) courier |
116 | | - (courier-id courier) `(,min-x ,min-y))) |
117 | | - (values leaf-courier-array flat-courier-list)))) |
| 162 | + (courier-id courier) `(,min-x ,min-y)))))) |
118 | 163 |
|
119 | 164 | (defmethod courier-courier->route ((processing-courier courier-quadtree) destination-courier-id) |
120 | 165 | "Routes according to a rectangle-membership-based routing table." |
| 166 | + |
121 | 167 | (loop :for (rect link) :in (courier-quadtree-links processing-courier) |
122 | 168 | :when (rectangle-member? rect destination-courier-id) |
123 | 169 | :do (return-from courier-courier->route link)) |
|
0 commit comments