001 (ns ^{:doc " Utility functions needed by MicroWorld and, specifically, in the
002 interpretation of MicroWorld rule."
003 :author "Simon Brooke"}
004 mw-engine.utils
005 (:require [clojure.math.combinatorics :as combo]
006 [clojure.string :refer [join]]))
007
008 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
009 ;;;;
010 ;;;; mw-engine: the state/transition engine of MicroWorld.
011 ;;;;
012 ;;;; This program is free software; you can redistribute it and/or
013 ;;;; modify it under the terms of the GNU General Public License
014 ;;;; as published by the Free Software Foundation; either version 2
015 ;;;; of the License, or (at your option) any later version.
016 ;;;;
017 ;;;; This program is distributed in the hope that it will be useful,
018 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
019 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
020 ;;;; GNU General Public License for more details.
021 ;;;;
022 ;;;; You should have received a copy of the GNU General Public License
023 ;;;; along with this program; if not, write to the Free Software
024 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
025 ;;;; USA.
026 ;;;;
027 ;;;; Copyright (C) 2014 Simon Brooke
028 ;;;;
029 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
030
031 (defn member?
032 "Return 'true' if elt is a member of col, else 'false'."
033 [elt col]
034 (contains? (set col) elt))
035
036 (defn get-int-or-zero
037 "Return the value of this `property` from this `map` if it is a integer;
038 otherwise return zero."
039 [map property]
040 (let [value (map property)]
041 (if (integer? value) value 0)))
042
043 (defn init-generation
044 "Return a cell like this `cell`, but having a value for :generation, zero if
045 the cell passed had no integer value for generation, otherwise the value
046 taken from the cell passed. The `world` argument is present only for
047 consistency with the rule engine and is ignored."
048 [_ cell]
049 (merge cell {:generation (get-int-or-zero cell :generation)}))
050
051 (defn in-bounds
052 "True if x, y are in bounds for this world (i.e., there is a cell at x, y)
053 else false. *DEPRECATED*: it's a predicate, prefer `in-bounds?`.
054
055 * `world` a world as defined in [world.clj](mw-engine.world.html);
056 * `x` a number which may or may not be a valid x coordinate within that world;
057 * `y` a number which may or may not be a valid y coordinate within that world."
058 {:deprecated "1.1.7"}
059 [world x y]
060 (and (>= x 0) (>= y 0) (< y (count world)) (< x (count (first world)))))
061
062 (defn in-bounds?
063 "True if x, y are in bounds for this world (i.e., there is a cell at x, y)
064 else false.
065
066 * `world` a world as defined in [world.clj](mw-engine.world.html);
067 * `x` a number which may or may not be a valid x coordinate within that world;
068 * `y` a number which may or may not be a valid y coordinate within that world."
069 {:added "1.1.7"}
070 [world x y]
071 (and (>= x 0) (>= y 0) (< y (count world)) (< x (count (first world)))))
072
073 (defn map-world-n-n
074 "Wholly non-parallel map world implementation; see documentation for `map-world`."
075 ([world function]
076 (map-world-n-n world function nil))
077 ([world function additional-args]
078 (into []
079 (map (fn [row]
080 (into [] (map
081 #(apply function
082 (cons world (cons % additional-args)))
083 row)))
084 world))))
085
086
087 (defn map-world-p-p
088 "Wholly parallel map-world implementation; see documentation for `map-world`."
089 ([world function]
090 (map-world-p-p world function nil))
091 ([world function additional-args]
092 (into []
093 (pmap (fn [row]
094 (into [] (pmap
095 #(apply function
096 (cons world (cons % additional-args)))
097 row)))
098 world))))
099
100 (defn map-world
101 "Apply this `function` to each cell in this `world` to produce a new world.
102 the arguments to the function will be the world, the cell, and any
103 `additional-args` supplied. Note that we parallel map over rows but
104 just map over cells within a row. That's because it isn't worth starting
105 a new thread for each cell, but there may be efficiency gains in
106 running rows in parallel."
107 ([world function]
108 (map-world world function nil))
109 ([world function additional-args]
110 (into []
111 (pmap (fn [row]
112 (into [] (map
113 #(apply function
114 (cons world (cons % additional-args)))
115 row)))
116 world))))
117
118 (defn get-cell
119 "Return the cell a x, y in this world, if any.
120
121 * `world` a world as defined in [world.clj](mw-engine.world.html);
122 * `x` a number which may or may not be a valid x coordinate within that world;
123 * `y` a number which may or may not be a valid y coordinate within that world."
124 [world x y]
125 (when (in-bounds? world x y)
126 (nth (nth world y) x)))
127
128 (defn get-int
129 "Get the value of a property expected to be an integer from a map; if not
130 present (or not an integer) return 0.
131
132 * `map` a map;
133 * `key` a symbol or keyword, presumed to be a key into the `map`."
134 [map key]
135 (if (map? map)
136 (let [v (map key)]
137 (cond (and v (integer? v)) v
138 :else 0))
139 (throw (Exception. "No map passed?"))))
140
141 (defmacro get-num
142 "Get the value of a property expected to be a number from a map; if not
143 present (or not a number) return 0.
144
145 * `map` a map;
146 * `key` a symbol or keyword, presumed to be a key into the `map`."
147 [map key]
148 `(if (map? ~map)
149 (let [~'v (~map ~key)]
150 (cond (and ~'v (number? ~'v)) ~'v
151 :else 0))
152 (throw (Exception. "No map passed?"))))
153
154 (defn population
155 "Return the population of this species in this cell. Currently a synonym for
156 `get-int`, but may not always be (depending whether species are later
157 implemented as actors)
158
159 * `cell` a map;
160 * `species` a keyword representing a species which may populate that cell."
161 [cell species]
162 (get-int cell species))
163
164 (def memo-get-neighbours
165 "Memoised get neighbours is more efficient when running deeply recursive
166 algorithms on the same world. But it's less efficient when running the
167 engine in its normal iterative style, because then we will rarely call
168 get naighbours on the same cell of the same world twice."
169 (memoize
170 (fn [world x y depth]
171 (remove nil?
172 (map #(get-cell world (first %) (first (rest %)))
173 (remove #(= % (list x y))
174 (combo/cartesian-product
175 (range (- x depth) (+ x depth 1))
176 (range (- y depth) (+ y depth 1)))))))))
177
178 (defn get-neighbours
179 "Get the neighbours to distance depth of a cell in this world.
180
181 Several overloads:
182 * `world` a world, as described in [world.clj](mw-engine.world.html);
183 * `cell` a cell within that world
184 Gets immediate neighbours of the specified cell.
185
186 * `world` a world, as described in[world.clj](mw-engine.world.html);
187 * `cell` a cell within that world
188 * `depth` an integer representing the depth to search from the
189 `cell`
190 Gets neighbours within the specified distance of the cell.
191
192 * `world` a world, as described in[world.clj](mw-engine.world.html);
193 * `x` an integer representing an x coordinate in that world;
194 * `y` an integer representing an y coordinate in that world;
195 * `depth` an integer representing the distance from [x,y] that
196 should be searched
197 Gets the neighbours within the specified distance of the cell at
198 coordinates [x,y] in this world."
199 ([world x y depth]
200 (memo-get-neighbours world x y depth))
201 ([world cell depth]
202 (memo-get-neighbours world (:x cell) (:y cell) depth))
203 ([world cell]
204 (memo-get-neighbours world (:x cell) (:y cell) 1)))
205
206 (defn get-neighbours-with-property-value
207 "Get the neighbours to distance depth of the cell at x, y in this world which
208 have this value for this property.
209
210 * `world` a world, as described in [world.clj](mw-engine.world.html);
211 * `cell` a cell within that world;
212 * `depth` an integer representing the distance from [x,y] that
213 should be searched (optional);
214 * `property` a keyword representing a property of the neighbours;
215 * `value` a value of that property (or, possibly, the name of another);
216 * `op` a comparator function to use in place of `=` (optional).
217
218 It gets messy."
219 ([world x y depth property value op]
220 (filter
221 #(eval
222 (list op
223 (or (get % property) (get-int % property))
224 value))
225 (get-neighbours world x y depth)))
226 ([world x y depth property value]
227 (get-neighbours-with-property-value world x y depth property value =))
228 ([world cell depth property value]
229 (get-neighbours-with-property-value world (:x cell) (:y cell) depth
230 property value))
231 ([world cell property value]
232 (get-neighbours-with-property-value world cell 1
233 property value)))
234
235 (defn get-neighbours-with-state
236 "Get the neighbours to distance depth of the cell at x, y in this world which
237 have this state.
238
239 * `world` a world, as described in [world.clj](mw-engine.world.html);
240 * `cell` a cell within that world;
241 * `depth` an integer representing the distance from [x,y] that
242 should be searched;
243 * `state` a keyword representing a state in the world."
244 ([world x y depth state]
245 (filter #(= (:state %) state) (get-neighbours world x y depth)))
246 ([world cell depth state]
247 (get-neighbours-with-state world (:x cell) (:y cell) depth state))
248 ([world cell state]
249 (get-neighbours-with-state world cell 1 state)))
250
251 (defn get-least-cell
252 "Return the cell from among these `cells` which has the lowest numeric value
253 for this `property`."
254 [cells property]
255 (first (sort-by property (filter #(number? (property %)) cells))))
256
257 (defn get-most-cell
258 "Return the cell from among these `cells` which has the highest numeric value
259 for this `property`."
260 [cells property]
261 (last (sort-by property (filter #(number? (property %)) cells))))
262
263 (defn- set-cell-property
264 "If this `cell`s x and y properties are equal to these `x` and `y` values,
265 return a cell like this cell but with the value of this `property` set to
266 this `value`. Otherwise, just return this `cell`."
267 [cell x y property value]
268 (cond
269 (and (= x (:x cell)) (= y (:y cell)))
270 (merge cell {property value :rule "Set by user"})
271 :else cell))
272
273 (defn set-property
274 "Return a world like this `world` but with the value of exactly one `property`
275 of one `cell` changed to this `value`"
276 ([world cell property value]
277 (set-property world (:x cell) (:y cell) property value))
278 ([world x y property value]
279 (apply
280 vector ;; we want a vector of vectors, not a list of lists, for efficiency
281 (map
282 (fn [row]
283 (apply
284 vector
285 (map #(set-cell-property % x y property value)
286 row)))
287 world))))
288
289 (defn merge-cell
290 "Return a world like this `world`, but merge the values from this `cell` with
291 those from the cell in the world with the same co-ordinates"
292 [world cell]
293 (if (in-bounds? world (:x cell) (:y cell))
294 (map-world world
295 #(if
296 (and
297 (= (:x cell) (:x %2))
298 (= (:y cell) (:y %2)))
299 (merge %2 cell)
300 %2))
301 world))
302
303 (defn rule-type
304 "Return the rule-type of this compiled `rule`."
305 [rule]
306 (:rule-type (meta rule)))
307
308 (defn add-history-event
309 "If `cell` is non-nil, expect it to be a map representing a cell; add
310 to its history an an event recording the firing of this rule. If
311 `detail` is passed, treat it as a map of additional data to be
312 added to the event."
313 ([cell rule]
314 (when cell (add-history-event cell rule {})))
315 ([result rule detail]
316 (when result
317 (let [rule-meta (meta rule)
318 event {:rule (:source rule-meta)
319 :rule-type (:rule-type rule-meta)
320 :generation (get-int-or-zero
321 result
322 :generation)}
323 event' (if detail (merge event detail) event)]
324 (merge result
325 {:history (concat
326 (:history result)
327 (list event'))})))))
328
329 (defn- event-narrative [event]
330 (case (:rule-type event)
331 :production (:rule event)
332 :flow (format "%s %f units of %s %s %d,%d:\n %s"
333 (name (:direction event))
334 (:quantity event)
335 (:property event)
336 (if (= :sent (:direction event)) "to" "from")
337 (:x (:other event))
338 (:y (:other event))
339 (:rule event))))
340
341 (defn history-string
342 "Return the history of this `cell` as a string for presentation to the user."
343 [cell]
344 (join "\n"
345 (map #(format "%6d: %s" (:generation %) (event-narrative %))
346 (:history cell))))
347
348 (defn- extend-summary [summary rs rl event]
349 (str summary
350 (if rs (format "%d-%d (%d occurances): %s\n" rs
351 (:generation event)
352 rl
353 (event-narrative event))
354 (format "%d: %s\n" (:generation event)
355 (event-narrative event)))))
356
357 (defn summarise-history
358 "Return, as a string, a shorter summary of the history of this cell"
359 [cell]
360 (loop [history (rest (:history cell))
361 event (first (:history cell))
362 prev nil
363 rs nil
364 rl 0
365 summary ""]
366 (cond (nil? event) (extend-summary summary rs rl prev)
367 (= (:rule event) (:rule prev)) (recur
368 (rest history)
369 (first history)
370 event
371 (or rs (:generation event))
372 (inc rl)
373 summary)
374 :else (recur (rest history)
375 (first history)
376 event
377 nil
378 0
379 (extend-summary summary rs (inc rl) event)))))