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 [get-cell get-num in-bounds? merge-cell]]
026 [taoensso.timbre :refer [info warn]]))
027
028 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
029 ;;;;
030 ;;;; mw-engine: the state/transition engine of MicroWorld.
031 ;;;;
032 ;;;; This program is free software; you can redistribute it and/or
033 ;;;; modify it under the terms of the GNU General Public License
034 ;;;; as published by the Free Software Foundation; either version 2
035 ;;;; of the License, or (at your option) any later version.
036 ;;;;
037 ;;;; This program is distributed in the hope that it will be useful,
038 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
039 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
040 ;;;; GNU General Public License for more details.
041 ;;;;
042 ;;;; You should have received a copy of the GNU General Public License
043 ;;;; along with this program; if not, write to the Free Software
044 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
045 ;;;; USA.
046 ;;;;
047 ;;;; Copyright (C) 2014 Simon Brooke
048 ;;;;
049 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
050
051 (defn coordinate?
052 "Return `true` if this object `o` is a valid coordinate with respect to
053 this `world`, else `false`. Assumes square worlds."
054 [o world]
055 (try
056 (and (or (zero? o) (pos-int? o))
057 (< o (count world)))
058 (catch Exception e
059 (warn (format "Not a valid coordinate: %s; %s" o (.getMessage e)))
060 false)))
061
062 (defn location?
063 "Return `true` if this object `o` is a location as defined above with respect to
064 this `world`, else `false`."
065 [o world]
066 (try
067 (and (map? o)
068 (integer? (:x o))
069 (integer? (:y o))
070 (in-bounds? world (:x o) (:y o)))
071 (catch Exception e
072 (warn (format "Not a valid location: %s; %s" o (.getMessage e)))
073 false)))
074
075 (defn flow?
076 "Return `true` if this object `o` is a flow as defined above with respect to
077 this `world`, else `false`. Assumes square worlds."
078 [o world]
079 (try
080 (and (map? o)
081 (location? (:source o) world)
082 (location? (:destination o) world)
083 (keyword? (:property o))
084 (pos? (:quantity o)))
085 (catch Exception e
086 (warn (format "Not a valid flow: %s; %s" o (.getMessage e)))
087 false)))
088
089 (defn execute
090 "Return a world like this `world`, except with the quantity of the property
091 described in this `flow` object transferred from the source of that flow
092 to its destination."
093 [world flow]
094 (try
095 (let [sx (-> flow :source :x)
096 sy (-> flow :source :y)
097 source (get-cell world sx sy)
098 dx (-> flow :destination :x)
099 dy (-> flow :destination :y)
100 dest (get-cell world dx dy)
101 p (:property flow)
102 q (min (:quantity flow) (get-num source p))
103 s' (assoc source p (- (source p) q))
104 d' (assoc dest p (+ (get-num dest p) q))]
105 (if (= q (:quantity flow))
106 (info (format "Moving %f units of %s from %d,%d to %d,%d"
107 (float q) (name p) sx sy dx dy))
108 (warn (format "Moving %s from %d,%d to %d,%d; %f units ordered but only %f available"
109 (name p) sx sy dx dy (float (:quantity flow)) (float q))))
110 (merge-cell (merge-cell world s') d'))
111 (catch Exception e
112 (warn (format "Failed to execute flow %s: %s" flow (.getMessage e)))
113 ;; return the world unmodified.
114 world)))
115
116 (defn execute-flows
117 "Return a world like this `world`, but with each of these flows executed."
118 [world flows]
119 (reduce execute world (filter #(flow? % world) flows)))
120
121 ;; building blocks for compiled flow rules
122
123 (defmacro create-location
124 [cell]
125 `(select-keys ~cell [:x :y]))
126
127 (defmacro create-flow-quantity
128 [source dest prop quantity]
129 `{:source (create-location ~source)
130 :destination (create-location ~dest)
131 :prop ~prop
132 :quantity ~quantity})
133
134 (defmacro create-flow-fraction
135 [source dest prop fraction]
136 `(create-flow-quantity ~source ~dest ~prop
137 (* ~fraction (get-num ~source ~prop))))
138
139 (defmacro create-flow-percent
140 [source dest prop percent]
141 `(create-flow-fraction ~source ~dest ~prop (/ ~percent 100)))