001 (ns mw-engine.flow
002 "Allow flows of values between cells in the world.
003
004 The design here is: a flow object is a map with the following properties:
005
006 1. `:source`, whose value is a location;
007 2. `:destination`, whose value is a location;
008 3. `:property`, whose value is a keyword;
009 4. `:quantity`, whose value is a positive real number.
010
011 A location object is a map with the following properties:
012
013 1. `:x`, whose value is a natural number not greater than the extent of the world;
014 2. `:y`, whose value is a natural number not greater than the extent of the world.
015
016 To execute a flow is transfer the quantity specified of the property specified
017 from the cell at the source specified to the cell at the destination specified;
018 if the source doesn't have sufficient of the property, then all it has should
019 be transferred, but no more: properties to be flowed cannot be pulled negative.
020
021 Flowing values through the world is consequently a two stage process: firstly
022 there's a planning stage, in which all the flows to be executed are computed
023 without changing the world, and then an execution stage, where they're all
024 executed. This namespace deals with mainly with execution."
025 (:require [mw-engine.utils :refer [add-history-event get-cell get-num
026 in-bounds? map-world merge-cell rule-type]]
027 [taoensso.timbre :refer [info warn]]))
028
029 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
030 ;;;;
031 ;;;; mw-engine: the state/transition engine of MicroWorld.
032 ;;;;
033 ;;;; This program is free software; you can redistribute it and/or
034 ;;;; modify it under the terms of the GNU General Public License
035 ;;;; as published by the Free Software Foundation; either version 2
036 ;;;; of the License, or (at your option) any later version.
037 ;;;;
038 ;;;; This program is distributed in the hope that it will be useful,
039 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
040 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
041 ;;;; GNU General Public License for more details.
042 ;;;;
043 ;;;; You should have received a copy of the GNU General Public License
044 ;;;; along with this program; if not, write to the Free Software
045 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
046 ;;;; USA.
047 ;;;;
048 ;;;; Copyright (C) 2014 Simon Brooke
049 ;;;;
050 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
051
052 (defn coordinate?
053 "Return `true` if this object `o` is a valid coordinate with respect to
054 this `world`, else `false`. Assumes square worlds."
055 [o world]
056 (try
057 (and (or (zero? o) (pos-int? o))
058 (< o (count world)))
059 (catch Exception e
060 (warn (format "Not a valid coordinate: %s; %s" o (.getMessage e)))
061 false)))
062
063 (defn location?
064 "Return `true` if this object `o` is a location as defined above with respect to
065 this `world`, else `false`."
066 [o world]
067 (try
068 (and (map? o)
069 (integer? (:x o))
070 (integer? (:y o))
071 (in-bounds? world (:x o) (:y o)))
072 (catch Exception e
073 (warn (format "Not a valid location: %s; %s" o (.getMessage e)))
074 false)))
075
076 (defn flow?
077 "Return `true` if this object `o` is a flow as defined above with respect to
078 this `world`, else `false`. Assumes square worlds."
079 [o world]
080 (try
081 (and (map? o)
082 (location? (:source o) world)
083 (location? (:destination o) world)
084 (keyword? (:property o))
085 (pos? (:quantity o)))
086 (catch Exception e
087 (warn (format "Not a valid flow: %s; %s" o (.getMessage e)))
088 false)))
089
090 (defn execute
091 "Return a world like this `world`, except with the quantity of the property
092 described in this `flow` object transferred from the source of that flow
093 to its destination."
094 [world flow]
095 (try
096 (let [sx (-> flow :source :x)
097 sy (-> flow :source :y)
098 source (get-cell world sx sy)
099 dx (-> flow :destination :x)
100 dy (-> flow :destination :y)
101 dest (get-cell world dx dy)
102 p (:property flow)
103 q (min (:quantity flow) (get-num source p))
104 s' (add-history-event
105 (assoc source p (- (source p) q))
106 (:rule flow)
107 {:direction :sent :other {:x dx :y dy} :property p :quantity q})
108 d' (add-history-event
109 (assoc dest p (+ (get-num dest p) q))
110 (:rule flow)
111 {:direction :received :other {:x sx :y sy} :property p :quantity q})]
112 (if (= q (:quantity flow))
113 (info (format "Moving %f units of %s from %d,%d to %d,%d"
114 (float q) (name p) sx sy dx dy))
115 (warn (format "Moving %s from %d,%d to %d,%d; %f units ordered but only %f available"
116 (name p) sx sy dx dy (float (:quantity flow)) (float q))))
117 (merge-cell (merge-cell world s') d'))
118 (catch Exception e
119 (warn (format "Failed to execute flow %s: %s" flow (.getMessage e)))
120 ;; return the world unmodified.
121 world)))
122
123 (defn execute-flows
124 "Return a world like this `world`, but with each of these flows executed."
125 [world flows]
126 (reduce execute world (filter #(flow? % world) flows)))
127
128 (defn- plan-cell-flows
129 [world cell rules]
130 (map ;; across all the rules
131 (fn [rule] (let [r (try
132 (apply rule (list cell world))
133 (catch Exception any
134 (throw (ex-info "Planning of flows failed"
135 (merge (meta rule) {:cell cell})
136 any))))]
137 (when r (map #(assoc % :rule rule) r))))
138 rules))
139
140 (defn plan-flows
141 "Plan, but do not execute, all the flows in this `world` implied by those of
142 these `rules` (which are expected to be pre-compiled) which are
143 flow rules. Return the list of plans, as flow objects."
144 [world rules]
145 (remove nil?
146 (flatten
147 (map-world
148 world
149 plan-cell-flows
150 (list (filter #(= :flow (rule-type %)) rules))))))
151
152 (defn flow-world
153 "Return a world derived from this `world` by applying the flow rules
154 found among these `rules` to each cell, and executing all the flows
155 planned."
156 [world rules]
157 (execute-flows world (plan-flows world rules)))
158
159 ;; building blocks for compiled flow rules
160
161 (defmacro create-location
162 [cell]
163 `(select-keys ~cell [:x :y]))
164
165 (defmacro create-flow-quantity
166 [source dest prop quantity]
167 `{:source (create-location ~source)
168 :destination (create-location ~dest)
169 :prop ~prop
170 :quantity ~quantity})
171
172 (defmacro create-flow-fraction
173 [source dest prop fraction]
174 `(create-flow-quantity ~source ~dest ~prop
175 (* ~fraction (get-num ~source ~prop))))
176
177 (defmacro create-flow-percent
178 [source dest prop percent]
179 `(create-flow-fraction ~source ~dest ~prop (/ ~percent 100)))