Prepended all namespaces with 'cc.journeyman'; tests run, 4 don't pass.

This commit is contained in:
Simon Brooke 2020-11-15 21:09:18 +00:00
parent 37dbb767ac
commit 310896cc95
No known key found for this signature in database
GPG key ID: A7A4F18D1D4DF987
34 changed files with 107 additions and 81 deletions

View file

@ -0,0 +1,44 @@
(ns cc.journeyman.the-great-game.agent.agent
"Anything in the game world with agency"
(:require [the-great-game.objects.game-object :refer [ProtoObject]]
[the-great-game.objects.container :refer [ProtoContainer]]))
;; hierarchy of needs probably gets implemented here
;; I'm probably going to want to defprotocol stuff, to define the hierarchy
;; of things in the gameworld; either that or drop to Java, wich I'd rather not do.
(defprotocol ProtoAgent
"An object which can act in the world"
(act
[actor world circle]
"Allow `actor` to do something in this `world`, in the context of this
`circle`; return the new state of the actor if something was done, `nil`
if nothing was done. Circle is expected to be one of
* `:active` - actors within visual/audible range of the player
character;
* `:pending` - actors not in the active circle, but sufficiently close
to it that they may enter the active circle within a short period;
* `:background` - actors who are active in the background in order to
handle trade, news, et cetera;
* `other` - actors who are not members of any other circle, although
I'm not clear whether it would ever be appropriate to invoke an
`act` method on them.
The `act` method *must not* have side effects; it must *only* return a
new state. If the actor's intention is to seek to change the state of
something else in the game world, it must add a representation of that
intention to the sequence which will be returned by its
`pending-intentions` method.")
(pending-intentions
[actor]
"Returns a sequence of effects an actor intends, as a consequence of
acting. The encoding of these is not yet defined."))
(defrecord Agent
;; "A default agent."
[name home tribe]
ProtoObject
ProtoContainer
ProtoAgent
)

View file

@ -0,0 +1,66 @@
(ns cc.journeyman.the-great-game.gossip.gossip
"Interchange of news events between gossip agents"
(:require [cc.journeyman.the-great-game.utils :refer [deep-merge]]
[cc.journeyman.the-great-game.gossip.news-items :refer [learn-news-item]]))
;; Note that habitual travellers are all gossip agents; specifically, at this
;; stage, that means merchants. When merchants are moved we also need to
;; update the location of the gossip with the same key.
(defn dialogue
"Dialogue between an `enquirer` and an `agent` in this `world`; returns a
map identical to `enquirer` except that its `:gossip` collection may have
additional entries."
;; TODO: not yet written, this is a stub.
[enquirer respondent world]
enquirer)
(defn gather-news
([world]
(reduce
deep-merge
world
(map
#(gather-news world %)
(keys (:gossips world)))))
([world gossip]
(let [g (cond (keyword? gossip)
(-> world :gossips gossip)
(map? gossip)
gossip)]
{:gossips
{(:id g)
(reduce
deep-merge
{}
(map
#(dialogue g % world)
(remove
#( = g %)
(filter
#(= (:location %) (:location g))
(vals (:gossips world))))))}})))
(defn move-gossip
"Return a world like this `world` but with this `gossip` moved to this
`new-location`. Many gossips are essentially shadow-records of agents of
other types, and the movement of the gossip should be controlled by the
run function of the type of the record they shadow. The [[#run]] function
below does NOT call this function."
[gossip world new-location]
(let [id (cond
(map? gossip)
(-> world :gossips gossip :id)
(keyword? gossip)
gossip)]
(deep-merge
world
{:gossips
{id
{:location new-location}}})))
(defn run
"Return a world like this `world`, with news items exchanged between gossip
agents."
[world]
(gather-news world))

View file

@ -0,0 +1,256 @@
(ns cc.journeyman.the-great-game.gossip.news-items
"Categories of news events interesting to gossip agents"
(:require [cc.journeyman.the-great-game.world.location :refer [distance-between]]
[cc.journeyman.the-great-game.time :refer [game-time]]))
;; The ideas here are based on the essay 'The spread of knowledge in a large
;; game world', q.v.; they've advanced a little beyond that and will doubtless
;; advance further in the course of writing and debugging this namespace.
;; A news item is a map with the keys:
;;
;; * `date` - the date on which the reported event happened;
;; * `nth-hand` - the number of agents the news item has passed through;
;; * `verb` - what it is that happened (key into `news-topics`);
;;
;; plus other keys taken from the `keys` value associated with the verb in
;; `news-topics`
(def news-topics
"Topics of interest to gossip agents. Topics are keyed in this map by
their `verbs`. The `keys` associated with each topic are the extra pieces
of information required to give context to a gossip item. Generally:
* `actor` is the id of the character who it is reported performed the
action;
* `other` is the id of the character on whom it is reported the action
was performed;
* `location` is the place at which the action was performed;
* `object` is an object (or possibly list of objects?) relevant to the
action;
* `price` is special to buy/sell, but of significant interest to merchants.
#### Notes:
##### Characters:
*TODO* but note that at most all the receiver can learn about a character
from a news item is what the giver knows about that character, degraded by
what the receiver finds interesting about them. If we just pass the id here,
then either the receiver knows everything in the database about the
character, or else the receiver knows nothing at all about the character.
Neither is desirable. Further thought needed.
By implication, the character values passed should include *all* the
information the giver knows about the character; that can then be degraded
as the receiver stores only that segment which the receiver finds
interesting.
##### Locations:
A 'location' value is a list comprising at most the x/y coordinate location
and the ids of the settlement and region (possibly hierarchically) that contain
the location. If the x/y is not local to the home of the receiving agent, they
won't remember it and won't pass it on; if any of the ids are not interesting
So location information will degrade progressively as the item is passed along.
It is assumed that the `:home` of a character is a location in this sense.
##### Inferences:
If an agent learns that Adam has married Betty, they can infer that Betty has
married Adam; if they learn that Charles killed Dorothy, that Dorothy has died.
I'm not convinced that my representation of inferences here is ideal.
"
{ ;; A significant attack is interesting whether or not it leads to deaths
:attack {:verb :attack :keys [:actor :other :location]}
;; Deaths of characters may be interesting
:die {:verb :die :keys [:actor :location]}
;; Deliberate killings are interesting.
:kill {:verb :kill :keys [:actor :other :location]
:inferences [{:verb :die :actor :other :other :nil}]}
;; Marriages may be interesting
:marry {:verb :marry :keys [:actor :other :location]
:inferences [{:verb :marry :actor :other :other :actor}]}
;; The end of ongoing open conflict between to characters may be interesting
:peace {:verb :peace :keys [:actor :other :location]
:inferences [{:verb :peace :actor :other :other :actor}]}
;; Things related to the plot are interesting, but will require special
;; handling. Extra keys may be required by particular plot events.
:plot {:verb :plot :keys [:actor :other :object :location]}
;; Rapes are interesting.
:rape {:verb :rape :keys [:actor :other :location]
;; Should you also infer from rape that actor is male and adult?
:inferences [{:verb :attack}
{:verb :sex}
{:verb :sex :actor :other :other :actor}]}
;; Merchants, especially, are interested in prices in other markets
:sell {:verb :sell :keys [:actor :other :object :location :price]}
;; Sex can juicy gossip, although not normally if the participants are in an
;; established sexual relationship.
:sex {:verb :sex :keys [:actor :other :location]
:inferences [{:verb :sex :actor :other :other :actor}]}
;; Thefts are interesting
:steal {:verb :steal :keys [:actor :other :object :location]}
;; The succession of rulers is interesting; of respected craftsmen,
;; potentially also interesting.
:succession {:verb :succession :keys [:actor :other :location :rank]}
;; The start of ongoing open conflict between to characters may be interesting
:war {:verb :war :keys [:actor :other :location]
:inferences [{:verb :war :actor :other :other :actor}]}
})
(defn interest-in-character
"Integer representation of how interesting this `character` is to this
`gossip`.
*TODO:* this assumes that characters are passed as keywords, but, as
documented above, they probably have to be maps, to allow for degradation."
[gossip character]
(count
(concat
(filter #(= (:actor % character)) (:knowledge gossip))
(filter #(= (:other % character)) (:knowledge gossip)))))
(defn interesting-character?
"Boolean representation of whether this `character` is interesting to this
`gossip`."
[gossip character]
(> (interest-in-character gossip character) 0))
(defn interest-in-location
"Integer representation of how interesting this `location` is to this
`gossip`."
[gossip location]
(cond
(and (map? location) (number? (:x location)) (number? (:y location)))
(if-let [home (:home gossip)]
(let [d (distance-between location home)
i (/ 10000 d) ;; 10000 at metre scale is 10km; interest should
;;fall off with distance from home, but possibly on a log scale
]
(if (> i 1) i 0))
0)
(coll? location)
(reduce
+
(map
#(interest-in-location gossip %)
location))
:else
(count
(filter
#(some (fn [x] (= x location)) (:location %))
(cons {:location (:home gossip)} (:knowledge gossip))))))
;; (interest-in-location {:home [{0, 0} :test-home] :knowledge []} [:test-home])
(defn interesting-location?
"True if the location of this news `item` is interesting to this `gossip`."
[gossip item]
(> (interest-in-location gossip (:location item)) 0))
(defn interesting-object?
[gossip object]
;; TODO: Not yet (really) implemented
true)
(defn interesting-topic?
[gossip topic]
;; TODO: Not yet (really) implemented
true)
(defn interesting-item?
"True if anything about this news `item` is interesting to this `gossip`."
[gossip item]
(or
(interesting-character? gossip (:actor item))
(interesting-character? gossip (:other item))
(interesting-location? gossip (:location item))
(interesting-object? gossip (:object item))
(interesting-topic? gossip (:verb item))))
(defn infer
"Infer a new knowledge item from this `item`, following this `rule`"
[item rule]
(reduce merge
item
(cons
{:verb (:verb rule)}
(map (fn [k] {k (apply (k rule) (list item))})
(remove
#(= % :verb)
(keys rule))))))
(declare learn-news-item)
(defn make-all-inferences
"Return a list of knowledge entries that can be inferred from this news
`item`."
[item]
(set
(reduce
concat
(map
#(:knowledge (learn-news-item {} (infer item %) false))
(:inferences (news-topics (:verb item)))))))
(defn degrade-character
"Return a character specification like this `character`, but comprising
only those properties this `gossip` is interested in."
[gossip character]
;; TODO: Not yet (really) implemented
character)
(defn degrade-location
"Return a location specification like this `location`, but comprising
only those elements this `gossip` is interested in. If none, return
`nil`."
[gossip location]
(let [l (if
(coll? location)
(filter
#(when (interesting-location? gossip %) %)
location))]
(when-not (empty? l) l)))
(defn learn-news-item
"Return a gossip like this `gossip`, which has learned this news `item` if
it is of interest to them."
;; TODO: Not yet implemented
([gossip item]
(learn-news-item gossip item true))
([gossip item follow-inferences?]
(if
(interesting-item? gossip item)
(let
[g (assoc
gossip
:knowledge
(cons
(assoc
item
:nth-hand (if
(number? (:nth-hand item))
(inc (:nth-hand item))
1)
:time-stamp (if
(number? (:time-stamp item))
(:time-stamp item)
(game-time))
:location (degrade-location gossip (:location item))
;; TODO: ought to maybe-degrade characters we're not yet interested in
)
;; TODO: ought not to add knowledge items we already have, except
;; to replace if new item is of increased specificity
(:knowledge gossip)))]
(if follow-inferences?
(assoc
g
:knowledge
(concat (:knowledge g) (make-all-inferences item)))
g))
gossip)))

View file

@ -0,0 +1,84 @@
(ns cc.journeyman.the-great-game.merchants.markets
"Adjusting quantities and prices in markets."
(:require [taoensso.timbre :as l :refer [info error]]
[cc.journeyman.the-great-game.utils :refer [deep-merge]]))
(defn new-price
"If `stock` is greater than the maximum of `supply` and `demand`, then
there is surplus and `old` price is too high, so shold be reduced. If
lower, then it is too low and should be increased."
[old stock supply demand]
(let
[delta (dec' (/ (max supply demand 1) (max stock 1)))
scaled (/ delta 100)]
(+ old scaled)))
(defn adjust-quantity-and-price
"Adjust the quantity of this `commodity` currently in stock in this `city`
of this `world`. Return a fragmentary world which can be deep-merged into
this world."
[world city commodity]
(let [c (cond
(keyword? city) (-> world :cities city)
(map? city) city)
id (:id c)
p (or (-> c :prices commodity) 0)
d (or (-> c :demands commodity) 0)
st (or (-> c :stock commodity) 0)
su (or (-> c :supplies commodity) 0)
decrement (min st d)
increment (cond
;; if we've two turns' production of this commodity in
;; stock, halt production
(> st (* su 2))
0
;; if it is profitable to produce this commodity, the
;; craftspeople of the city will do so.
(> p 1) su
;; otherwise, if there isn't a turn's production in
;; stock, top up the stock, so that there's something for
;; incoming merchants to buy
(> su st)
(- su st)
:else
0)
n (new-price p st su d)]
(if
(not= p n)
(l/info "Price of" commodity "at" id "has changed from" (float p) "to" (float n)))
{:cities {id
{:stock
{commodity (+ (- st decrement) increment)}
:prices
{commodity n}}}}))
(defn update-markets
"Return a world like this `world`, with quantities and prices in markets
updated to reflect supply and demand. If `city` or `city` and `commodity`
are specified, return a fragmentary world with only the changes for that
`city` (and `commodity` if specified) populated."
([world]
(reduce
deep-merge
world
(map
#(update-markets world %)
(keys (:cities world)))))
([world city]
(reduce
deep-merge
{}
(map #(update-markets world city %)
(keys (:commodities world)))))
([world city commodity]
(adjust-quantity-and-price world city commodity)))
(defn run
"Return a world like this `world`, with quantities and prices in markets
updated to reflect supply and demand."
[world]
(update-markets world))

View file

@ -0,0 +1,106 @@
(ns cc.journeyman.the-great-game.merchants.merchant-utils
"Useful functions for doing low-level things with merchants.")
(defn expected-price
"Find the price anticipated, given this `world`, by this `merchant` for
this `commodity` in this `city`. If no information, assume 1.
`merchant` should be passed as a map, `commodity` and `city` should be passed as keywords."
[merchant commodity city]
(or
(:price
(last
(sort-by
:date
(-> merchant :known-prices city commodity))))
1))
(defn burden
"The total weight of the current cargo carried by this `merchant` in this
`world`."
[merchant world]
(let [m (cond
(keyword? merchant)
(-> world :merchants merchant)
(map? merchant)
merchant)
cargo (or (:stock m) {})]
(reduce
+
0
(map
#(* (cargo %) (-> world :commodities % :weight))
(keys cargo)))))
(defn can-carry
"Return the number of units of this `commodity` which this `merchant`
can carry in this `world`, given their current burden."
[merchant world commodity]
(let [m (cond
(keyword? merchant)
(-> world :merchants merchant)
(map? merchant)
merchant)]
(max
0
(quot
(- (or (:capacity m) 0) (burden m world))
(-> world :commodities commodity :weight)))))
(defn can-afford
"Return the number of units of this `commodity` which this `merchant`
can afford to buy in this `world`."
[merchant world commodity]
(let [m (cond
(keyword? merchant)
(-> world :merchants merchant)
(map? merchant)
merchant)
l (:location m)]
(cond
(nil? m)
(throw (Exception. "No merchant?"))
(or (nil? l) (nil? (-> world :cities l)))
(throw (Exception. (str "No known location for merchant " m)))
:else
(quot
(:cash m)
(-> world :cities l :prices commodity)))))
(defn add-stock
"Where `a` and `b` are both maps all of whose values are numbers, return
a map whose keys are a union of the keys of `a` and `b` and whose values
are the sums of their respective values."
[a b]
(reduce
merge
a
(map
#(hash-map % (+ (or (a %) 0) (or (b %) 0)))
(keys b))))
(defn add-known-prices
"Add the current prices at this `merchant`'s location in the `world`
to a new cache of known prices, and return it."
[merchant world]
(let [m (cond
(keyword? merchant)
(-> world :merchants merchant)
(map? merchant)
merchant)
k (or (:known-prices m) {})
l (:location m)
d (or (:date world) 0)
p (-> world :cities l :prices)]
(cond
(nil? m)
(throw (Exception. "No merchant?"))
(or (nil? l) (nil? (-> world :cities l)))
(throw (Exception. (str "No known location for merchant " m)))
:else
(reduce
merge
k
(map
#(hash-map % (apply vector cons {:price (p %) :date d} (k %)))
(-> world :commodities keys))))))

View file

@ -0,0 +1,28 @@
(ns cc.journeyman.the-great-game.merchants.merchants
"Trade planning for merchants, primarily."
(:require [taoensso.timbre :as l :refer [info error spy]]
[the-great-game.utils :refer [deep-merge]]
[the-great-game.merchants.strategies.simple :refer [move-merchant]]))
(defn run
"Return a partial world based on this `world`, but with each merchant moved."
[world]
(try
(reduce
deep-merge
world
(map
#(try
(let [move-fn (or
(-> world :merchants % :move-fn)
move-merchant)]
(apply move-fn (list % world)))
(catch Exception any
(l/error any "Failure while moving merchant " %)
{}))
(keys (:merchants world))))
(catch Exception any
(l/error any "Failure while moving merchants")
world)))

View file

@ -0,0 +1,159 @@
(ns cc.journeyman.the-great-game.merchants.planning
"Trade planning for merchants, primarily. This follows a simple-minded
generate-and-test strategy and currently generates plans for all possible
routes from the current location. This may not scale. Also, routes do not
currently have cost or risk associated with them."
(:require [cc.journeyman.the-great-game.utils :refer [deep-merge make-target-filter]]
[cc.journeyman.the-great-game.merchants.merchant-utils :refer [can-afford can-carry expected-price]]
[cc.journeyman.the-great-game.world.routes :refer [find-route]]
[cc.journeyman.the-great-game.world.world :refer [actual-price default-world]]))
(defn generate-trade-plans
"Generate all possible trade plans for this `merchant` and this `commodity`
in this `world`.
Returned plans are maps with keys:
* :merchant - the id of the `merchant` for whom the plan was created;
* :origin - the city from which the trade starts;
* :destination - the city to which the trade is planned;
* :commodity - the `commodity` to be carried;
* :buy-price - the price at which that `commodity` can be bought;
* :expected-price - the price at which the `merchant` anticipates
that `commodity` can be sold;
* :distance - the number of stages in the planned journey
* :dist-to-home - the distance from `destination` to the `merchant`'s
home city."
[merchant world commodity]
(let [m (cond
(keyword? merchant)
(-> world :merchants merchant)
(map? merchant)
merchant)
origin (:location m)]
(map
#(hash-map
:merchant (:id m)
:origin origin
:destination %
:commodity commodity
:buy-price (actual-price world commodity origin)
:expected-price (expected-price
m
commodity
%)
:distance (count
(find-route world origin %))
:dist-to-home (count
(find-route
world
(:home m)
%)))
(remove #(= % origin) (-> world :cities keys)))))
(defn nearest-with-targets
"Return the distance to the nearest destination among those of these
`plans` which match these `targets`. Plans are expected to be plans
as returned by `generate-trade-plans`, q.v.; `targets` are expected to be
as accepted by `make-target-filter`, q.v."
[plans targets]
(apply
min
(map
:distance
(filter
(make-target-filter targets)
plans))))
(defn plan-trade
"Find the best destination in this `world` for this `commodity` given this
`merchant` and this `origin`. If two cities are anticipated to offer the
same price, the nearer should be preferred; if two are equally distant, the
ones nearer to the merchant's home should be preferred.
`merchant` may be passed as a map or a keyword; `commodity` should be
passed as a keyword.
The returned plan is a map with keys:
* :merchant - the id of the `merchant` for whom the plan was created;
* :origin - the city from which the trade starts;
* :destination - the city to which the trade is planned;
* :commodity - the `commodity` to be carried;
* :buy-price - the price at which that `commodity` can be bought;
* :expected-price - the price at which the `merchant` anticipates
that `commodity` can be sold;
* :distance - the number of stages in the planned journey
* :dist-to-home - the distance from `destination` to the `merchant`'s
home city."
[merchant world commodity]
(let [plans (generate-trade-plans merchant world commodity)
best-prices (filter
(make-target-filter
[[:expected-price
(apply
max
(filter number? (map :expected-price plans)))]])
plans)]
(first
(sort-by
;; all other things being equal, a merchant would prefer to end closer
;; to home.
#(- 0 (:dist-to-home %))
;; a merchant will seek the best price, but won't go further than
;; needed to get it.
(filter
(make-target-filter
[[:distance
(apply min (filter number? (map :distance best-prices)))]])
best-prices)))))
(defn augment-plan
"Augment this `plan` constructed in this `world` for this `merchant` with
the `:quantity` of goods which should be bought and the `:expected-profit`
of the trade.
Returns the augmented plan."
[merchant world plan]
(let [c (:commodity plan)
o (:origin plan)
q (min
(or
(-> world :cities o :stock c)
0)
(can-carry merchant world c)
(can-afford merchant world c))
p (* q (- (:expected-price plan) (:buy-price plan)))]
(assoc plan :quantity q :expected-profit p)))
(defn select-cargo
"A `merchant`, in a given location in a `world`, will choose to buy a cargo
within the limit they are capable of carrying, which they can anticipate
selling for a profit at a destination."
[merchant world]
(let [m (cond
(keyword? merchant)
(-> world :merchants merchant)
(map? merchant)
merchant)
origin (:location m)
available (-> world :cities origin :stock)
plans (map
#(augment-plan
m
world
(plan-trade m world %))
(filter
#(let [q (-> world :cities origin :stock %)]
(and (number? q) (pos? q)))
(keys available)))]
(if
(not (empty? plans))
(first
(sort-by
#(- 0 (:dist-to-home %))
(filter
(make-target-filter
[[:expected-profit
(apply max (filter number? (map :expected-profit plans)))]])
plans))))))

View file

@ -0,0 +1,173 @@
(ns cc.journeyman.the-great-game.merchants.strategies.simple
"Default trading strategy for merchants.
The simple strategy buys a single product in the local market if there is
one which can be traded profitably, trades it to the chosen target market,
and sells it there. If there is no commodity locally which can be traded
profitably, moves towards home with no cargo. If at home and no commodity
can be traded profitably, does not move."
(:require [taoensso.timbre :as l :refer [info error spy]]
[cc.journeyman.the-great-game.utils :refer [deep-merge]]
[cc.journeyman.the-great-game.gossip.gossip :refer [move-gossip]]
[cc.journeyman.the-great-game.merchants.planning :refer [augment-plan plan-trade select-cargo]]
[cc.journeyman.the-great-game.merchants.merchant-utils :refer
[add-stock add-known-prices]]
[cc.journeyman.the-great-game.world.routes :refer [find-route]]))
(defn plan-and-buy
"Return a world like this `world`, in which this `merchant` has planned
a new trade, and bought appropriate stock for it. If no profitable trade
can be planned, the merchant is simply moved towards their home."
[merchant world]
(let [m (cond
(keyword? merchant)
(-> world :merchants merchant)
(map? merchant)
merchant)
id (:id m)
location (:location m)
market (-> world :cities location)
plan (select-cargo merchant world)]
(l/debug "plan-and-buy: merchant" id)
(cond
(not (empty? plan))
(let
[c (:commodity plan)
p (* (:quantity plan) (:buy-price plan))
q (:quantity plan)]
(l/info "Merchant" id "bought" q "units of" c "at" location "for" p plan)
{:merchants
{id
{:stock (add-stock (:stock m) {c q})
:cash (- (:cash m) p)
:known-prices (add-known-prices m world)
:plan plan}}
:cities
{location
{:stock (assoc (:stock market) c (- (-> market :stock c) q))
:cash (+ (:cash market) p)}}})
;; if no plan, then if at home stay put
(= (:location m) (:home m))
(do
(l/info "Merchant" id "remains at home in" location)
{})
;; else move towards home
:else
(let [route (find-route world location (:home m))
next-location (nth route 1)]
(l/info "No trade possible at" location "; merchant" id "moves to" next-location)
(merge
{:merchants
{id
{:location next-location}}}
(move-gossip id world next-location))))))
(defn re-plan
"Having failed to sell a cargo at current location, re-plan a route to
sell the current cargo. Returns a revised world."
[merchant world]
(let [m (cond
(keyword? merchant)
(-> world :merchants merchant)
(map? merchant)
merchant)
id (:id m)
location (:location m)
plan (augment-plan m world (plan-trade m world (-> m :plan :commodity)))]
(l/debug "re-plan: merchant" id)
(deep-merge
world
{:merchants
{id
{:plan plan}}})))
(defn sell-and-buy
"Return a new world like this `world`, in which this `merchant` has sold
their current stock in their current location, and planned a new trade, and
bought appropriate stock for it."
;; TODO: this either sells the entire cargo, or, if the market can't afford
;; it, none of it. And it does not cope with selling different commodities
;; in different markets.
[merchant world]
(let [m (cond
(keyword? merchant)
(-> world :merchants merchant)
(map? merchant)
merchant)
id (:id m)
location (:location m)
market (-> world :cities location)
stock-value (reduce
+
(map
#(* (-> m :stock %) (-> market :prices m))
(keys (:stock m))))]
(l/debug "sell-and-buy: merchant" id)
(if
(>= (:cash market) stock-value)
(do
(l/info "Merchant" id "sells" (:stock m) "at" location "for" stock-value)
(plan-and-buy
merchant
(deep-merge
world
{:merchants
{id
{:stock {}
:cash (+ (:cash m) stock-value)
:known-prices (add-known-prices m world)}}
:cities
{location
{:stock (add-stock (:stock m) (:stock market))
:cash (- (:cash market) stock-value)}}})))
;; else
(re-plan merchant world))))
(defn move-merchant
"Handle general en route movement of this `merchant` in this `world`;
return a (partial or full) world like this `world` but in which the
merchant may have been moved ot updated."
[merchant world]
(let [m (cond
(keyword? merchant)
(-> world :merchants merchant)
(map? merchant)
merchant)
id (:id m)
at-destination? (and (:plan m) (= (:location m) (-> m :plan :destination)))
plan (:plan m)
next-location (if plan
(nth
(find-route
world
(:location m)
(:destination plan))
1)
(:location m))]
(l/debug "move-merchant: merchant" id "at" (:location m)
"destination" (-> m :plan :destination) "next" next-location
"at destination" at-destination?)
(cond
;; if the merchant is at the destination of their current plan
;; sell all cargo and repurchase.
at-destination?
(sell-and-buy merchant world)
;; if they don't have a plan, seek to create one
(nil? plan)
(plan-and-buy merchant world)
;; otherwise, move one step towards their destination
(and next-location (not= next-location (:location m)))
(do
(l/info "Merchant " id " moving from " (:location m) " to " next-location)
(deep-merge
{:merchants
{id
{:location next-location
:known-prices (add-known-prices m world)}}}
(move-gossip id world next-location)))
:else
(do
(l/info "Merchant" id "has plan but no next-location; currently at"
(:location m) ", destination is" (:destination plan))
world))))

View file

@ -0,0 +1,11 @@
(ns cc.journeyman.the-great-game.objects.container
(:require
[cc.journeyman.the-great-game.objects.game-object :refer :all]))
(defprotocol ProtoContainer
(contents
[container]
"Return a sequence of the contents of this `container`, or `nil` if empty.")
(is-empty?
[container]
"Return `true` if this `container` is empty, else `false`."))

View file

@ -0,0 +1,19 @@
(ns cc.journeyman.the-great-game.objects.game-object
"Anything at all in the game world")
(defprotocol ProtoObject
"An object in the world"
(id [object] "Returns the unique id of this object.")
(reify-object
[object]
"Adds this `object` to the global object list. If the `object` has a
non-nil value for its `id` method, keys it to that id - **but** if the
id value is already in use, throws a hard exception. Returns the id to
which the object is keyed in the global object list."))
(defrecord GameObject
[id]
;; "An object in the world"
ProtoObject
(id [_] id)
(reify-object [object] "TODO: doesn't work yet"))

View file

@ -0,0 +1,144 @@
(ns cc.journeyman.the-great-game.time
(:require [clojure.string :as s]))
(def game-start-time
"The start time of this run."
(System/currentTimeMillis))
(def ^:const game-day-length
"The Java clock advances in milliseconds, which is fine.
But we need game-days to be shorter than real world days.
A Witcher 3 game day is 1 hour 36 minutes, or 96 minutes, which is
presumably researched. Round it up to 100 minutes for easier
calculation."
(* 100 ;; minutes per game day
60 ;; seconds per minute
1000)) ;; milliseconds per second
(defn now
"For now, we'll use Java timestamp for time; ultimately, we need a
concept of game-time which allows us to drive day/night cycle, seasons,
et cetera, but what matters about time is that it is a value which
increases."
[]
(System/currentTimeMillis))
(def ^:const canonical-ordering-of-houses
"The canonical ordering of religious houses."
[:eye
:foot
:nose
:hand
:ear
:mouth
:stomach
:furrow
:plough])
(def ^:const days-of-week
"The eight-day week of the game world. This differs from the canonical
ordering of houses in that it omits the eye."
(rest canonical-ordering-of-houses))
(def ^:const days-in-week
"This world has an eight day week."
(count days-of-week))
(def ^:const seasons-of-year
"The ordering of seasons in the year is different from the canonical
ordering of the houses, for reasons of the agricultural cycle."
[:foot
:nose
:hand
:ear
:mouth
:stomach
:plough
:furrow
:eye])
(def ^:const seasons-in-year
"Nine seasons in a year, one for each house (although the order is
different."
(count seasons-of-year))
(def ^:const weeks-of-season
"To fit nine seasons of eight day weeks into 365 days, each must be of
five weeks."
[:first :second :third :fourth :fifth])
(def ^:const weeks-in-season
"To fit nine seasons of eight day weeks into 365 days, each must be of
five weeks."
(count weeks-of-season))
(def ^:const days-in-season
(* weeks-in-season days-in-week))
(defn game-time
"With no arguments, the current game time. If a Java `timestamp` value is
passed (as a `long`), the game time represented by that value."
([] (game-time (now)))
([timestamp]
(- timestamp game-start-time)))
(defmacro day-of-year
"The day of the year represented by this `game-time`, ignoring leap years."
[game-time]
`(mod (long (/ ~game-time game-day-length)) 365))
(def waiting-day?
"Does this `game-time` represent a waiting day?"
(memoize
;; we're likely to call this several times in quick succession on the
;; same timestamp
(fn [game-time]
(>=
(day-of-year game-time)
(* seasons-in-year weeks-in-season days-in-week)))))
(defn day
"Day of the eight-day week represented by this `game-time`."
[game-time]
(let [day-of-week (mod (day-of-year game-time) days-in-week)]
(if (waiting-day? game-time)
(nth weeks-of-season day-of-week)
(nth days-of-week day-of-week))))
(defn week
"Week of season represented by this `game-time`."
[game-time]
(let [day-of-season (mod (day-of-year game-time) days-in-season)
week (/ day-of-season days-in-week)]
(if (waiting-day? game-time)
:waiting
(nth weeks-of-season week))))
(defn season
[game-time]
(let [season (int (/ (day-of-year game-time) days-in-season))]
(if (waiting-day? game-time)
:waiting
(nth seasons-of-year season))))
(defn date-string
"Return a correctly formatted date for this `game-time` in the calendar of
the Great Place."
[game-time]
(s/join
" "
(if
(waiting-day? game-time)
[(s/capitalize
(name
(nth
weeks-of-season
(mod (day-of-year game-time) days-in-week))))
"waiting day"]
[(s/capitalize (name (week game-time)))
(s/capitalize (name (day game-time)))
"of the"
(s/capitalize (name (season game-time)))])))

View file

@ -0,0 +1,45 @@
(ns cc.journeyman.the-great-game.utils)
(defn cyclic?
"True if two or more elements of `route` are identical"
[route]
(not= (count route)(count (set route))))
(defn deep-merge
"Recursively merges maps. Stolen from
https://dnaeon.github.io/recursively-merging-maps-in-clojure/"
[& maps]
(letfn [(m [& xs]
(if (some #(and (map? %) (not (record? %))) xs)
(apply merge-with m xs)
(last xs)))]
(reduce m maps)))
(defn make-target-filter
"Construct a filter which, when applied to a list of maps,
will pass those which match these `targets`, where each target
is a tuple [key value]."
;; TODO: this would probably be more elegant as a macro
[targets]
(eval
(list
'fn
(vector 'm)
(cons
'and
(map
#(list
'=
(list (first %) 'm)
(nth % 1))
targets)))))
(defn value-or-default
"Return the value of this key `k` in this map `m`, or this `dflt` value if
there is none."
[m k dflt]
(or (when (map? m) (m k)) dflt))
;; (value-or-default {:x 0 :y 0 :altitude 7} :altitude 8)
;; (value-or-default {:x 0 :y 0 :altitude 7} :alt 8)
;; (value-or-default nil :altitude 8)

View file

@ -0,0 +1,159 @@
(ns cc.journeyman.the-great-game.world.heightmap
"Functions dealing with the tessellated multi-layer heightmap."
(:require [clojure.math.numeric-tower :refer [expt sqrt]]
[mw-engine.core :refer []]
[mw-engine.heightmap :refer [apply-heightmap]]
[mw-engine.utils :refer [get-cell in-bounds? map-world scale-world]]
[cc.journeyman.the-great-game.utils :refer [value-or-default]]))
;; It's not at all clear to me yet what the workflow for getting a MicroWorld
;; map into The Great Game, and whether it passes through Walkmap to get here.
;; This file as currently written assumes it doesn't.
;; It's utterly impossible to hold a whole continent at one metre scale in
;; memory at one time. So we have to be able to regenerate high resolution
;; surfaces from much lower resolution heightmaps.
;;
;; Thus to reproduce a segment of surface at a particular level of detail,
;; we:
;; 1. load the base heightmap into a grid (see
;; `mw-engine.heightmap/apply-heightmap`);
;; 2. scale the base hightmap to kilometre scale (see `scale-grid`);
;; 3. exerpt the portion of that that we want to reproduce (see `exerpt-grid`);
;; 4. interpolate that grid to get the resolution we require (see
;; `interpolate-grid`);
;; 5. create an appropriate purturbation grid from the noise map(s) for the
;; same coordinates to break up the smooth interpolation;
;; 6. sum the altitudes of the two grids.
;;
;; In production this will have to be done **very** fast!
(def ^:dynamic *base-map* "resources/maps/heightmap.png")
(def ^:dynamic *noise-map* "resources/maps/noise.png")
(defn scale-grid
"multiply all `:x` and `:y` values in this `grid` by this `n`."
[grid n]
(map-world grid (fn [w c x] (assoc c :x (* (:x c) n) :y (* (:y c) n)))))
;; Each of the east-west curve and the north-south curve are of course two
;; dimensional curves; the east-west curve is in the :x/:z plane and the
;; north-south curve is in the :y/:z plane (except, perhaps unwisely,
;; we've been using :altitude to label the :z plane). We have a library
;; function `walkmap.edge/intersection2d`, but as currently written it
;; can only find intersections in :x/:y plane.
;;
;; TODO: rewrite the function so that it can use arbitrary coordinates.
;; AFTER TRYING: OK, there are too many assumptions about the way that
;; function is written to allow for easy rotation. TODO: think!
(defn interpolate-altitude
"Return the altitude of the point at `x-offset`, `y-offset` within this
`cell` having this `src-width`, taken from this `grid`."
[cell grid src-width x-offset y-offset ]
(let [c-alt (:altitude cell)
n-alt (or (:altitude (get-cell grid (:x cell) (dec (:y cell)))) c-alt)
w-alt (or (:altitude (get-cell grid (inc (:x cell)) (:y cell))) c-alt)
s-alt (or (:altitude (get-cell grid (:x cell) (inc (:y cell)))) c-alt)
e-alt (or (:altitude (get-cell grid (dec (:x cell)) (:y cell))) c-alt)]
;; TODO: construct two curves (arcs of circles good enough for now)
;; n-alt...c-alt...s-alt and e-alt...c-alt...w-alt;
;; then interpolate x-offset along e-alt...c-alt...w-alt and y-offset
;; along n-alt...c-alt...s-alt;
;; then return the average of the two
0))
(defn interpolate-cell
"Construct a grid (array of arrays) of cells each of width `target-width`
from this `cell`, of width `src-width`, taken from this `grid`"
[cell grid src-width target-width]
(let [offsets (map #(* target-width %) (range (/ src-width target-width)))]
(into
[]
(map
(fn [r]
(into
[]
(map
(fn [c]
(assoc cell
:x (+ (:x cell) c)
:y (+ (:y cell) r)
:altitude (interpolate-altitude cell grid src-width c r)))
offsets)))
offsets))))
(defn interpolate-grid
"Return a grid interpolated from this `grid` of rows, cols given scaling
from this `src-width` to this `target-width`"
[grid src-width target-width]
(reduce
concat
(into
[]
(map
(fn [row]
(reduce
(fn [g1 g2]
(into [] (map #(into [] (concat %1 %2)) g1 g2)))
(into [] (map #(interpolate-cell % grid src-width target-width) row))))
grid))))
(defn excerpt-grid
"Return that section of this `grid` where the `:x` co-ordinate of each cell
is greater than or equal to this `x-offset`, the `:y` co-ordinate is greater
than or equal to this `y-offset`, whose width is not greater than this
`width`, and whose height is not greater than this `height`."
[grid x-offset y-offset width height]
(into
[]
(remove
nil?
(map
(fn [row]
(when
(and
(>= (:y (first row)) y-offset)
(< (:y (first row)) (+ y-offset height)))
(into
[]
(remove
nil?
(map
(fn [cell]
(when
(and
(>= (:x cell) x-offset)
(< (:x cell) (+ x-offset width)))
cell))
row)))))
grid))))
(defn get-surface
"Return, as a vector of vectors of cells represented as Clojure maps, a
segment of surface from this `base-map` as modified by this
`noise-map` at this `cell-size` starting at this `x-offset` and `y-offset`
and having this `width` and `height`.
If `base-map` and `noise-map` are not supplied, the bindings of `*base-map*`
and `*noise-map*` will be used, respectively.
`base-map` and `noise-map` may be passed either as strings, assumed to be
file paths of PNG files, or as MicroWorld style world arrays. It is assumed
that one pixel in `base-map` represents one square kilometre in the game
world. It is assumed that `cell-size`, `x-offset`, `y-offset`, `width` and
`height` are integer numbers of metres."
([cell-size x-offset y-offset width height]
(get-surface *base-map* *noise-map* cell-size x-offset y-offset width height))
([base-map noise-map cell-size x-offset y-offset width height]
(let [b (if (seq? base-map) base-map (scale-world (apply-heightmap base-map) 1000))
n (if (seq? noise-map) noise-map (apply-heightmap noise-map))]
(if (and (in-bounds? b x-offset y-offset)
(in-bounds? b (+ x-offset width) (+ y-offset height)))
b ;; actually do stuff
(throw (Exception. "Surface out of bounds for map.")))
)))

View file

@ -0,0 +1,37 @@
(ns cc.journeyman.the-great-game.world.location
"Functions dealing with location in the world."
(:require [clojure.math.numeric-tower :refer [expt sqrt]]))
;; A 'location' value is a list comprising at most the x/y coordinate location
;; and the ids of the settlement and region (possibly hierarchically) that contain
;; the location. If the x/y is not local to the home of the receiving agent, they
;; won't remember it and won't pass it on; if any of the ids are not interesting
;; So location information will degrade progressively as the item is passed along.
;; It is assumed that the `:home` of a character is a location in this sense.
(defn get-coords
"Return the coordinates in the game world of `location`, which may be
1. A coordinate pair in the format {:x 5 :y 32};
2. A location, as discussed above;
3. Any other gameworld object, having a `:location` property whose value
is one of the above."
[location]
(cond
(empty? location) nil
(map? location)
(cond
(and (number? (:x location)) (number? (:y location)))
location
(:location location)
(:location location))
:else
(get-coords (first (remove keyword? location)))))
(defn distance-between
[location-1 location-2]
(let [c1 (get-coords location-1)
c2 (get-coords location-2)]
(when
(and c1 c2)
(sqrt (+ (expt (- (:x c1) (:x c2)) 2) (expt (- (:y c1) (:y c2)) 2))))))

View file

@ -0,0 +1,7 @@
(ns cc.journeyman.the-great-game.world.mw
"Functions dealing with building a great game world from a MicroWorld world."
(:require [clojure.math.numeric-tower :refer [expt sqrt]]
[mw-engine.core :refer []]
[mw-engine.world :refer []]))
;; It's not at all clear to me yet what the workflow for getting a MicroWorld map into The Great Game, and whether it passes through Walkmap to get here. This file as currently written assumes it doesn't.

View file

@ -0,0 +1,55 @@
(ns cc.journeyman.the-great-game.world.routes
"Conceptual (plan level) routes, represented as tuples of location ids."
(:require [cc.journeyman.the-great-game.utils :refer [cyclic?]]))
(defn find-routes
"Find routes from among these `routes` from `from`; if `to` is supplied,
to `to`, by breadth-first search."
([routes from]
(map
(fn [to] (cons from to))
(remove
empty?
(map
(fn [route]
(remove
#(= from %)
(if (some #(= % from) route) route)))
routes))))
([routes from to]
(let [steps (find-routes routes from)
found (filter
(fn [step] (if (some #(= to %) step) step))
steps)]
(if
(empty? found)
(find-routes routes from to steps)
found)))
([routes from to steps]
(if
(not (empty? steps))
(let [paths (remove
cyclic?
(mapcat
(fn [path]
(map
(fn [x] (concat path (rest x)))
(find-routes routes (last path))))
steps))
found (filter
#(= (last %) to) paths)]
(if
(empty? found)
(find-routes routes from to paths)
found)))))
(defn find-route
"Find a single route from `from` to `to` in this `world-or-routes`, which
may be either a world as defined in [[the-great-game.world.world]] or else
a sequence of tuples of keywords."
[world-or-routes from to]
(first
(find-routes
(or (:routes world-or-routes) world-or-routes)
from
to)))

View file

@ -0,0 +1,39 @@
(ns cc.journeyman.the-great-game.world.run
"Run the whole simulation"
(:require [environ.core :refer [env]]
[taoensso.timbre :as timbre]
[taoensso.timbre.appenders.3rd-party.rotor :as rotor]
[cc.journeyman.the-great-game.gossip.gossip :as g]
[cc.journeyman.the-great-game.merchants.merchants :as m]
[cc.journeyman.the-great-game.merchants.markets :as k]
[cc.journeyman.the-great-game.world.world :as w]))
(defn init
([]
(init {}))
([config]
(timbre/merge-config!
{:appenders
{:rotor (rotor/rotor-appender
{:path "the-great-game.log"
:max-size (* 512 1024)
:backlog 10})}
:level (or
(:log-level config)
(if (env :dev) :debug)
:info)})))
(defn run
"The pipeline to run the simulation each game day. Returns a world like
this world, with all the various active elements updated. The optional
`date` argument, if supplied, is set as the `:date` of the returned world."
([world]
(g/run
(m/run
(k/run
(w/run world)))))
([world date]
(g/run
(m/run
(k/run
(w/run world date))))))

View file

@ -0,0 +1,192 @@
(ns cc.journeyman.the-great-game.world.world
"Access to data about the world")
;;; The world has to work either as map or a database. Initially, and for
;;; unit tests, I'll use a map; later, there will be a database. But the
;;; API needs to be agnostic, so that heirarchies which interact with
;;; `world` don't have to know which they've got - as far as they're concerned
;;; it's just a handle.
(def default-world
"A basic world for testing concepts"
{:date 0 ;; the age of this world in game days
:cities
{:aberdeen
{:id :aberdeen
:supplies
;; `supplies` is the quantity of each commodity added to the stock
;; each game day. If the price in the market is lower than 1 (the
;; cost of production of a unit) no goods will be added.
{:fish 10
:leather 5}
:demands
;; `stock` is the quantity of each commodity in the market at any
;; given time. It is adjusted for production and consumption at
;; the end of each game day.
{:iron 1
:cloth 10
:whisky 10}
:port true
:prices
;; `prices`: the current price (both buying and selling, for simplicity)
;; of each commodity in the market. Updated each game day based on current
;; stock.
{:cloth 1
:fish 1
:leather 1
:iron 1
:whisky 1}
:stock
;; `stock` is the quantity of each commodity in the market at any
;; given time. It is adjusted for production and consumption at
;; the end of each game day.
{:cloth 0
:fish 0
:leather 0
:iron 0
:whisky 0}
:cash 100}
:buckie
{:id :buckie
:supplies
{:fish 20}
:demands
{:cloth 5
:leather 3
:whisky 5
:iron 1}
:port true
:prices {:cloth 1
:fish 1
:leather 1
:iron 1
:whisky 1}
:stock {:cloth 0
:fish 0
:leather 0
:iron 0
:whisky 0}
:cash 100}
:callander
{:id :callander
:supplies {:leather 20}
:demands
{:cloth 5
:fish 3
:whisky 5
:iron 1}
:prices {:cloth 1
:fish 1
:leather 1
:iron 1
:whisky 1}
:stock {:cloth 0
:fish 0
:leather 0
:iron 0
:whisky 0}
:cash 100}
:dundee {:id :dundee}
:edinburgh {:id :dundee}
:falkirk
{:id :falkirk
:supplies {:iron 10}
:demands
{:cloth 5
:leather 3
:whisky 5
:fish 10}
:port true
:prices {:cloth 1
:fish 1
:leather 1
:iron 1
:whisky 1}
:stock {:cloth 0
:fish 0
:leather 0
:iron 0
:whisky 0}
:cash 100}
:glasgow
{:id :glasgow
:supplies {:whisky 10}
:demands
{:cloth 5
:leather 3
:iron 5
:fish 10}
:port true
:prices {:cloth 1
:fish 1
:leather 1
:iron 1
:whisky 1}
:stock {:cloth 0
:fish 0
:leather 0
:iron 0
:whisky 0}
:cash 100}}
:merchants
{:archie {:id :archie
:home :aberdeen :location :aberdeen :cash 100 :capacity 10
:known-prices {}
:stock {}}
:belinda {:id :belinda
:home :buckie :location :buckie :cash 100 :capacity 10
:known-prices {}
:stock {}}
:callum {:id :callum
:home :callander :location :calander :cash 100 :capacity 10
:known-prices {}
:stock {}}
:deirdre {:id :deidre
:home :dundee :location :dundee :cash 100 :capacity 10
:known-prices {}
:stock {}}
:euan {:id :euan
:home :edinbirgh :location :edinburgh :cash 100 :capacity 10
:known-prices {}
:stock {}}
:fiona {:id :fiona
:home :falkirk :location :falkirk :cash 100 :capacity 10
:known-prices {}
:stock {}}}
:routes
;; all routes can be traversed in either direction and are assumed to
;; take the same amount of time.
[[:aberdeen :buckie]
[:aberdeen :dundee]
[:callander :glasgow]
[:dundee :callander]
[:dundee :edinburgh]
[:dundee :falkirk]
[:edinburgh :falkirk]
[:falkirk :glasgow]]
:commodities
;; cost of commodities is expressed in person/days;
;; weight in packhorse loads. Transport in this model
;; is all overland; you don't take bulk cargoes overland
;; in this period, it's too expensive.
{:cloth {:id :cloth :cost 1 :weight 0.25}
:fish {:id :fish :cost 1 :weight 1}
:leather {:id :leather :cost 1 :weight 0.5}
:whisky {:id :whisky :cost 1 :weight 0.1}
:iron {:id :iron :cost 1 :weight 10}}})
(defn actual-price
"Find the actual current price of this `commodity` in this `city` given
this `world`. **NOTE** that merchants can only know the actual prices in
the city in which they are currently located."
[world commodity city]
(-> world :cities city :prices commodity))
(defn run
"Return a world like this `world` with only the `:date` to this `date`
(or id `date` not supplied, the current value incremented by one). For
running other aspects of the simulation, see [[the-great-game.world.run]]."
([world]
(run world (inc (or (:date world) 0))))
([world date]
(assoc world :date date)))