From 23032c586cf9b4b858aa839045b22a2ef1e546e8 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Wed, 9 Jun 2021 20:20:52 +0100 Subject: [PATCH] Working on unit tests. --- .../the_great_game/agent/agent.clj.html | 143 +++ .../buildings/rectangular.clj.html | 548 ++++++++++ .../the_great_game/gossip/gossip.clj.html | 227 +++++ .../the_great_game/gossip/news_items.clj.html | 947 ++++++++++++++++++ .../the_great_game/holdings/holding.clj.html | 146 +++ .../the_great_game/location/location.clj.html | 149 +++ .../the_great_game/merchants/markets.clj.html | 260 +++++ .../merchants/merchant_utils.clj.html | 326 ++++++ .../merchants/merchants.clj.html | 92 ++ .../merchants/planning.clj.html | 485 +++++++++ .../merchants/strategies/simple.clj.html | 527 ++++++++++ .../the_great_game/objects/container.clj.html | 41 + .../objects/game_object.clj.html | 71 ++ .../the_great_game/playroom.clj.html | 224 +++++ .../journeyman/the_great_game/time.clj.html | 440 ++++++++ .../journeyman/the_great_game/utils.clj.html | 143 +++ .../the_great_game/world/heightmap.clj.html | 485 +++++++++ .../the_great_game/world/location.clj.html | 119 +++ .../the_great_game/world/mw.clj.html | 29 + .../the_great_game/world/routes.clj.html | 173 ++++ .../the_great_game/world/run.clj.html | 125 +++ .../the_great_game/world/world.clj.html | 584 +++++++++++ docs/cloverage/index.html | 249 +++-- .../journeyman}/architecture.md | 0 .../the_great_game/buildings/rectangular.clj | 30 - .../the_great_game/gossip/news_items.clj | 72 +- .../the_great_game/location/location.clj | 2 - .../the_great_game/gossip/news_items_test.clj | 172 ++-- 28 files changed, 6602 insertions(+), 207 deletions(-) create mode 100644 docs/cloverage/cc/journeyman/the_great_game/agent/agent.clj.html create mode 100644 docs/cloverage/cc/journeyman/the_great_game/buildings/rectangular.clj.html create mode 100644 docs/cloverage/cc/journeyman/the_great_game/gossip/gossip.clj.html create mode 100644 docs/cloverage/cc/journeyman/the_great_game/gossip/news_items.clj.html create mode 100644 docs/cloverage/cc/journeyman/the_great_game/holdings/holding.clj.html create mode 100644 docs/cloverage/cc/journeyman/the_great_game/location/location.clj.html create mode 100644 docs/cloverage/cc/journeyman/the_great_game/merchants/markets.clj.html create mode 100644 docs/cloverage/cc/journeyman/the_great_game/merchants/merchant_utils.clj.html create mode 100644 docs/cloverage/cc/journeyman/the_great_game/merchants/merchants.clj.html create mode 100644 docs/cloverage/cc/journeyman/the_great_game/merchants/planning.clj.html create mode 100644 docs/cloverage/cc/journeyman/the_great_game/merchants/strategies/simple.clj.html create mode 100644 docs/cloverage/cc/journeyman/the_great_game/objects/container.clj.html create mode 100644 docs/cloverage/cc/journeyman/the_great_game/objects/game_object.clj.html create mode 100644 docs/cloverage/cc/journeyman/the_great_game/playroom.clj.html create mode 100644 docs/cloverage/cc/journeyman/the_great_game/time.clj.html create mode 100644 docs/cloverage/cc/journeyman/the_great_game/utils.clj.html create mode 100644 docs/cloverage/cc/journeyman/the_great_game/world/heightmap.clj.html create mode 100644 docs/cloverage/cc/journeyman/the_great_game/world/location.clj.html create mode 100644 docs/cloverage/cc/journeyman/the_great_game/world/mw.clj.html create mode 100644 docs/cloverage/cc/journeyman/the_great_game/world/routes.clj.html create mode 100644 docs/cloverage/cc/journeyman/the_great_game/world/run.clj.html create mode 100644 docs/cloverage/cc/journeyman/the_great_game/world/world.clj.html rename src/{the_great_game => cc/journeyman}/architecture.md (100%) diff --git a/docs/cloverage/cc/journeyman/the_great_game/agent/agent.clj.html b/docs/cloverage/cc/journeyman/the_great_game/agent/agent.clj.html new file mode 100644 index 0000000..cafc39e --- /dev/null +++ b/docs/cloverage/cc/journeyman/the_great_game/agent/agent.clj.html @@ -0,0 +1,143 @@ + + + + cc/journeyman/the_great_game/agent/agent.clj + + + + 001  (ns cc.journeyman.the-great-game.agent.agent +
+ + 002    "Anything in the game world with agency; primarily but not exclusively +
+ + 003     characters." +
+ + 004    (:require [cc.journeyman.the-great-game.objects.game-object :refer [ProtoObject]] +
+ + 005              [cc.journeyman.the-great-game.objects.container :refer [ProtoContainer]])) +
+ + 006   +
+ + 007  ;;;  hierarchy of needs probably gets implemented here +
+ + 008  ;;;  I'm probably going to want to defprotocol stuff, to define the hierarchy +
+ + 009  ;;;  of things in the gameworld; either that or drop to Java, wich I'd rather not do. +
+ + 010   +
+ + 011  (defprotocol ProtoAgent +
+ + 012    "An object which can act in the world" +
+ + 013    (act +
+ + 014      [actor world circle] +
+ + 015         "Allow `actor` to do something in this `world`, in the context of this +
+ + 016         `circle`; return the new state of the actor if something was done, `nil` +
+ + 017         if nothing was done. Circle is expected to be one of +
+ + 018   +
+ + 019         * `:active` - actors within visual/audible range of the player +
+ + 020           character; +
+ + 021         * `:pending` - actors not in the active circle, but sufficiently close +
+ + 022           to it that they may enter the active circle within a short period; +
+ + 023         * `:background` - actors who are active in the background in order to +
+ + 024           handle trade, news, et cetera; +
+ + 025         * `other` - actors who are not members of any other circle, although +
+ + 026           I'm not clear whether it would ever be appropriate to invoke an +
+ + 027           `act` method on them. +
+ + 028   +
+ + 029         The `act` method *must not* have side effects; it must *only* return a +
+ + 030         new state. If the actor's intention is to seek to change the state of +
+ + 031         something else in the game world, it must add a representation of that +
+ + 032         intention to the sequence which will be returned by its +
+ + 033         `pending-intentions` method.") +
+ + 034    (pending-intentions +
+ + 035      [actor] +
+ + 036      "Returns a sequence of effects an actor intends, as a consequence of +
+ + 037      acting. The encoding of these is not yet defined.")) +
+ + 038   +
+ + 039  (defrecord Agent +
+ + 040    ;; "A default agent." +
+ + 041    [name craft home culture] +
+ + 042    ProtoObject +
+ + 043    ProtoContainer +
+ + 044    ProtoAgent +
+ + 045  ) +
+ + diff --git a/docs/cloverage/cc/journeyman/the_great_game/buildings/rectangular.clj.html b/docs/cloverage/cc/journeyman/the_great_game/buildings/rectangular.clj.html new file mode 100644 index 0000000..f276d7b --- /dev/null +++ b/docs/cloverage/cc/journeyman/the_great_game/buildings/rectangular.clj.html @@ -0,0 +1,548 @@ + + + + cc/journeyman/the_great_game/buildings/rectangular.clj + + + + 001  (ns cc.journeyman.the-great-game.buildings.rectangular +
+ + 002    "Build buildings with a generally rectangular floow plan. +
+ + 003      +
+ + 004     ## Motivations +
+ + 005      +
+ + 006     Right, the idea behind this namespace is many fold. +
+ + 007   +
+ + 008     1. To establish the broad principle of genetic buildings, by creating a +
+ + 009        function which reproducibly creates reproducible buildings at specified +
+ + 010        locations, such that different buildings are credibly varied but a +
+ + 011        building at a specified location is always (modulo economic change) the +
+ + 012        same. +
+ + 013     2. Create good rectangular buildings, and investigate whether a single  +
+ + 014        function can be used to create buildings of more than one family (e.g. +
+ + 015        can it produce flat roofed, north African style, mud brick houses as +
+ + 016        well as pitch roofed, half timbered northern European houses?) +
+ + 017     3. Establish whether, in my current state of fairly severe mental illness, +
+ + 018        I can actually produce any usable code at all. +
+ + 019   +
+ + 020     ## Key factors in the creation of a building +
+ + 021   +
+ + 022     ### Holding +
+ + 023   +
+ + 024     Every building is on a holding, and, indeed, what I mean by 'building' here +
+ + 025     may well turn out to be 'the collection of all the permanent structures on +
+ + 026     a holding. A holding is a polygonal area of the map which does not  +
+ + 027     intersect with any other holding, but for the time being we'll make the  +
+ + 028     simplifying assumption that every holding is a rectangular strip, and that +
+ + 029     'urban' holdings are of a reasonably standard width (see Viking-period  +
+ + 030     York) and length. Rural holdings (farms, ?wood lots) may be much larger. +
+ + 031   +
+ + 032     ### Terrain +
+ + 033   +
+ + 034     A building is made of the stuff of the place. In a forest, buildings will  +
+ + 035     tend to be wooden; in a terrain with rocky outcrops -- normally found on  +
+ + 036     steep slopes -- stone. On the flat lands where there's river mud, of brick, +
+ + 037     cob, or wattle and daub. So to build a building we need to know the  +
+ + 038     terrain. Terrain can be inferred from location but in practice this will  +
+ + 039     be computationally expensive, so we'll pass terrain in as an argument to +
+ + 040     the build function. +
+ + 041   +
+ + 042     For the time being we'll pass it in simply as a keyword from a defined set +
+ + 043     of keywords; later it may be a more sophisticated data structure. +
+ + 044   +
+ + 045     ### Culture +
+ + 046   +
+ + 047     People of different cultures build distinctively different buildings, even +
+ + 048     when using the same materials. So, in our world, a Japanese wooden house  +
+ + 049     looks quite different from an Anglo Saxon stave house which looks quite  +
+ + 050     different from a Canadian log cabin, even though the materials are much the +
+ + 051     same and the tools available to build with are not much different. +
+ + 052   +
+ + 053     Culture can affect not just the overall shape of a building but also its  +
+ + 054     finish and surface detail. For example, in many places in England, stone +
+ + 055     buildings are typically left bare; in rural Scotland, typically painted  +
+ + 056     white or in pastel shades; in Ireland, often quite vivid colours. +
+ + 057   +
+ + 058     People may also show religious or cultural symbols on their buildings. +
+ + 059    +
+ + 060     For all these reasons, we need to know the culture of the occupant when +
+ + 061     creating a building. Again, this will initially be passed in as a keyword. +
+ + 062   +
+ + 063     ### Craft +
+ + 064   +
+ + 065     People in the game world have a craft, and some crafts will require  +
+ + 066     different features in the building. In the broadly late-bronze-age-to +
+ + 067     medieval period within which the game is set, residence and  workplace +
+ + 068     are for most people pretty much the same. +
+ + 069   +
+ + 070     So a baker needs an oven, a smith a forge, and so on. All crafts who do +
+ + 071     some degree retail trade will want a shop front as part of the ground  +
+ + 072     floor of their dwelling. Merchants and bankers will probably have houses +
+ + 073     that are a bit more showy than others. +
+ + 074   +
+ + 075     Whether the 'genetic buildings' idea will ever really produce suitable +
+ + 076     buildings for aristons I don't know; it seems more likely that significant +
+ + 077     strongholds (of which there will be relatively few) should all be hand +
+ + 078     modelled rather than procedurally generated." +
+ + 079    (:require [cc.journeyman.the-great-game.holdings.holding :refer [ProtoHolding]] +
+ + 080              [cc.journeyman.the-great-game.location.location :refer [ProtoLocation]]) +
+ + 081    (:import [org.apache.commons.math3.random MersenneTwister])) +
+ + 082   +
+ + 083    +
+ + 084  (def ^:dynamic *terrain-types*  +
+ + 085    "Types of terrain which affect building families. TODO: This is a placeholder; +
+ + 086     a more sophisticated model will be needed." +
+ + 087    #{:arable :arid :forest :plateau :upland}) +
+ + 088   +
+ + 089  (def ^:dynamic *cultures* +
+ + 090    "Cultures which affect building families. TODO: placeholder" +
+ + 091    #{:ariston :coastal :steppe-clans :western-clans :wild-herd}) +
+ + 092   +
+ + 093  (def ^:dynamic *crafts* +
+ + 094    "Crafts which affect building types in the game. See  +
+ + 095     `Populating a game world`. TODO: placeholder" +
+ + 096    #{:baker :banker :butcher :chancellor :innkeeper :lawyer :magus :merchant :miller :priest :scholar :smith :weaver}) +
+ + 097   +
+ + 098  (def ^:dynamic *building-families*  +
+ + 099    "Families of buildings. +
+ + 100      +
+ + 101     Each family has +
+ + 102      +
+ + 103     * terrain types to which it is appropriate; +
+ + 104     * crafts to which it is appropriate; +
+ + 105     * cultures to which it is appropriate.  +
+ + 106      +
+ + 107     Each generated building will be of one family, and will comprise modules  +
+ + 108     taken only from that family." +
+ + 109    {:pitched-rectangular {:terrains #{:arable :forest :upland} +
+ + 110                           :crafts *crafts* +
+ + 111                           :cultures #{:coastal :western-clans} +
+ + 112                           :modules []} +
+ + 113     :flatroof-rectangular {:terrains #{:arid :plateau} +
+ + 114                            :crafts *crafts* +
+ + 115                            :cultures #{:coastal} +
+ + 116                            :modules []}}) +
+ + 117   +
+ + 118  ;; TODO: So, modules need to contain +
+ + 119  ;; +
+ + 120  ;; 1. Ground floor modules, having external doors; +
+ + 121  ;; 2. Craft modules -- workshops -- which will normally be ground floor (except +
+ + 122  ;; weavers) and may have the constraint that no upper floor module can cover them; +
+ + 123  ;; 3. Upper floor modules, having NO external doors (but linking internal doors); +
+ + 124  ;; 4. Roof modules +
+ + 125  ;;  +
+ + 126  ;; There also needs to be an undercroft or platform module, such that the area of  +
+ + 127  ;; the top of the platform is identical with the footprint of the building, and  +
+ + 128  ;; the altitude of the top of the platform is equal to the altitude of the  +
+ + 129  ;; terrain at the heighest corner of the building; so that the actual  +
+ + 130  ;; building doesn't float in the air, and also so that none of the doors or windows +
+ + 131  ;; are partly underground. +
+ + 132  ;; +
+ + 133  ;; Each module needs to wrap an actual 3d model created in Blender or whatever,  +
+ + 134  ;; and have a list of optional textures with which that model can be rendered.  +
+ + 135  ;; So an upper floor bedroom module might have the following renders: +
+ + 136  ;; +
+ + 137  ;; 1. Bare masonry - constrained to upland or plateau terrain, and to coastal culture +
+ + 138  ;; 2. Painted masonry - constrained to upland or plateau terrain, and to coastal culture +
+ + 139  ;; 3. Half-timbered - not available on plateau terrain +
+ + 140  ;; 4. Weatherboarded - constrained to forest terrain +
+ + 141  ;; 5. Brick - constrained to arable or arid terrain +
+ + 142  ;; +
+ + 143  ;; of course these are only examples, and also, it's entirely possible to have +
+ + 144  ;; for example multiple different weatherboard renders for the same module.  +
+ + 145  ;; There needs to be a way of rendering what can be built above what: for +
+ + 146  ;; example, you can't have a masonry clad module over a half timbered one,  +
+ + 147  ;; but you can have a half-timbered one over a masonry one +
+ + 148   +
+ + 149  (defn building-family +
+ + 150    "A building family is essentially a collection of models of building modules +
+ + 151     which can be assembled to create buildings of a particular structural and +
+ + 152     architectural style." +
+ + 153    [terrain culture craft gene] +
+ + 154    (let [candidates (filter #(and +
+ + 155                               ((:terrains %) terrain) +
+ + 156                               ((:crafts %) craft) +
+ + 157                               ((:cultures %) culture)) +
+ + 158                             (vals *building-families*))] +
+ + 159      (nth candidates (mod (Math/abs (.nextInt gene)) (count candidates))))) +
+ + 160   +
+ + 161  (building-family :arable :coastal :baker (MersenneTwister. 5)) +
+ + 162   +
+ + 163  (defn build!  +
+ + 164    "Builds a building, and returns a data structure which represents it. In  +
+ + 165     building the building, it adds a model of the building to the representation +
+ + 166     of the world, so it does have a side effect." +
+ + 167    [holding terrain culture craft size] +
+ + 168    (if (satisfies? ProtoHolding holding) +
+ + 169    (let [location (.building-origin holding) +
+ + 170          gene (MersenneTwister. (int (+ (* (.easting location) 1000000) (.northing location)))) +
+ + 171          family (building-family terrain culture craft gene)] +
+ + 172    (if  +
+ + 173     (and (instance? ProtoLocation location) (:orientation location)) +
+ + 174      :stuff +
+ + 175      :nonsense +
+ + 176      )) +
+ + 177      :froboz)) +
+ + 178   +
+ + 179  ;; (def ol (cc.journeyman.the-great-game.location.location/OrientedLocation. 123.45 543.76 12.34 0.00 {})) +
+ + 180   +
+ + diff --git a/docs/cloverage/cc/journeyman/the_great_game/gossip/gossip.clj.html b/docs/cloverage/cc/journeyman/the_great_game/gossip/gossip.clj.html new file mode 100644 index 0000000..cf48455 --- /dev/null +++ b/docs/cloverage/cc/journeyman/the_great_game/gossip/gossip.clj.html @@ -0,0 +1,227 @@ + + + + cc/journeyman/the_great_game/gossip/gossip.clj + + + + 001  (ns cc.journeyman.the-great-game.gossip.gossip +
+ + 002    "Interchange of news events between gossip agents. +
+ + 003      +
+ + 004     Note that habitual travellers are all gossip agents; specifically, at this +
+ + 005     stage, that means merchants. When merchants are moved we also need to +
+ + 006     update the location of the gossip with the same key. +
+ + 007      +
+ + 008     Innkeepers are also gossip agents but do not typically move." +
+ + 009    (:require [cc.journeyman.the-great-game.utils :refer [deep-merge]] +
+ + 010              [cc.journeyman.the-great-game.gossip.news-items :refer [learn-news-item]] +
+ + 011              )) +
+ + 012   +
+ + 013   +
+ + 014  (defn dialogue +
+ + 015    "Dialogue between an `enquirer` and an `agent` in this `world`; returns a +
+ + 016    map identical to `enquirer` except that its `:gossip` collection may have +
+ + 017    additional entries." +
+ + 018    ;; TODO: not yet written, this is a stub. +
+ + 019    [enquirer respondent world] +
+ + 020    enquirer) +
+ + 021   +
+ + 022  (defn gather-news +
+ + 023    "Gather news for the specified `gossip` in this `world`." +
+ + 024    [world gossip] +
+ + 025    (let [g (cond (keyword? gossip) +
+ + 026                  (-> world :gossips gossip) +
+ + 027                  (map? gossip) +
+ + 028                  gossip)] +
+ + 029      (if g +
+ + 030        {:gossips +
+ + 031         {(:id g) +
+ + 032          (reduce +
+ + 033           deep-merge +
+ + 034           {} +
+ + 035           (map +
+ + 036            #(dialogue g % world) +
+ + 037            (remove +
+ + 038             #(= g %) +
+ + 039             (filter +
+ + 040              #(= (:location %) (:location g)) +
+ + 041              (vals (:gossips world))))))}} +
+ + 042        {}))) +
+ + 043   +
+ + 044  (defn move-gossip +
+ + 045    "Return a world like this `world` but with this `gossip` moved to this +
+ + 046    `new-location`. Many gossips are essentially shadow-records of agents of +
+ + 047    other types, and the movement of the gossip should be controlled by the +
+ + 048    run function of the type of the record they shadow. The [[#run]] function +
+ + 049    below does NOT call this function." +
+ + 050    [gossip world new-location] +
+ + 051    (let [id (cond +
+ + 052              (map? gossip) +
+ + 053              (-> world :gossips gossip :id) +
+ + 054              (keyword? gossip) +
+ + 055              gossip)] +
+ + 056    (deep-merge +
+ + 057      world +
+ + 058      {:gossips +
+ + 059       {id +
+ + 060        {:location new-location}}}))) +
+ + 061   +
+ + 062  (defn run +
+ + 063    "Return a world like this `world`, with news items exchanged between gossip +
+ + 064    agents." +
+ + 065    [world] +
+ + 066    (reduce +
+ + 067     deep-merge +
+ + 068     world +
+ + 069     (map +
+ + 070      #(gather-news world %) +
+ + 071      (keys (:gossips world))))) +
+ + 072   +
+ + 073   +
+ + diff --git a/docs/cloverage/cc/journeyman/the_great_game/gossip/news_items.clj.html b/docs/cloverage/cc/journeyman/the_great_game/gossip/news_items.clj.html new file mode 100644 index 0000000..3a27e1d --- /dev/null +++ b/docs/cloverage/cc/journeyman/the_great_game/gossip/news_items.clj.html @@ -0,0 +1,947 @@ + + + + cc/journeyman/the_great_game/gossip/news_items.clj + + + + 001  (ns cc.journeyman.the-great-game.gossip.news-items +
+ + 002    "Categories of news events interesting to gossip agents. +
+ + 003      +
+ + 004     The ideas here are based on the essay [The spread of knowledge in a large +
+ + 005     game world](The-spread-of-knowledge-in-a-large-game-world.html), q.v.;  +
+ + 006     they've advanced a little beyond that and will doubtless +
+ + 007     advance further in the course of writing and debugging this namespace. +
+ + 008   +
+ + 009     A news item is a map with the keys: +
+ + 010    +
+ + 011     * `date` - the date on which the reported event happened; +
+ + 012     * `nth-hand` - the number of agents the news item has passed through; +
+ + 013     * `verb` - what it is that happened (key into `news-topics`); +
+ + 014   +
+ + 015     plus other keys taken from the `keys` value associated with the verb in +
+ + 016     `news-topics`. +
+ + 017      +
+ + 018     ## Notes: +
+ + 019      +
+ + 020     *TODO*    +
+ + 021     This namespace at present considers the `:knowledge` of a gossip to be a flat +
+ + 022     list of propositions, each of which must be checked every time any new +
+ + 023     proposition is offered. This is woefully inefficient. " +
+ + 024    (:require [cc.journeyman.the-great-game.world.location :refer [distance-between]] +
+ + 025              [cc.journeyman.the-great-game.time :refer [game-time]])) +
+ + 026   +
+ + 027   +
+ + 028  (def news-topics +
+ + 029    "Topics of interest to gossip agents. Topics are keyed in this map by +
+ + 030    their `verbs`. The `keys` associated with each topic are the extra pieces +
+ + 031    of information required to give context to a gossip item. Generally: +
+ + 032   +
+ + 033    * `actor` is the id of the character who it is reported performed the +
+ + 034    action; +
+ + 035    * `other` is the id of the character on whom it is reported the action +
+ + 036    was performed; +
+ + 037    * `location` is the place at which the action was performed; +
+ + 038    * `object` is an object (or possibly list of objects?) relevant to the +
+ + 039    action; +
+ + 040    * `price` is special to buy/sell, but of significant interest to merchants. +
+ + 041   +
+ + 042    ## Notes +
+ + 043   +
+ + 044    ### Characters +
+ + 045   +
+ + 046    *TODO* but note that at most all the receiver can learn about a character +
+ + 047    from a news item is what the giver knows about that character, degraded by +
+ + 048    what the receiver finds interesting about them. If we just pass the id here, +
+ + 049    then either the receiver knows everything in the database about the +
+ + 050    character, or else the receiver knows nothing at all about the character. +
+ + 051    Neither is desirable. Further thought needed. +
+ + 052   +
+ + 053    By implication, the character values passed should include *all* the +
+ + 054    information the giver knows about the character; that can then be degraded +
+ + 055    as the receiver stores only that segment which the receiver finds +
+ + 056    interesting. +
+ + 057   +
+ + 058    ### Locations +
+ + 059   +
+ + 060    A 'location' value is a list comprising at most the x/y coordinate location +
+ + 061    and the ids of the settlement and region (possibly hierarchically) that contain +
+ + 062    the location. If the x/y is not local to the home of the receiving agent, they +
+ + 063    won't remember it and won't pass it on; if any of the ids are not interesting +
+ + 064    So location information will degrade progressively as the item is passed along. +
+ + 065   +
+ + 066    It is assumed that the `:home` of a character is a location in this sense. +
+ + 067   +
+ + 068    ### Inferences +
+ + 069   +
+ + 070    If an agent learns that Adam has married Betty, they can infer that Betty has +
+ + 071    married Adam; if they learn that Charles killed Dorothy, that Dorothy has died. +
+ + 072    I'm not convinced that my representation of inferences here is ideal. +
+ + 073    " +
+ + 074    {;; A significant attack is interesting whether or not it leads to deaths +
+ + 075     :attack {:verb :attack :keys [:actor :other :location]} +
+ + 076      ;; Deaths of characters may be interesting +
+ + 077     :die {:verb :die :keys [:actor :location]} +
+ + 078      ;; Deliberate killings are interesting. +
+ + 079     :kill {:verb :kill :keys [:actor :other :location] +
+ + 080            :inferences [{:verb :die :actor :other :other :nil}]} +
+ + 081      ;; Marriages may be interesting +
+ + 082     :marry {:verb :marry :keys [:actor :other :location] +
+ + 083             :inferences [{:verb :marry :actor :other :other :actor}]} +
+ + 084      ;; The end of ongoing open conflict between to characters may be interesting +
+ + 085     :peace {:verb :peace :keys [:actor :other :location] +
+ + 086             :inferences [{:verb :peace :actor :other :other :actor}]} +
+ + 087      ;; Things related to the plot are interesting, but will require special +
+ + 088      ;; handling. Extra keys may be required by particular plot events. +
+ + 089     :plot {:verb :plot :keys [:actor :other :object :location]} +
+ + 090      ;; Rapes are interesting. +
+ + 091     :rape {:verb :rape :keys [:actor :other :location] +
+ + 092             ;; Should you also infer from rape that actor is male and adult? +
+ + 093            :inferences [{:verb :attack} +
+ + 094                         {:verb :sex} +
+ + 095                         {:verb :sex :actor :other :other :actor}]} +
+ + 096      ;; Merchants, especially, are interested in prices in other markets +
+ + 097     :sell {:verb :sell :keys [:actor :other :object :location :price]} +
+ + 098      ;; Sex can juicy gossip, although not normally if the participants are in an +
+ + 099      ;; established sexual relationship. +
+ + 100     :sex {:verb :sex :keys [:actor :other :location] +
+ + 101           :inferences [{:verb :sex :actor :other :other :actor}]} +
+ + 102      ;; Thefts are interesting. +
+ + 103     :steal {:verb :steal :keys [:actor :other :object :location]} +
+ + 104      ;; The succession of rulers is interesting; of respected craftsmen, +
+ + 105      ;; potentially also interesting. +
+ + 106     :succession {:verb :succession :keys [:actor :other :location :rank]} +
+ + 107      ;; The start of ongoing open conflict between two characters may be interesting. +
+ + 108     :war {:verb :war :keys [:actor :other :location] +
+ + 109           :inferences [{:verb :war :actor :other :other :actor}]}}) +
+ + 110   +
+ + 111   +
+ + 112  (defn interest-in-character +
+ + 113    "Integer representation of how interesting this `character` is to this +
+ + 114    `gossip`. +
+ + 115    *TODO:* this assumes that characters are passed as keywords, but, as +
+ + 116    documented above, they probably have to be maps, to allow for degradation." +
+ + 117    [gossip character] +
+ + 118    (count +
+ + 119     (concat +
+ + 120      (filter #(= (:actor % character)) (:knowledge gossip)) +
+ + 121      (filter #(= (:other % character)) (:knowledge gossip))))) +
+ + 122   +
+ + 123  (defn interesting-character? +
+ + 124    "Boolean representation of whether this `character` is interesting to this +
+ + 125    `gossip`." +
+ + 126    [gossip character] +
+ + 127    (> (interest-in-character gossip character) 0)) +
+ + 128   +
+ + 129  (defn interest-in-location +
+ + 130    "Integer representation of how interesting this `location` is to this +
+ + 131    `gossip`." +
+ + 132    [gossip location] +
+ + 133    (cond +
+ + 134      (and (map? location) (number? (:x location)) (number? (:y location))) +
+ + 135      (if-let [home (:home gossip)] +
+ + 136        (let [d (distance-between location home) +
+ + 137              i (/ 10000 d) ;; 10000 at metre scale is 10km; interest should +
+ + 138              ;;fall off with distance from home, but possibly on a log scale +
+ + 139              ] +
+ + 140          (if (> i 1) i 0)) +
+ + 141        0) +
+ + 142      (coll? location) +
+ + 143      (reduce +
+ + 144       + +
+ + 145       (map +
+ + 146        #(interest-in-location gossip %) +
+ + 147        location)) +
+ + 148      :else +
+ + 149      (count +
+ + 150       (filter +
+ + 151        #(some (fn [x] (= x location)) (:location %)) +
+ + 152        (cons {:location (:home gossip)} (:knowledge gossip)))))) +
+ + 153   +
+ + 154  ;; (interest-in-location {:home [{0, 0} :test-home] :knowledge []} [:test-home]) +
+ + 155   +
+ + 156  (defn interesting-location? +
+ + 157    "True if the location of this news `item` is interesting to this `gossip`." +
+ + 158    [gossip item] +
+ + 159    (> (interest-in-location gossip (:location item)) 0)) +
+ + 160   +
+ + 161  (defn interesting-object? +
+ + 162    [gossip object] +
+ + 163    ;; TODO: Not yet (really) implemented +
+ + 164    true) +
+ + 165   +
+ + 166  (defn interesting-topic? +
+ + 167    [gossip topic] +
+ + 168    ;; TODO: Not yet (really) implemented +
+ + 169    true) +
+ + 170   +
+ + 171  (defn compatible-value? +
+ + 172    "True if `known-value` is the same as `new-value`, or, for each key present +
+ + 173     in `new-value`, has the same value for that key.  +
+ + 174      +
+ + 175     The rationale here is that if `new-value` contains new or different  +
+ + 176     information, it's worth learning; otherwise, not." +
+ + 177    [new-value known-value] +
+ + 178    (or +
+ + 179     (= new-value known-value) +
+ + 180     ;; TODO: some handwaving here about being a slightly better descriptor -- +
+ + 181     ;; having more keys than might  +
+ + 182     (when (and (map? new-value) (map? known-value)) +
+ + 183       (every? true? (map #(= (new-value %) (known-value %)) +
+ + 184                          (keys new-value)))))) +
+ + 185   +
+ + 186  (defn compatible-item? +
+ + 187    "True if `new-item` is identical with, or less specific than, `known-item`. +
+ + 188      +
+ + 189     If we already know 'Bad Joe killed Sweet Daisy', there's no point in  +
+ + 190     learning that 'someone killed Sweet Daisy', but there is point in learning +
+ + 191     'someone killed Sweet Daisy _with poison_'." +
+ + 192    [new-item known-item] +
+ + 193    (reduce +
+ + 194     #(and %1 %2) +
+ + 195     (map #(if +
+ + 196            (known-item %) ;; if known-item has this key +
+ + 197             (compatible-value? (new-item %) (known-item %)) +
+ + 198             true) +
+ + 199          (remove #{:nth-hand :confidence :learned-from} (keys new-item))))) +
+ + 200   +
+ + 201  (defn known-item? +
+ + 202    "True if this news `item` is already known to this `gossip`. +
+ + 203      +
+ + 204     This means that the `gossip` already knows an item which identifiably has +
+ + 205     the same _or more specific_ values for all the keys of this `item` except +
+ + 206     `:nth-hand`, `:confidence` and `:learned-from`." +
+ + 207    [gossip item] +
+ + 208    (reduce +
+ + 209     #(or %1 %2) +
+ + 210     (filter true? (map #(compatible-item? item %) (:knowledge gossip))))) +
+ + 211   +
+ + 212  (defn interesting-item? +
+ + 213    "True if anything about this news `item` is interesting to this `gossip`." +
+ + 214    [gossip item] +
+ + 215    (and (not (known-item? gossip item)) +
+ + 216         (or +
+ + 217          (interesting-character? gossip (:actor item)) +
+ + 218          (interesting-character? gossip (:other item)) +
+ + 219          (interesting-location? gossip (:location item)) +
+ + 220          (interesting-object? gossip (:object item)) +
+ + 221          (interesting-topic? gossip (:verb item))))) +
+ + 222   +
+ + 223  (defn infer +
+ + 224    "Infer a new knowledge item from this `item`, following this `rule`" +
+ + 225    [item rule] +
+ + 226    (reduce merge +
+ + 227            item +
+ + 228            (cons +
+ + 229             {:verb (:verb rule)} +
+ + 230             (map (fn [k] {k (apply (k rule) (list item))}) +
+ + 231                  (remove +
+ + 232                   #{:verb} +
+ + 233                   (keys rule)))))) +
+ + 234   +
+ + 235  (declare learn-news-item) +
+ + 236   +
+ + 237  (defn make-all-inferences +
+ + 238    "Return a list of knowledge entries that can be inferred from this news +
+ + 239    `item`." +
+ + 240    [item] +
+ + 241    (set +
+ + 242     (reduce +
+ + 243      concat +
+ + 244      (map +
+ + 245       #(:knowledge (learn-news-item {} (infer item %) false)) +
+ + 246       (:inferences (news-topics (:verb item))))))) +
+ + 247   +
+ + 248  (defn degrade-character +
+ + 249    "Return a character specification like this `character`, but comprising +
+ + 250    only those properties this `gossip` is interested in." +
+ + 251    [gossip character] +
+ + 252    ;; TODO: Not yet (really) implemented +
+ + 253    character) +
+ + 254   +
+ + 255  (defn degrade-location +
+ + 256    "Return a location specification like this `location`, but comprising +
+ + 257    only those elements this `gossip` is interested in. If none, return +
+ + 258    `nil`." +
+ + 259    [gossip location] +
+ + 260    (let [l (when +
+ + 261             (coll? location) +
+ + 262              (filter +
+ + 263               #(when (interesting-location? gossip %) %) +
+ + 264               location))] +
+ + 265      (when-not (empty? l) l))) +
+ + 266   +
+ + 267  (defn inc-or-one +
+ + 268    "If this `val` is a number, return that number incremented by one; otherwise, +
+ + 269     return 1. TODO: should probably be in `utils`." +
+ + 270    [val] +
+ + 271    (if +
+ + 272     (number? val) +
+ + 273      (inc val) +
+ + 274      1)) +
+ + 275   +
+ + 276  (defn learn-news-item +
+ + 277    "Return a gossip like this `gossip`, which has learned this news `item` if +
+ + 278    it is of interest to them." +
+ + 279    ([gossip item] +
+ + 280     (learn-news-item gossip item true)) +
+ + 281    ([gossip item follow-inferences?] +
+ + 282     (if +
+ + 283      (interesting-item? gossip item) +
+ + 284       (let [item' (assoc +
+ + 285                    item +
+ + 286                    :nth-hand (inc-or-one (:nth-hand item)) +
+ + 287                    :time-stamp (if +
+ + 288                                 (number? (:time-stamp item)) +
+ + 289                                  (:time-stamp item) +
+ + 290                                  (game-time)) +
+ + 291                    :location (degrade-location gossip (:location item)) +
+ + 292                    :actor (degrade-character gossip (:actor item)) +
+ + 293                    :other (degrade-character gossip (:other item)) +
+ + 294                    ;; TODO: do something to degrade confidence in the item, +
+ + 295                    ;; probably as a function of the provider's confidence in +
+ + 296                    ;; the item and the gossip's trust in the provider +
+ + 297                    ) +
+ + 298             g (assoc +
+ + 299                gossip +
+ + 300                :knowledge +
+ + 301                (cons +
+ + 302                 item' +
+ + 303                 (:knowledge gossip)))] +
+ + 304         (if follow-inferences? +
+ + 305           (assoc +
+ + 306            g +
+ + 307            :knowledge +
+ + 308            (concat (:knowledge g) (make-all-inferences item))) +
+ + 309           g))) +
+ + 310     gossip)) +
+ + 311   +
+ + 312   +
+ + 313   +
+ + diff --git a/docs/cloverage/cc/journeyman/the_great_game/holdings/holding.clj.html b/docs/cloverage/cc/journeyman/the_great_game/holdings/holding.clj.html new file mode 100644 index 0000000..1ed2918 --- /dev/null +++ b/docs/cloverage/cc/journeyman/the_great_game/holdings/holding.clj.html @@ -0,0 +1,146 @@ + + + + cc/journeyman/the_great_game/holdings/holding.clj + + + + 001  (ns cc.journeyman.the-great-game.holdings.holding +
+ + 002    (:require [cc.journeyman.the-great-game.agent.agent :refer [ProtoAgent]] +
+ + 003              [cc.journeyman.the-great-game.objects.container :refer [ProtoContainer]] +
+ + 004              [cc.journeyman.the-great-game.objects.game-object :refer [ProtoObject]] +
+ + 005  ;;            [cc.journeyman.the-great-game.location.location :refer [OrientedLocation]] +
+ + 006              [cc.journeyman.the-great-game.world.routes :refer []])) +
+ + 007   +
+ + 008  ;;; A holding is a polygonal area of the map which does not +
+ + 009  ;;; intersect with any other holding, or with any road or water feature. For  +
+ + 010  ;;; the time being we'll make the  +
+ + 011  ;;; simplifying assumption that every holding is a rectangular strip, and that +
+ + 012  ;;; 'urban' holdings are of a reasonably standard width (see Viking-period  +
+ + 013  ;;; York) and length. Rural holdings (farms, ?wood lots) may be much larger. +
+ + 014   +
+ + 015  (defprotocol ProtoHolding +
+ + 016    (frontage +
+ + 017      [holding] +
+ + 018      "Returns a sequence of two locations representing the edge of the polygon +
+ + 019      which defines this holding which is considered to be the front.") +
+ + 020    (building-origin +
+ + 021      [holding] +
+ + 022      "Returns an oriented location - normally the right hand end of the  +
+ + 023      frontage, for an urban holding - from which buildings on the holding +
+ + 024      should be built.")) +
+ + 025   +
+ + 026  (defrecord Holding [perimeter holder] +
+ + 027    ;; Perimeter should be a list of locations in exactly the same sense as a +
+ + 028    ;; route in `cc.journeyman.the-great-game.world.routes`. Some sanity checking +
+ + 029    ;; is needed to ensure this! +
+ + 030    ProtoContainer +
+ + 031    ProtoHolding +
+ + 032    (frontage  +
+ + 033      [holding] +
+ + 034     "TODO: this is WRONG, but will work for now. The frontage should +
+ + 035      be the side of the perimeter nearest to the nearest existing  +
+ + 036      route." +
+ + 037      [(first (perimeter holding)) (nth (perimeter holding) 1)]) +
+ + 038    (building-origin  +
+ + 039     [holding] +
+ + 040     "TODO: again this is WRONG. The default building origin for rectangular  +
+ + 041      buildings should be the right hand end of the frontage when viewed +
+ + 042      from outside the holding. But that's not general; celtic-style circular +
+ + 043      buildings should normally be in the centre of their holdings. So probably +
+ + 044      building-origin becomes a method of building-family rather than of holding." +
+ + 045     (first (frontage holding))) +
+ + 046    ProtoObject) +
+ + diff --git a/docs/cloverage/cc/journeyman/the_great_game/location/location.clj.html b/docs/cloverage/cc/journeyman/the_great_game/location/location.clj.html new file mode 100644 index 0000000..a27e3bf --- /dev/null +++ b/docs/cloverage/cc/journeyman/the_great_game/location/location.clj.html @@ -0,0 +1,149 @@ + + + + cc/journeyman/the_great_game/location/location.clj + + + + 001  (ns cc.journeyman.the-great-game.location.location) +
+ + 002   +
+ + 003  ;;; There's probably conflict between this sense of a reified location and +
+ + 004  ;;; the simpler sense of a location described in  +
+ + 005  ;;; `cc.journeyman.the-great-game.world.location`, q.v. This needs to +
+ + 006  ;;; be resolved! +
+ + 007   +
+ + 008  (defprotocol ProtoLocation +
+ + 009    (easting [location] +
+ + 010     "Return the easting of this location") +
+ + 011    (northing [location] "Return the northing of this location") +
+ + 012    (altitude [location] +
+ + 013              "Return the absolute altitude of this location, which may be +
+ + 014               different from the terrain height at this location, if, for +
+ + 015               example, the location is underground or on an upper floor.") +
+ + 016    (terrain-altitude [location] +
+ + 017                      "Return the 'ground level' (altitude of the terrain) +
+ + 018                       at this location given this world. TODO: possibly +
+ + 019                       terrain-altitude should be a method of the world.") +
+ + 020    (settlement [location] +
+ + 021                "Return the settlement record of the settlement in this world +
+ + 022                 within whose parish polygon this location exists, or if none +
+ + 023                 whose centre (inn location) is closest to this location")) +
+ + 024   +
+ + 025   +
+ + 026  (defrecord Location [^Double easting ^Double northing ^Double altitude world] +
+ + 027    ProtoLocation +
+ + 028    (easting [l] (:easting l)) +
+ + 029    (northing [l] (:northing l)) +
+ + 030    (altitude [l] (:altitude l)) +
+ + 031    (terrain-altitude [l] 0.0) ;; TODO +
+ + 032    (settlement [l] :tchahua)) +
+ + 033   +
+ + 034  (defrecord OrientedLocation +
+ + 035    ;; "Identical to a Location except having, additionally, an orientation" +
+ + 036             [^Double easting ^Double northing ^Double altitude ^Double orientation world] +
+ + 037    ProtoLocation +
+ + 038    (easting [l] (:easting l)) +
+ + 039    (northing [l] (:northing l)) +
+ + 040    (altitude [l] (:altitude l)) +
+ + 041    (terrain-altitude [l] 0.0) ;; TODO +
+ + 042    (settlement [l] :tchahua)) ;; TODO +
+ + 043   +
+ + 044   ;; (.settlement (OrientedLocation. 123.45 543.76 12.34 0.00 {})) +
+ + 045   +
+ + 046   +
+ + 047  ;; (OrientedLocation. 123.45 543.76 12.34 0.00 {}) +
+ + diff --git a/docs/cloverage/cc/journeyman/the_great_game/merchants/markets.clj.html b/docs/cloverage/cc/journeyman/the_great_game/merchants/markets.clj.html new file mode 100644 index 0000000..ad08ec1 --- /dev/null +++ b/docs/cloverage/cc/journeyman/the_great_game/merchants/markets.clj.html @@ -0,0 +1,260 @@ + + + + cc/journeyman/the_great_game/merchants/markets.clj + + + + 001  (ns cc.journeyman.the-great-game.merchants.markets +
+ + 002    "Adjusting quantities and prices in markets." +
+ + 003    (:require [taoensso.timbre :as l :refer [info error]] +
+ + 004              [cc.journeyman.the-great-game.utils :refer [deep-merge]])) +
+ + 005   +
+ + 006  (defn new-price +
+ + 007    "If `stock` is greater than the maximum of `supply` and `demand`, then +
+ + 008    there is surplus and `old` price is too high, so shold be reduced. If +
+ + 009    lower, then it is too low and should be increased." +
+ + 010    [old stock supply demand] +
+ + 011    (let +
+ + 012      [delta (dec' (/ (max supply demand 1) (max stock 1))) +
+ + 013       scaled (/ delta 100)] +
+ + 014      (+ old scaled))) +
+ + 015   +
+ + 016   +
+ + 017  (defn adjust-quantity-and-price +
+ + 018    "Adjust the quantity of this `commodity` currently in stock in this `city` +
+ + 019    of this `world`. Return a fragmentary world which can be deep-merged into +
+ + 020    this world." +
+ + 021    [world city commodity] +
+ + 022    (let [c (cond +
+ + 023              (keyword? city) (-> world :cities city) +
+ + 024              (map? city) city) +
+ + 025          id (:id c) +
+ + 026          p (or (-> c :prices commodity) 0) +
+ + 027          d (or (-> c :demands commodity) 0) +
+ + 028          st (or (-> c :stock commodity) 0) +
+ + 029          su (or (-> c :supplies commodity) 0) +
+ + 030          decrement (min st d) +
+ + 031          increment (cond +
+ + 032                      ;; if we've two turns' production of this commodity in +
+ + 033                      ;; stock, halt production +
+ + 034                      (> st (* su 2)) +
+ + 035                      0 +
+ + 036                      ;; if it is profitable to produce this commodity, the +
+ + 037                      ;; craftspeople of the city will do so. +
+ + 038                      (> p 1) su +
+ + 039                      ;; otherwise, if there isn't a turn's production in +
+ + 040                      ;; stock, top up the stock, so that there's something for +
+ + 041                      ;; incoming merchants to buy +
+ + 042                      (> su st) +
+ + 043                      (- su st) +
+ + 044                      :else +
+ + 045                      0) +
+ + 046          n (new-price p st su d)] +
+ + 047      (if +
+ + 048        (not= p n) +
+ + 049        (l/info "Price of" commodity "at" id "has changed from" (float p) "to" (float n))) +
+ + 050      {:cities {id +
+ + 051                {:stock +
+ + 052                 {commodity (+ (- st decrement) increment)} +
+ + 053                 :prices +
+ + 054                 {commodity n}}}})) +
+ + 055   +
+ + 056   +
+ + 057  (defn update-markets +
+ + 058    "Return a world like this `world`, with quantities and prices in markets +
+ + 059    updated to reflect supply and demand. If `city` or `city` and `commodity` +
+ + 060    are specified, return a fragmentary world with only the changes for that +
+ + 061    `city` (and `commodity` if specified) populated." +
+ + 062    ([world] +
+ + 063     (reduce +
+ + 064       deep-merge +
+ + 065       world +
+ + 066       (map +
+ + 067         #(update-markets world %) +
+ + 068         (keys (:cities world))))) +
+ + 069    ([world city] +
+ + 070     (reduce +
+ + 071       deep-merge +
+ + 072       {} +
+ + 073       (map #(update-markets world city %) +
+ + 074            (keys (:commodities world))))) +
+ + 075    ([world city commodity] +
+ + 076      (adjust-quantity-and-price world city commodity))) +
+ + 077   +
+ + 078   +
+ + 079  (defn run +
+ + 080    "Return a world like this `world`, with quantities and prices in markets +
+ + 081    updated to reflect supply and demand." +
+ + 082    [world] +
+ + 083    (update-markets world)) +
+ + 084   +
+ + diff --git a/docs/cloverage/cc/journeyman/the_great_game/merchants/merchant_utils.clj.html b/docs/cloverage/cc/journeyman/the_great_game/merchants/merchant_utils.clj.html new file mode 100644 index 0000000..377f27a --- /dev/null +++ b/docs/cloverage/cc/journeyman/the_great_game/merchants/merchant_utils.clj.html @@ -0,0 +1,326 @@ + + + + cc/journeyman/the_great_game/merchants/merchant_utils.clj + + + + 001  (ns cc.journeyman.the-great-game.merchants.merchant-utils +
+ + 002    "Useful functions for doing low-level things with merchants.") +
+ + 003   +
+ + 004  (defn expected-price +
+ + 005    "Find the price anticipated, given this `world`, by this `merchant` for +
+ + 006    this `commodity` in this `city`. If no information, assume 1. +
+ + 007    `merchant` should be passed as a map, `commodity` and `city` should be passed as keywords." +
+ + 008    [merchant commodity city] +
+ + 009    (or +
+ + 010      (:price +
+ + 011        (last +
+ + 012          (sort-by +
+ + 013            :date +
+ + 014            (-> merchant :known-prices city commodity)))) +
+ + 015      1)) +
+ + 016   +
+ + 017  (defn burden +
+ + 018    "The total weight of the current cargo carried by this `merchant` in this +
+ + 019    `world`." +
+ + 020    [merchant world] +
+ + 021    (let [m (cond +
+ + 022              (keyword? merchant) +
+ + 023              (-> world :merchants merchant) +
+ + 024              (map? merchant) +
+ + 025              merchant) +
+ + 026          cargo (or (:stock m) {})] +
+ + 027      (reduce +
+ + 028        + +
+ + 029        0 +
+ + 030        (map +
+ + 031          #(* (cargo %) (-> world :commodities % :weight)) +
+ + 032          (keys cargo))))) +
+ + 033   +
+ + 034   +
+ + 035  (defn can-carry +
+ + 036    "Return the number of units of this `commodity` which this `merchant` +
+ + 037    can carry in this `world`, given their current burden." +
+ + 038    [merchant world commodity] +
+ + 039    (let [m (cond +
+ + 040              (keyword? merchant) +
+ + 041              (-> world :merchants merchant) +
+ + 042              (map? merchant) +
+ + 043              merchant)] +
+ + 044      (max +
+ + 045        0 +
+ + 046        (quot +
+ + 047          (- (or (:capacity m) 0) (burden m world)) +
+ + 048          (-> world :commodities commodity :weight))))) +
+ + 049   +
+ + 050  (defn can-afford +
+ + 051    "Return the number of units of this `commodity` which this `merchant` +
+ + 052    can afford to buy in this `world`." +
+ + 053    [merchant world commodity] +
+ + 054    (let [m (cond +
+ + 055              (keyword? merchant) +
+ + 056              (-> world :merchants merchant) +
+ + 057              (map? merchant) +
+ + 058              merchant) +
+ + 059          l (:location m)] +
+ + 060      (cond +
+ + 061        (nil? m) +
+ + 062        (throw (Exception. "No merchant?")) +
+ + 063        (or (nil? l) (nil? (-> world :cities l))) +
+ + 064        (throw (Exception. (str "No known location for merchant " m))) +
+ + 065        :else +
+ + 066        (quot +
+ + 067          (:cash m) +
+ + 068          (-> world :cities l :prices commodity))))) +
+ + 069   +
+ + 070  (defn add-stock +
+ + 071    "Where `a` and `b` are both maps all of whose values are numbers, return +
+ + 072    a map whose keys are a union of the keys of `a` and `b` and whose values +
+ + 073    are the sums of their respective values." +
+ + 074    [a b] +
+ + 075    (reduce +
+ + 076      merge +
+ + 077      a +
+ + 078      (map +
+ + 079        #(hash-map % (+ (or (a %) 0) (or (b %) 0))) +
+ + 080        (keys b)))) +
+ + 081   +
+ + 082  (defn add-known-prices +
+ + 083    "Add the current prices at this `merchant`'s location in the `world` +
+ + 084    to a new cache of known prices, and return it." +
+ + 085    [merchant world] +
+ + 086    (let [m (cond +
+ + 087              (keyword? merchant) +
+ + 088              (-> world :merchants merchant) +
+ + 089              (map? merchant) +
+ + 090              merchant) +
+ + 091          k (or (:known-prices m) {}) +
+ + 092          l (:location m) +
+ + 093          d (or (:date world) 0) +
+ + 094          p (-> world :cities l :prices)] +
+ + 095      (cond +
+ + 096        (nil? m) +
+ + 097        (throw (Exception. "No merchant?")) +
+ + 098        (or (nil? l) (nil? (-> world :cities l))) +
+ + 099        (throw (Exception. (str "No known location for merchant " m))) +
+ + 100        :else +
+ + 101        (reduce +
+ + 102          merge +
+ + 103          k +
+ + 104          (map +
+ + 105            #(hash-map % (apply vector cons {:price (p %) :date d} (k %))) +
+ + 106            (-> world :commodities keys)))))) +
+ + diff --git a/docs/cloverage/cc/journeyman/the_great_game/merchants/merchants.clj.html b/docs/cloverage/cc/journeyman/the_great_game/merchants/merchants.clj.html new file mode 100644 index 0000000..94daa96 --- /dev/null +++ b/docs/cloverage/cc/journeyman/the_great_game/merchants/merchants.clj.html @@ -0,0 +1,92 @@ + + + + cc/journeyman/the_great_game/merchants/merchants.clj + + + + 001  (ns cc.journeyman.the-great-game.merchants.merchants +
+ + 002    "Trade planning for merchants, primarily." +
+ + 003    (:require [cc.journeyman.the-great-game.utils :refer [deep-merge]] +
+ + 004              [cc.journeyman.the-great-game.merchants.strategies.simple :refer [move-merchant]] +
+ + 005              [taoensso.timbre :as l])) +
+ + 006   +
+ + 007   +
+ + 008  (defn run +
+ + 009    "Return a partial world based on this `world`, but with each merchant moved." +
+ + 010    [world] +
+ + 011    (try +
+ + 012      (reduce +
+ + 013       deep-merge +
+ + 014       world +
+ + 015       (map +
+ + 016        #(try +
+ + 017           (let [move-fn (or +
+ + 018                          (-> world :merchants % :move-fn) +
+ + 019                          move-merchant)] +
+ + 020             (apply move-fn (list % world))) +
+ + 021           (catch Exception any +
+ + 022             (l/error any "Failure while moving merchant " %) +
+ + 023             {})) +
+ + 024        (keys (:merchants world)))) +
+ + 025      (catch Exception any +
+ + 026        (l/error any "Failure while moving merchants") +
+ + 027        world))) +
+ + 028   +
+ + diff --git a/docs/cloverage/cc/journeyman/the_great_game/merchants/planning.clj.html b/docs/cloverage/cc/journeyman/the_great_game/merchants/planning.clj.html new file mode 100644 index 0000000..ee3243d --- /dev/null +++ b/docs/cloverage/cc/journeyman/the_great_game/merchants/planning.clj.html @@ -0,0 +1,485 @@ + + + + cc/journeyman/the_great_game/merchants/planning.clj + + + + 001  (ns cc.journeyman.the-great-game.merchants.planning +
+ + 002    "Trade planning for merchants, primarily. This follows a simple-minded +
+ + 003    generate-and-test strategy and currently generates plans for all possible +
+ + 004    routes from the current location. This may not scale. Also, routes do not +
+ + 005    currently have cost or risk associated with them." +
+ + 006    (:require [cc.journeyman.the-great-game.utils :refer [deep-merge make-target-filter]] +
+ + 007              [cc.journeyman.the-great-game.merchants.merchant-utils :refer [can-afford can-carry expected-price]] +
+ + 008              [cc.journeyman.the-great-game.world.routes :refer [find-route]] +
+ + 009              [cc.journeyman.the-great-game.world.world :refer [actual-price default-world]])) +
+ + 010   +
+ + 011  (defn generate-trade-plans +
+ + 012    "Generate all possible trade plans for this `merchant` and this `commodity` +
+ + 013    in this `world`. +
+ + 014   +
+ + 015    Returned plans are maps with keys: +
+ + 016   +
+ + 017    * :merchant - the id of the `merchant` for whom the plan was created; +
+ + 018    * :origin - the city from which the trade starts; +
+ + 019    * :destination - the city to which the trade is planned; +
+ + 020    * :commodity - the `commodity` to be carried; +
+ + 021    * :buy-price - the price at which that `commodity` can be bought; +
+ + 022    * :expected-price - the price at which the `merchant` anticipates +
+ + 023    that `commodity` can be sold; +
+ + 024    * :distance - the number of stages in the planned journey +
+ + 025    * :dist-to-home - the distance from `destination` to the `merchant`'s +
+ + 026    home city." +
+ + 027    [merchant world commodity] +
+ + 028    (let [m (cond +
+ + 029              (keyword? merchant) +
+ + 030              (-> world :merchants merchant) +
+ + 031              (map? merchant) +
+ + 032              merchant) +
+ + 033          origin (:location m)] +
+ + 034      (map +
+ + 035        #(hash-map +
+ + 036           :merchant (:id m) +
+ + 037           :origin origin +
+ + 038           :destination % +
+ + 039           :commodity commodity +
+ + 040           :buy-price (actual-price world commodity origin) +
+ + 041           :expected-price (expected-price +
+ + 042                             m +
+ + 043                             commodity +
+ + 044                             %) +
+ + 045           :distance (count +
+ + 046                       (find-route world origin %)) +
+ + 047           :dist-to-home (count +
+ + 048                           (find-route +
+ + 049                             world +
+ + 050                             (:home m) +
+ + 051                             %))) +
+ + 052        (remove #(= % origin) (-> world :cities keys))))) +
+ + 053   +
+ + 054  (defn nearest-with-targets +
+ + 055    "Return the distance to the nearest destination among those of these +
+ + 056    `plans` which match these `targets`. Plans are expected to be plans +
+ + 057    as returned by `generate-trade-plans`, q.v.; `targets` are expected to be +
+ + 058    as accepted by `make-target-filter`, q.v." +
+ + 059    [plans targets] +
+ + 060    (apply +
+ + 061      min +
+ + 062      (map +
+ + 063        :distance +
+ + 064        (filter +
+ + 065          (make-target-filter targets) +
+ + 066          plans)))) +
+ + 067   +
+ + 068  (defn plan-trade +
+ + 069    "Find the best destination in this `world` for this `commodity` given this +
+ + 070    `merchant` and this `origin`. If two cities are anticipated to offer the +
+ + 071    same price, the nearer should be preferred; if two are equally distant, the +
+ + 072    ones nearer to the merchant's home should be preferred. +
+ + 073    `merchant` may be passed as a map or a keyword; `commodity` should  be +
+ + 074    passed as a keyword. +
+ + 075   +
+ + 076    The returned plan is a map with keys: +
+ + 077   +
+ + 078    * :merchant - the id of the `merchant` for whom the plan was created; +
+ + 079    * :origin - the city from which the trade starts; +
+ + 080    * :destination - the city to which the trade is planned; +
+ + 081    * :commodity - the `commodity` to be carried; +
+ + 082    * :buy-price - the price at which that `commodity` can be bought; +
+ + 083    * :expected-price - the price at which the `merchant` anticipates +
+ + 084    that `commodity` can be sold; +
+ + 085    * :distance - the number of stages in the planned journey +
+ + 086    * :dist-to-home - the distance from `destination` to the `merchant`'s +
+ + 087    home city." +
+ + 088    [merchant world commodity] +
+ + 089    (let [plans (generate-trade-plans merchant world commodity) +
+ + 090          best-prices (filter +
+ + 091                        (make-target-filter +
+ + 092                          [[:expected-price +
+ + 093                            (apply +
+ + 094                              max +
+ + 095                              (filter number? (map :expected-price plans)))]]) +
+ + 096                        plans)] +
+ + 097      (first +
+ + 098        (sort-by +
+ + 099          ;; all other things being equal, a merchant would prefer to end closer +
+ + 100          ;; to home. +
+ + 101          #(- 0 (:dist-to-home %)) +
+ + 102          ;; a merchant will seek the best price, but won't go further than +
+ + 103          ;; needed to get it. +
+ + 104          (filter +
+ + 105            (make-target-filter +
+ + 106              [[:distance +
+ + 107                (apply min (filter number? (map :distance best-prices)))]]) +
+ + 108            best-prices))))) +
+ + 109   +
+ + 110  (defn augment-plan +
+ + 111    "Augment this `plan` constructed in this `world` for this `merchant` with +
+ + 112    the `:quantity` of goods which should be bought and the `:expected-profit` +
+ + 113    of the trade. +
+ + 114   +
+ + 115    Returns the augmented plan." +
+ + 116    [merchant world plan] +
+ + 117    (let [c (:commodity plan) +
+ + 118          o (:origin plan) +
+ + 119          q (min +
+ + 120              (or +
+ + 121                (-> world :cities o :stock c) +
+ + 122                0) +
+ + 123              (can-carry merchant world c) +
+ + 124              (can-afford merchant world c)) +
+ + 125          p (* q (- (:expected-price plan) (:buy-price plan)))] +
+ + 126      (assoc plan :quantity q :expected-profit p))) +
+ + 127   +
+ + 128  (defn select-cargo +
+ + 129    "A `merchant`, in a given location in a `world`, will choose to buy a cargo +
+ + 130    within the limit they are capable of carrying, which they can anticipate +
+ + 131    selling for a profit at a destination." +
+ + 132    [merchant world] +
+ + 133    (let [m (cond +
+ + 134              (keyword? merchant) +
+ + 135              (-> world :merchants merchant) +
+ + 136              (map? merchant) +
+ + 137              merchant) +
+ + 138          origin (:location m) +
+ + 139          available (-> world :cities origin :stock) +
+ + 140          plans (map +
+ + 141                  #(augment-plan +
+ + 142                     m +
+ + 143                     world +
+ + 144                     (plan-trade m world %)) +
+ + 145                  (filter +
+ + 146                    #(let [q (-> world :cities origin :stock %)] +
+ + 147                       (and (number? q) (pos? q))) +
+ + 148                    (keys available)))] +
+ + 149      (if +
+ + 150        (not (empty? plans)) +
+ + 151        (first +
+ + 152          (sort-by +
+ + 153            #(- 0 (:dist-to-home %)) +
+ + 154            (filter +
+ + 155              (make-target-filter +
+ + 156                [[:expected-profit +
+ + 157                  (apply max (filter number? (map :expected-profit plans)))]]) +
+ + 158              plans)))))) +
+ + 159   +
+ + diff --git a/docs/cloverage/cc/journeyman/the_great_game/merchants/strategies/simple.clj.html b/docs/cloverage/cc/journeyman/the_great_game/merchants/strategies/simple.clj.html new file mode 100644 index 0000000..48b73c0 --- /dev/null +++ b/docs/cloverage/cc/journeyman/the_great_game/merchants/strategies/simple.clj.html @@ -0,0 +1,527 @@ + + + + cc/journeyman/the_great_game/merchants/strategies/simple.clj + + + + 001  (ns cc.journeyman.the-great-game.merchants.strategies.simple +
+ + 002    "Default trading strategy for merchants. +
+ + 003   +
+ + 004    The simple strategy buys a single product in the local market if there is +
+ + 005    one which can be traded profitably, trades it to the chosen target market, +
+ + 006    and sells it there. If there is no commodity locally which can be traded +
+ + 007    profitably, moves towards home with no cargo. If at home and no commodity +
+ + 008    can be traded profitably, does not move." +
+ + 009    (:require [taoensso.timbre :as l :refer [info error spy]] +
+ + 010              [cc.journeyman.the-great-game.utils :refer [deep-merge]] +
+ + 011              [cc.journeyman.the-great-game.gossip.gossip :refer [move-gossip]] +
+ + 012              [cc.journeyman.the-great-game.merchants.planning :refer [augment-plan plan-trade select-cargo]] +
+ + 013              [cc.journeyman.the-great-game.merchants.merchant-utils :refer +
+ + 014               [add-stock add-known-prices]] +
+ + 015              [cc.journeyman.the-great-game.world.routes :refer [find-route]])) +
+ + 016   +
+ + 017  (defn plan-and-buy +
+ + 018    "Return a world like this `world`, in which this `merchant` has planned +
+ + 019    a new trade, and bought appropriate stock for it. If no profitable trade +
+ + 020    can be planned, the merchant is simply moved towards their home." +
+ + 021    [merchant world] +
+ + 022    (let [m (cond +
+ + 023              (keyword? merchant) +
+ + 024              (-> world :merchants merchant) +
+ + 025              (map? merchant) +
+ + 026              merchant) +
+ + 027          id (:id m) +
+ + 028          location (:location m) +
+ + 029          market (-> world :cities location) +
+ + 030          plan (select-cargo merchant world)] +
+ + 031      (l/debug "plan-and-buy: merchant" id) +
+ + 032      (cond +
+ + 033        (seq? plan) +
+ + 034        (let +
+ + 035          [c (:commodity plan) +
+ + 036           p (* (:quantity plan) (:buy-price plan)) +
+ + 037           q (:quantity plan)] +
+ + 038          (l/info "Merchant" id "bought" q "units of" c "at" location "for" p plan) +
+ + 039          {:merchants +
+ + 040           {id +
+ + 041            {:stock (add-stock (:stock m) {c q}) +
+ + 042             :cash (- (:cash m) p) +
+ + 043             :known-prices (add-known-prices m world) +
+ + 044             :plan plan}} +
+ + 045           :cities +
+ + 046           {location +
+ + 047            {:stock (assoc (:stock market) c (- (-> market :stock c) q)) +
+ + 048             :cash (+ (:cash market) p)}}}) +
+ + 049        ;; if no plan, then if at home stay put +
+ + 050        (= (:location m) (:home m)) +
+ + 051        (do +
+ + 052          (l/info "Merchant" id "remains at home in" location) +
+ + 053          {}) +
+ + 054        ;; else move towards home +
+ + 055        :else +
+ + 056        (let [route (find-route world location (:home m)) +
+ + 057              next-location (nth route 1)] +
+ + 058          (l/info "No trade possible at" location "; merchant" id "moves to" next-location) +
+ + 059          (merge +
+ + 060            {:merchants +
+ + 061             {id +
+ + 062              {:location next-location}}} +
+ + 063            (move-gossip id world next-location)))))) +
+ + 064   +
+ + 065  (defn re-plan +
+ + 066    "Having failed to sell a cargo at current location, re-plan a route to +
+ + 067    sell the current cargo. Returns a revised world." +
+ + 068    [merchant world] +
+ + 069    (let [m (cond +
+ + 070              (keyword? merchant) +
+ + 071              (-> world :merchants merchant) +
+ + 072              (map? merchant) +
+ + 073              merchant) +
+ + 074          id (:id m) +
+ + 075          location (:location m) +
+ + 076          plan (augment-plan m world (plan-trade m world (-> m :plan :commodity)))] +
+ + 077      (l/debug "re-plan: merchant" id) +
+ + 078      (deep-merge +
+ + 079        world +
+ + 080        {:merchants +
+ + 081         {id +
+ + 082          {:plan plan}}}))) +
+ + 083   +
+ + 084  (defn sell-and-buy +
+ + 085    "Return a new world like this `world`, in which this `merchant` has sold +
+ + 086    their current stock in their current location, and planned a new trade, and +
+ + 087    bought appropriate stock for it." +
+ + 088    ;; TODO: this either sells the entire cargo, or, if the market can't afford +
+ + 089    ;; it, none of it. And it does not cope with selling different commodities +
+ + 090    ;; in different markets. +
+ + 091    [merchant world] +
+ + 092    (let [m (cond +
+ + 093              (keyword? merchant) +
+ + 094              (-> world :merchants merchant) +
+ + 095              (map? merchant) +
+ + 096              merchant) +
+ + 097          id (:id m) +
+ + 098          location (:location m) +
+ + 099          market (-> world :cities location) +
+ + 100          stock-value (reduce +
+ + 101                        + +
+ + 102                        (map +
+ + 103                          #(* (-> m :stock %) (-> market :prices m)) +
+ + 104                          (keys (:stock m))))] +
+ + 105      (l/debug "sell-and-buy: merchant" id) +
+ + 106      (if +
+ + 107        (>= (:cash market) stock-value) +
+ + 108        (do +
+ + 109          (l/info "Merchant" id "sells" (:stock m) "at" location "for" stock-value) +
+ + 110          (plan-and-buy +
+ + 111            merchant +
+ + 112            (deep-merge +
+ + 113              world +
+ + 114              {:merchants +
+ + 115               {id +
+ + 116                {:stock {} +
+ + 117                 :cash (+ (:cash m) stock-value) +
+ + 118                 :known-prices (add-known-prices m world)}} +
+ + 119               :cities +
+ + 120               {location +
+ + 121                {:stock (add-stock (:stock m) (:stock market)) +
+ + 122                 :cash (- (:cash market) stock-value)}}}))) +
+ + 123        ;; else +
+ + 124        (re-plan merchant world)))) +
+ + 125   +
+ + 126  (defn move-merchant +
+ + 127    "Handle general en route movement of this `merchant` in this `world`; +
+ + 128    return a (partial or full) world like this `world` but in which the +
+ + 129    merchant may have been moved ot updated." +
+ + 130    [merchant world] +
+ + 131    (let [m (cond +
+ + 132              (keyword? merchant) +
+ + 133              (-> world :merchants merchant) +
+ + 134              (map? merchant) +
+ + 135              merchant) +
+ + 136          id (:id m) +
+ + 137          at-destination? (and (:plan m) (= (:location m) (-> m :plan :destination))) +
+ + 138          plan (:plan m) +
+ + 139          next-location (if plan +
+ + 140                          (nth +
+ + 141                            (find-route +
+ + 142                              world +
+ + 143                              (:location m) +
+ + 144                              (:destination plan)) +
+ + 145                            1) +
+ + 146                          (:location m))] +
+ + 147      (l/debug "move-merchant: merchant" id "at" (:location m) +
+ + 148               "destination" (-> m :plan :destination) "next" next-location +
+ + 149               "at destination" at-destination?) +
+ + 150      (cond +
+ + 151        ;; if the merchant is at the destination of their current plan +
+ + 152        ;; sell all cargo and repurchase. +
+ + 153        at-destination? +
+ + 154        (sell-and-buy merchant world) +
+ + 155        ;; if they don't have a plan, seek to create one +
+ + 156        (nil? plan) +
+ + 157        (plan-and-buy merchant world) +
+ + 158        ;; otherwise, move one step towards their destination +
+ + 159        (and next-location (not= next-location (:location m))) +
+ + 160        (do +
+ + 161          (l/info "Merchant " id " moving from " (:location m) " to " next-location) +
+ + 162          (deep-merge +
+ + 163            {:merchants +
+ + 164             {id +
+ + 165              {:location next-location +
+ + 166               :known-prices (add-known-prices m world)}}} +
+ + 167            (move-gossip id world next-location))) +
+ + 168        :else +
+ + 169        (do +
+ + 170          (l/info "Merchant" id "has plan but no next-location; currently at" +
+ + 171                  (:location m) ", destination is" (:destination plan)) +
+ + 172          world)))) +
+ + 173   +
+ + diff --git a/docs/cloverage/cc/journeyman/the_great_game/objects/container.clj.html b/docs/cloverage/cc/journeyman/the_great_game/objects/container.clj.html new file mode 100644 index 0000000..0140330 --- /dev/null +++ b/docs/cloverage/cc/journeyman/the_great_game/objects/container.clj.html @@ -0,0 +1,41 @@ + + + + cc/journeyman/the_great_game/objects/container.clj + + + + 001  (ns cc.journeyman.the-great-game.objects.container +
+ + 002    (:require +
+ + 003      [cc.journeyman.the-great-game.objects.game-object :refer :all])) +
+ + 004   +
+ + 005  (defprotocol ProtoContainer +
+ + 006    (contents +
+ + 007      [container] +
+ + 008              "Return a sequence of the contents of this `container`, or `nil` if empty.") +
+ + 009    (is-empty? +
+ + 010      [container] +
+ + 011      "Return `true` if this `container` is empty, else `false`.")) +
+ + diff --git a/docs/cloverage/cc/journeyman/the_great_game/objects/game_object.clj.html b/docs/cloverage/cc/journeyman/the_great_game/objects/game_object.clj.html new file mode 100644 index 0000000..32e0483 --- /dev/null +++ b/docs/cloverage/cc/journeyman/the_great_game/objects/game_object.clj.html @@ -0,0 +1,71 @@ + + + + cc/journeyman/the_great_game/objects/game_object.clj + + + + 001  (ns cc.journeyman.the-great-game.objects.game-object +
+ + 002    "Anything at all in the game world") +
+ + 003   +
+ + 004  (defprotocol ProtoObject +
+ + 005    "An object in the world" +
+ + 006    (id [object] "Returns the unique id of this object.") +
+ + 007    (reify-object +
+ + 008      [object] +
+ + 009      "Adds this `object` to the global object list. If the `object` has a +
+ + 010      non-nil value for its `id` method, keys it to that id - **but** if the +
+ + 011      id value is already in use, throws a hard exception. Returns the id to +
+ + 012      which the object is keyed in the global object list.")) +
+ + 013   +
+ + 014  (defrecord GameObject +
+ + 015             [id] +
+ + 016    ;; "An object in the world" +
+ + 017    ProtoObject +
+ + 018    (id [_] id) +
+ + 019    (reify-object [object] +
+ + 020      "TODO: doesn't work yet" +
+ + 021      object)) +
+ + diff --git a/docs/cloverage/cc/journeyman/the_great_game/playroom.clj.html b/docs/cloverage/cc/journeyman/the_great_game/playroom.clj.html new file mode 100644 index 0000000..a2574c4 --- /dev/null +++ b/docs/cloverage/cc/journeyman/the_great_game/playroom.clj.html @@ -0,0 +1,224 @@ + + + + cc/journeyman/the_great_game/playroom.clj + + + + 001  (ns cc.journeyman.the-great-game.playroom +
+ + 002    (:require [jme-clj.core :refer [add add-to-root box defsimpleapp fly-cam geo  +
+ + 003                                    get* get-state load-texture rotate run set*  +
+ + 004                                    setc set-state start unshaded-mat]]) +
+ + 005    (:import [com.jme3.math ColorRGBA])) +
+ + 006   +
+ + 007  ;; At present this file is just somewhere to play around with jme-clj examples +
+ + 008   +
+ + 009  (declare app) +
+ + 010   +
+ + 011  (defn init [] +
+ + 012    (let [cube (geo "jMonkey cube" (box 1 1 1)) +
+ + 013          mat  (unshaded-mat)] +
+ + 014      (set* mat :texture "ColorMap" (load-texture "textures/Monkey.jpg")) +
+ + 015      (set* cube :material mat) +
+ + 016      (add-to-root cube) +
+ + 017      {:cube cube})) +
+ + 018   +
+ + 019  ;; Let's create simple-update fn with no body for now. +
+ + 020   (defn simple-update [tpf] +
+ + 021     (let [{:keys [cube]} (get-state)] +
+ + 022       (rotate cube 0 (* 2 tpf) 0))) +
+ + 023   +
+ + 024   +
+ + 025  ;; Kills the running app var and closes its window. +
+ + 026  ;; (unbind-app #'app) +
+ + 027   +
+ + 028  ;; We define the `app` var. +
+ + 029  (defsimpleapp app +
+ + 030                 :opts {:show-settings?       false +
+ + 031                        :pause-on-lost-focus? false +
+ + 032                        :settings             {:title          "My JME Game" +
+ + 033                                               :load-defaults? true +
+ + 034                                               :frame-rate     60 +
+ + 035                                               :width          800 +
+ + 036                                               :height         600}} +
+ + 037                 :init init +
+ + 038                 :update simple-update) +
+ + 039   +
+ + 040  (start app) +
+ + 041   +
+ + 042  ;; Reinitialises the running app +
+ + 043  ;;(run app +
+ + 044  ;;     (re-init init)) +
+ + 045    +
+ + 046   ;; By default, there is a Fly Camera attached to the app that you can control with W, A, S and D keys. +
+ + 047   ;; Let's increase its movement speed. Now, you fly faster :) +
+ + 048   (run app +
+ + 049        (set* (fly-cam) :move-speed 15)) +
+ + 050   +
+ + 051   +
+ + 052   ;; Updates the app  +
+ + 053  (run app +
+ + 054       (let [{:keys [cube]} (get-state)] +
+ + 055         (set* cube :local-translation (add (get* cube :local-translation) 1 1 1)))) +
+ + 056   +
+ + 057    ;; Updates the app adding a second cube +
+ + 058  (run app +
+ + 059        (let [cube (geo "jMonkey cube" (box 1 1 1)) +
+ + 060              mat  (unshaded-mat)] +
+ + 061          (set* mat :texture "ColorMap" (load-texture "textures/Monkey.jpg")) +
+ + 062          (setc cube +
+ + 063                :material mat +
+ + 064                :local-translation [-3 0 0]) +
+ + 065          (add-to-root cube) +
+ + 066          (set-state :cube2 cube))) +
+ + 067    +
+ + 068   ;; We added the new cube, but it's not rotating. We need to update the simple-update fn. +
+ + 069   (defn simple-update [tpf] +
+ + 070     (let [{:keys [cube cube2]} (get-state)] +
+ + 071       (rotate cube 0 (* 2 tpf) 0) +
+ + 072       (rotate cube2 0 (* 2 tpf) 0))) +
+ + diff --git a/docs/cloverage/cc/journeyman/the_great_game/time.clj.html b/docs/cloverage/cc/journeyman/the_great_game/time.clj.html new file mode 100644 index 0000000..f869045 --- /dev/null +++ b/docs/cloverage/cc/journeyman/the_great_game/time.clj.html @@ -0,0 +1,440 @@ + + + + cc/journeyman/the_great_game/time.clj + + + + 001  (ns cc.journeyman.the-great-game.time +
+ + 002    (:require [clojure.string :as s])) +
+ + 003   +
+ + 004  (def game-start-time +
+ + 005    "The start time of this run." +
+ + 006    (System/currentTimeMillis)) +
+ + 007   +
+ + 008  (def ^:const game-day-length +
+ + 009    "The Java clock advances in milliseconds, which is fine. +
+ + 010    But we need game-days to be shorter than real world days. +
+ + 011    A Witcher 3 game day is 1 hour 36 minutes, or 96 minutes, which is +
+ + 012    presumably researched. Round it up to 100 minutes for easier +
+ + 013    calculation." +
+ + 014    (* 100          ;; minutes per game day +
+ + 015       60           ;; seconds per minute +
+ + 016       1000))       ;; milliseconds per second +
+ + 017   +
+ + 018  (defn now +
+ + 019    "For now, we'll use Java timestamp for time; ultimately, we need a +
+ + 020    concept of game-time which allows us to drive day/night cycle, seasons, +
+ + 021    et cetera, but what matters about time is that it is a value which +
+ + 022    increases." +
+ + 023    [] +
+ + 024    (System/currentTimeMillis)) +
+ + 025   +
+ + 026  (def ^:const canonical-ordering-of-houses +
+ + 027    "The canonical ordering of religious houses." +
+ + 028    [:eye +
+ + 029     :foot +
+ + 030     :nose +
+ + 031     :hand +
+ + 032     :ear +
+ + 033     :mouth +
+ + 034     :stomach +
+ + 035     :furrow +
+ + 036     :plough]) +
+ + 037   +
+ + 038  (def ^:const days-of-week +
+ + 039    "The eight-day week of the game world. This differs from the canonical +
+ + 040    ordering of houses in that it omits the eye." +
+ + 041    (rest canonical-ordering-of-houses)) +
+ + 042   +
+ + 043  (def ^:const days-in-week +
+ + 044    "This world has an eight day week." +
+ + 045    (count days-of-week)) +
+ + 046   +
+ + 047  (def ^:const seasons-of-year +
+ + 048    "The ordering of seasons in the year is different from the canonical +
+ + 049    ordering of the houses, for reasons of the agricultural cycle." +
+ + 050    [:foot +
+ + 051     :nose +
+ + 052     :hand +
+ + 053     :ear +
+ + 054     :mouth +
+ + 055     :stomach +
+ + 056     :plough +
+ + 057     :furrow +
+ + 058     :eye]) +
+ + 059   +
+ + 060  (def ^:const seasons-in-year +
+ + 061    "Nine seasons in a year, one for each house (although the order is +
+ + 062    different." +
+ + 063    (count seasons-of-year)) +
+ + 064   +
+ + 065  (def ^:const weeks-of-season +
+ + 066    "To fit nine seasons of eight day weeks into 365 days, each must be of +
+ + 067    five weeks." +
+ + 068    [:first :second :third :fourth :fifth]) +
+ + 069   +
+ + 070  (def ^:const weeks-in-season +
+ + 071    "To fit nine seasons of eight day weeks into 365 days, each must be of +
+ + 072    five weeks." +
+ + 073    (count weeks-of-season)) +
+ + 074   +
+ + 075  (def ^:const days-in-season +
+ + 076    (* weeks-in-season days-in-week)) +
+ + 077   +
+ + 078  (defn game-time +
+ + 079    "With no arguments, the current game time. If a Java `timestamp` value is +
+ + 080    passed (as a `long`), the game time represented by that value." +
+ + 081    ([] (game-time (now))) +
+ + 082    ([timestamp] +
+ + 083     (- timestamp game-start-time))) +
+ + 084   +
+ + 085  (defmacro day-of-year +
+ + 086    "The day of the year represented by this `game-time`, ignoring leap years." +
+ + 087    [game-time] +
+ + 088    `(mod (long (/ ~game-time game-day-length)) 365)) +
+ + 089   +
+ + 090  (def waiting-day? +
+ + 091    "Does this `game-time` represent a waiting day?" +
+ + 092    (memoize +
+ + 093      ;; we're likely to call this several times in quick succession on the +
+ + 094      ;; same timestamp +
+ + 095      (fn [game-time] +
+ + 096          (>= +
+ + 097            (day-of-year game-time) +
+ + 098            (* seasons-in-year weeks-in-season days-in-week))))) +
+ + 099   +
+ + 100  (defn day +
+ + 101    "Day of the eight-day week represented by this `game-time`." +
+ + 102    [game-time] +
+ + 103    (let [day-of-week (mod (day-of-year game-time) days-in-week)] +
+ + 104      (if (waiting-day? game-time) +
+ + 105        (nth weeks-of-season day-of-week) +
+ + 106        (nth days-of-week day-of-week)))) +
+ + 107   +
+ + 108  (defn week +
+ + 109    "Week of season represented by this `game-time`." +
+ + 110    [game-time] +
+ + 111    (let [day-of-season (mod (day-of-year game-time) days-in-season) +
+ + 112          week (/ day-of-season days-in-week)] +
+ + 113      (if (waiting-day? game-time) +
+ + 114        :waiting +
+ + 115        (nth weeks-of-season week)))) +
+ + 116   +
+ + 117  (defn season +
+ + 118    [game-time] +
+ + 119    (let [season (int (/ (day-of-year game-time) days-in-season))] +
+ + 120      (if (waiting-day? game-time) +
+ + 121        :waiting +
+ + 122        (nth seasons-of-year season)))) +
+ + 123   +
+ + 124  (defn date-string +
+ + 125    "Return a correctly formatted date for this `game-time` in the calendar of +
+ + 126    the Great Place." +
+ + 127    [game-time] +
+ + 128    (s/join +
+ + 129      " " +
+ + 130      (if +
+ + 131        (waiting-day? game-time) +
+ + 132        [(s/capitalize +
+ + 133           (name +
+ + 134             (nth +
+ + 135               weeks-of-season +
+ + 136               (mod (day-of-year game-time) days-in-week)))) +
+ + 137         "waiting day"] +
+ + 138        [(s/capitalize (name (week game-time))) +
+ + 139         (s/capitalize (name (day game-time))) +
+ + 140         "of the" +
+ + 141         (s/capitalize (name (season game-time)))]))) +
+ + 142   +
+ + 143   +
+ + 144   +
+ + diff --git a/docs/cloverage/cc/journeyman/the_great_game/utils.clj.html b/docs/cloverage/cc/journeyman/the_great_game/utils.clj.html new file mode 100644 index 0000000..640231f --- /dev/null +++ b/docs/cloverage/cc/journeyman/the_great_game/utils.clj.html @@ -0,0 +1,143 @@ + + + + cc/journeyman/the_great_game/utils.clj + + + + 001  (ns cc.journeyman.the-great-game.utils) +
+ + 002   +
+ + 003  (defn cyclic? +
+ + 004    "True if two or more elements of `route` are identical" +
+ + 005    [route] +
+ + 006    (not= (count route)(count (set route)))) +
+ + 007   +
+ + 008  (defn deep-merge +
+ + 009    "Recursively merges maps. Stolen from +
+ + 010    https://dnaeon.github.io/recursively-merging-maps-in-clojure/" +
+ + 011    [& maps] +
+ + 012    (letfn [(m [& xs] +
+ + 013               (if (some #(and (map? %) (not (record? %))) xs) +
+ + 014                 (apply merge-with m xs) +
+ + 015                 (last xs)))] +
+ + 016      (reduce m maps))) +
+ + 017   +
+ + 018  (defn make-target-filter +
+ + 019    "Construct a filter which, when applied to a list of maps, +
+ + 020    will pass those which match these `targets`, where each target +
+ + 021    is a tuple [key value]." +
+ + 022    ;; TODO: this would probably be more elegant as a macro +
+ + 023    [targets] +
+ + 024    (eval +
+ + 025      (list +
+ + 026        'fn +
+ + 027        (vector 'm) +
+ + 028        (cons +
+ + 029          'and +
+ + 030          (map +
+ + 031            #(list +
+ + 032               '= +
+ + 033               (list (first %) 'm) +
+ + 034               (nth % 1)) +
+ + 035            targets))))) +
+ + 036   +
+ + 037  (defn value-or-default +
+ + 038    "Return the value of this key `k` in this map `m`, or this `dflt` value if +
+ + 039    there is none." +
+ + 040    [m k dflt] +
+ + 041    (or (when (map? m) (m k)) dflt)) +
+ + 042   +
+ + 043  ;; (value-or-default {:x 0 :y 0 :altitude 7} :altitude 8) +
+ + 044  ;; (value-or-default {:x 0 :y 0 :altitude 7} :alt 8) +
+ + 045  ;; (value-or-default nil :altitude 8) +
+ + diff --git a/docs/cloverage/cc/journeyman/the_great_game/world/heightmap.clj.html b/docs/cloverage/cc/journeyman/the_great_game/world/heightmap.clj.html new file mode 100644 index 0000000..4ca6508 --- /dev/null +++ b/docs/cloverage/cc/journeyman/the_great_game/world/heightmap.clj.html @@ -0,0 +1,485 @@ + + + + cc/journeyman/the_great_game/world/heightmap.clj + + + + 001  (ns cc.journeyman.the-great-game.world.heightmap +
+ + 002    "Functions dealing with the tessellated multi-layer heightmap." +
+ + 003      (:require [clojure.math.numeric-tower :refer [expt sqrt]] +
+ + 004                [mw-engine.core :refer []] +
+ + 005                [mw-engine.heightmap :refer [apply-heightmap]] +
+ + 006                [mw-engine.utils :refer [get-cell in-bounds? map-world]] +
+ + 007                [cc.journeyman.the-great-game.utils :refer [value-or-default]])) +
+ + 008   +
+ + 009  ;; It's not at all clear to me yet what the workflow for getting a MicroWorld +
+ + 010  ;; map into The Great Game, and whether it passes through Walkmap to get here. +
+ + 011  ;; This file as currently written assumes it doesn't. +
+ + 012   +
+ + 013  ;; It's utterly impossible to hold a whole continent at one metre scale in +
+ + 014  ;; memory at one time. So we have to be able to regenerate high resolution +
+ + 015  ;; surfaces from much lower resolution heightmaps. +
+ + 016  ;; +
+ + 017  ;; Thus to reproduce a segment of surface at a particular level of detail, +
+ + 018  ;; we: +
+ + 019  ;; 1. load the base heightmap into a grid (see +
+ + 020  ;;    `mw-engine.heightmap/apply-heightmap`); +
+ + 021  ;; 2. scale the base hightmap to kilometre scale (see `scale-grid`); +
+ + 022  ;; 3. exerpt the portion of that that we want to reproduce (see `exerpt-grid`); +
+ + 023  ;; 4. interpolate that grid to get the resolution we require (see +
+ + 024  ;;    `interpolate-grid`); +
+ + 025  ;; 5. create an appropriate purturbation grid from the noise map(s) for the +
+ + 026  ;;    same coordinates to break up the smooth interpolation; +
+ + 027  ;; 6. sum the altitudes of the two grids. +
+ + 028  ;; +
+ + 029  ;; In production this will have to be done **very** fast! +
+ + 030   +
+ + 031  (def ^:dynamic *base-map* "resources/maps/heightmap.png") +
+ + 032  (def ^:dynamic *noise-map* "resources/maps/noise.png") +
+ + 033   +
+ + 034  (defn scale-grid +
+ + 035    "multiply all `:x` and `:y` values in this `grid` by this `n`." +
+ + 036    [grid n] +
+ + 037    (map-world grid (fn [w c x] (assoc c :x (* (:x c) n) :y (* (:y c) n))))) +
+ + 038   +
+ + 039   +
+ + 040   +
+ + 041  ;; Each of the east-west curve and the north-south curve are of course two +
+ + 042  ;; dimensional curves; the east-west curve is in the :x/:z plane and the +
+ + 043  ;; north-south curve is in the :y/:z plane (except, perhaps unwisely, +
+ + 044  ;; we've been using :altitude to label the :z plane). We have a library +
+ + 045  ;; function `walkmap.edge/intersection2d`, but as currently written it +
+ + 046  ;; can only find intersections in :x/:y plane. +
+ + 047  ;; +
+ + 048  ;; TODO: rewrite the function so that it can use arbitrary coordinates. +
+ + 049  ;; AFTER TRYING: OK, there are too many assumptions about the way that +
+ + 050  ;; function is written to allow for easy rotation. TODO: think! +
+ + 051   +
+ + 052  (defn interpolate-altitude +
+ + 053    "Return the altitude of the point at `x-offset`, `y-offset` within this +
+ + 054    `cell` having this `src-width`, taken from this `grid`." +
+ + 055    [cell grid src-width x-offset y-offset ] +
+ + 056    (let [c-alt (:altitude cell) +
+ + 057          n-alt (or (:altitude (get-cell grid (:x cell) (dec (:y cell)))) c-alt) +
+ + 058          w-alt (or (:altitude (get-cell grid (inc (:x cell)) (:y cell))) c-alt) +
+ + 059          s-alt (or (:altitude (get-cell grid (:x cell) (inc (:y cell)))) c-alt) +
+ + 060          e-alt (or (:altitude (get-cell grid (dec (:x cell)) (:y cell))) c-alt)] +
+ + 061      ;; TODO: construct two curves (arcs of circles good enough for now) +
+ + 062      ;; n-alt...c-alt...s-alt and e-alt...c-alt...w-alt; +
+ + 063      ;; then interpolate x-offset along e-alt...c-alt...w-alt and y-offset +
+ + 064      ;; along n-alt...c-alt...s-alt; +
+ + 065      ;; then return the average of the two +
+ + 066   +
+ + 067      0)) +
+ + 068   +
+ + 069  (defn interpolate-cell +
+ + 070    "Construct a grid (array of arrays) of cells each of width `target-width` +
+ + 071    from this `cell`, of width `src-width`, taken from this `grid`" +
+ + 072    [cell grid src-width target-width] +
+ + 073    (let [offsets (map #(* target-width %) (range (/ src-width target-width)))] +
+ + 074      (into +
+ + 075        [] +
+ + 076        (map +
+ + 077          (fn [r] +
+ + 078            (into +
+ + 079              [] +
+ + 080              (map +
+ + 081                (fn [c] +
+ + 082                  (assoc cell +
+ + 083                    :x (+ (:x cell) c) +
+ + 084                    :y (+ (:y cell) r) +
+ + 085                    :altitude (interpolate-altitude cell grid src-width c r))) +
+ + 086                offsets))) +
+ + 087          offsets)))) +
+ + 088   +
+ + 089  (defn interpolate-grid +
+ + 090    "Return a grid interpolated from this `grid` of rows, cols given scaling +
+ + 091    from this `src-width` to this `target-width`" +
+ + 092    [grid src-width target-width] +
+ + 093    (reduce +
+ + 094      concat +
+ + 095      (into +
+ + 096        [] +
+ + 097        (map +
+ + 098          (fn [row] +
+ + 099            (reduce +
+ + 100              (fn [g1 g2] +
+ + 101                (into [] (map #(into [] (concat %1 %2)) g1 g2))) +
+ + 102              (into [] (map #(interpolate-cell % grid src-width target-width) row)))) +
+ + 103          grid)))) +
+ + 104   +
+ + 105  (defn excerpt-grid +
+ + 106    "Return that section of this `grid` where the `:x` co-ordinate of each cell +
+ + 107    is greater than or equal to this `x-offset`, the `:y` co-ordinate is greater +
+ + 108    than or equal to this `y-offset`, whose width is not greater than this +
+ + 109    `width`, and whose height is not greater than this `height`." +
+ + 110    [grid x-offset y-offset width height] +
+ + 111    (into +
+ + 112      [] +
+ + 113      (remove +
+ + 114        nil? +
+ + 115        (map +
+ + 116          (fn [row] +
+ + 117            (when +
+ + 118              (and +
+ + 119                (>= (:y (first row)) y-offset) +
+ + 120                (< (:y (first row)) (+ y-offset height))) +
+ + 121              (into +
+ + 122                [] +
+ + 123                (remove +
+ + 124                  nil? +
+ + 125                  (map +
+ + 126                    (fn [cell] +
+ + 127                      (when +
+ + 128                        (and +
+ + 129                          (>= (:x cell) x-offset) +
+ + 130                          (< (:x cell) (+ x-offset width))) +
+ + 131                        cell)) +
+ + 132                    row))))) +
+ + 133         grid)))) +
+ + 134   +
+ + 135  (defn get-surface +
+ + 136    "Return, as a vector of vectors of cells represented as Clojure maps, a +
+ + 137    segment of surface from this `base-map` as modified by this +
+ + 138    `noise-map` at this `cell-size` starting at this `x-offset` and `y-offset` +
+ + 139    and having this `width` and `height`. +
+ + 140   +
+ + 141    If `base-map` and `noise-map` are not supplied, the bindings of `*base-map*` +
+ + 142    and `*noise-map*` will be used, respectively. +
+ + 143   +
+ + 144    `base-map` and `noise-map` may be passed either as strings, assumed to be +
+ + 145    file paths of PNG files, or as MicroWorld style world arrays. It is assumed +
+ + 146    that one pixel in `base-map` represents one square kilometre in the game +
+ + 147    world. It is assumed that `cell-size`, `x-offset`, `y-offset`, `width` and +
+ + 148    `height` are integer numbers of metres." +
+ + 149    ([cell-size x-offset y-offset width height] +
+ + 150     (get-surface *base-map* *noise-map* cell-size x-offset y-offset width height)) +
+ + 151    ([base-map noise-map cell-size x-offset y-offset width height] +
+ + 152     (let [b (if (seq? base-map) base-map (scale-grid (apply-heightmap base-map) 1000)) +
+ + 153           n (if (seq? noise-map) noise-map (apply-heightmap noise-map))] +
+ + 154       (if (and (in-bounds? b x-offset y-offset) +
+ + 155                (in-bounds? b (+ x-offset width) (+ y-offset height))) +
+ + 156         b ;; actually do stuff +
+ + 157         (throw (Exception. "Surface out of bounds for map."))) +
+ + 158       ))) +
+ + 159   +
+ + diff --git a/docs/cloverage/cc/journeyman/the_great_game/world/location.clj.html b/docs/cloverage/cc/journeyman/the_great_game/world/location.clj.html new file mode 100644 index 0000000..d8fdc31 --- /dev/null +++ b/docs/cloverage/cc/journeyman/the_great_game/world/location.clj.html @@ -0,0 +1,119 @@ + + + + cc/journeyman/the_great_game/world/location.clj + + + + 001  (ns cc.journeyman.the-great-game.world.location +
+ + 002    "Functions dealing with location in the world." +
+ + 003    (:require [clojure.math.numeric-tower :refer [expt sqrt]])) +
+ + 004   +
+ + 005  ;;   A 'location' value is a list comprising at most the x/y coordinate location +
+ + 006  ;;   and the ids of the settlement and region (possibly hierarchically) that contain +
+ + 007  ;;   the location. If the x/y is not local to the home of the receiving agent, they +
+ + 008  ;;   won't remember it and won't pass it on; if any of the ids are not interesting +
+ + 009  ;;   So location information will degrade progressively as the item is passed along. +
+ + 010   +
+ + 011  ;;   It is assumed that the `:home` of a character is a location in this sense. +
+ + 012   +
+ + 013  (defn get-coords +
+ + 014    "Return the coordinates in the game world of `location`, which may be +
+ + 015    1. A coordinate pair in the format {:x 5 :y 32}; +
+ + 016    2. A location, as discussed above; +
+ + 017    3. Any other gameworld object, having a `:location` property whose value +
+ + 018      is one of the above." +
+ + 019    [location] +
+ + 020    (cond +
+ + 021      (empty? location) nil +
+ + 022      (map? location) +
+ + 023      (cond +
+ + 024        (and (number? (:x location)) (number? (:y location))) +
+ + 025        location +
+ + 026        (:location location) +
+ + 027        (:location location)) +
+ + 028      :else +
+ + 029      (get-coords (first (remove keyword? location))))) +
+ + 030   +
+ + 031  (defn distance-between +
+ + 032    [location-1 location-2] +
+ + 033    (let [c1 (get-coords location-1) +
+ + 034          c2 (get-coords location-2)] +
+ + 035      (when +
+ + 036        (and c1 c2) +
+ + 037        (sqrt (+ (expt (- (:x c1) (:x c2)) 2) (expt (- (:y c1) (:y c2)) 2)))))) +
+ + diff --git a/docs/cloverage/cc/journeyman/the_great_game/world/mw.clj.html b/docs/cloverage/cc/journeyman/the_great_game/world/mw.clj.html new file mode 100644 index 0000000..80194bc --- /dev/null +++ b/docs/cloverage/cc/journeyman/the_great_game/world/mw.clj.html @@ -0,0 +1,29 @@ + + + + cc/journeyman/the_great_game/world/mw.clj + + + + 001  (ns cc.journeyman.the-great-game.world.mw +
+ + 002    "Functions dealing with building a great game world from a MicroWorld world." +
+ + 003      (:require [clojure.math.numeric-tower :refer [expt sqrt]] +
+ + 004                [mw-engine.core :refer []] +
+ + 005                [mw-engine.world :refer []])) +
+ + 006   +
+ + 007  ;; 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. +
+ + diff --git a/docs/cloverage/cc/journeyman/the_great_game/world/routes.clj.html b/docs/cloverage/cc/journeyman/the_great_game/world/routes.clj.html new file mode 100644 index 0000000..5d5ee4e --- /dev/null +++ b/docs/cloverage/cc/journeyman/the_great_game/world/routes.clj.html @@ -0,0 +1,173 @@ + + + + cc/journeyman/the_great_game/world/routes.clj + + + + 001  (ns cc.journeyman.the-great-game.world.routes +
+ + 002    "Conceptual (plan level) routes, represented as tuples of location ids." +
+ + 003    (:require [cc.journeyman.the-great-game.utils :refer [cyclic?]])) +
+ + 004   +
+ + 005  (defn find-routes +
+ + 006    "Find routes from among these `routes` from `from`; if `to` is supplied, +
+ + 007    to `to`, by breadth-first search." +
+ + 008    ([routes from] +
+ + 009     (map +
+ + 010       (fn [to] (cons from to)) +
+ + 011       (remove +
+ + 012         empty? +
+ + 013         (map +
+ + 014           (fn [route] +
+ + 015             (remove +
+ + 016               #(= from %) +
+ + 017               (if (some #(= % from) route) route))) +
+ + 018           routes)))) +
+ + 019    ([routes from to] +
+ + 020     (let [steps (find-routes routes from) +
+ + 021           found (filter +
+ + 022                   (fn [step] (if (some #(= to %) step) step)) +
+ + 023                   steps)] +
+ + 024       (if +
+ + 025         (empty? found) +
+ + 026         (find-routes routes from to steps) +
+ + 027         found))) +
+ + 028    ([routes from to steps] +
+ + 029     (if +
+ + 030       (not (empty? steps)) +
+ + 031       (let [paths (remove +
+ + 032                     cyclic? +
+ + 033                     (mapcat +
+ + 034                         (fn [path] +
+ + 035                           (map +
+ + 036                             (fn [x] (concat path (rest x))) +
+ + 037                             (find-routes routes (last path)))) +
+ + 038                         steps)) +
+ + 039             found (filter +
+ + 040                     #(= (last %) to) paths)] +
+ + 041         (if +
+ + 042           (empty? found) +
+ + 043           (find-routes routes from to paths) +
+ + 044           found))))) +
+ + 045   +
+ + 046  (defn find-route +
+ + 047    "Find a single route from `from` to `to` in this `world-or-routes`, which +
+ + 048    may be either a world as defined in [[the-great-game.world.world]] or else +
+ + 049    a sequence of tuples of keywords." +
+ + 050    [world-or-routes from to] +
+ + 051    (first +
+ + 052      (find-routes +
+ + 053        (or (:routes world-or-routes) world-or-routes) +
+ + 054        from +
+ + 055        to))) +
+ + diff --git a/docs/cloverage/cc/journeyman/the_great_game/world/run.clj.html b/docs/cloverage/cc/journeyman/the_great_game/world/run.clj.html new file mode 100644 index 0000000..f161313 --- /dev/null +++ b/docs/cloverage/cc/journeyman/the_great_game/world/run.clj.html @@ -0,0 +1,125 @@ + + + + cc/journeyman/the_great_game/world/run.clj + + + + 001  (ns cc.journeyman.the-great-game.world.run +
+ + 002    "Run the whole simulation" +
+ + 003    (:require [environ.core :refer [env]] +
+ + 004              [taoensso.timbre :as timbre] +
+ + 005              [taoensso.timbre.appenders.3rd-party.rotor :as rotor] +
+ + 006              [cc.journeyman.the-great-game.gossip.gossip :as g] +
+ + 007              [cc.journeyman.the-great-game.merchants.merchants :as m] +
+ + 008              [cc.journeyman.the-great-game.merchants.markets :as k] +
+ + 009              [cc.journeyman.the-great-game.world.world :as w])) +
+ + 010   +
+ + 011  (defn init +
+ + 012    ([] +
+ + 013     (init {})) +
+ + 014    ([config] +
+ + 015     (timbre/merge-config! +
+ + 016       {:appenders +
+ + 017        {:rotor (rotor/rotor-appender +
+ + 018                  {:path "the-great-game.log" +
+ + 019                   :max-size (* 512 1024) +
+ + 020                   :backlog 10})} +
+ + 021        :level (or +
+ + 022                 (:log-level config) +
+ + 023                 (if (env :dev) :debug) +
+ + 024                 :info)}))) +
+ + 025   +
+ + 026  (defn run +
+ + 027    "The pipeline to run the simulation each game day. Returns a world like +
+ + 028    this world, with all the various active elements updated. The optional +
+ + 029    `date` argument, if supplied, is set as the `:date` of the returned world." +
+ + 030    ([world] +
+ + 031    (g/run +
+ + 032      (m/run +
+ + 033        (k/run +
+ + 034          (w/run world))))) +
+ + 035    ([world date] +
+ + 036    (g/run +
+ + 037      (m/run +
+ + 038        (k/run +
+ + 039          (w/run world date)))))) +
+ + diff --git a/docs/cloverage/cc/journeyman/the_great_game/world/world.clj.html b/docs/cloverage/cc/journeyman/the_great_game/world/world.clj.html new file mode 100644 index 0000000..7170770 --- /dev/null +++ b/docs/cloverage/cc/journeyman/the_great_game/world/world.clj.html @@ -0,0 +1,584 @@ + + + + cc/journeyman/the_great_game/world/world.clj + + + + 001  (ns cc.journeyman.the-great-game.world.world +
+ + 002    "Access to data about the world") +
+ + 003   +
+ + 004  ;;; The world has to work either as map or a database. Initially, and for +
+ + 005  ;;; unit tests, I'll use a map; later, there will be a database. But the +
+ + 006  ;;; API needs to be agnostic, so that heirarchies which interact with +
+ + 007  ;;; `world` don't have to know which they've got - as far as they're concerned +
+ + 008  ;;; it's just a handle. +
+ + 009   +
+ + 010  (def default-world +
+ + 011    "A basic world for testing concepts" +
+ + 012    {:date 0 ;; the age of this world in game days +
+ + 013     :cities +
+ + 014     {:aberdeen +
+ + 015      {:id :aberdeen +
+ + 016       :supplies +
+ + 017       ;; `supplies` is the quantity of each commodity added to the stock +
+ + 018       ;; each game day. If the price in the market is lower than 1 (the +
+ + 019       ;; cost of production of a unit) no goods will be added. +
+ + 020       {:fish 10 +
+ + 021        :leather 5} +
+ + 022       :demands +
+ + 023       ;; `stock` is the quantity of each commodity in the market at any +
+ + 024       ;; given time. It is adjusted for production and consumption at +
+ + 025       ;; the end of each game day. +
+ + 026       {:iron 1 +
+ + 027        :cloth 10 +
+ + 028        :whisky 10} +
+ + 029       :port true +
+ + 030       :prices +
+ + 031       ;; `prices`: the current price (both buying and selling, for simplicity) +
+ + 032       ;; of each commodity in the market. Updated each game day based on current +
+ + 033       ;; stock. +
+ + 034       {:cloth 1 +
+ + 035        :fish 1 +
+ + 036        :leather 1 +
+ + 037        :iron 1 +
+ + 038        :whisky 1} +
+ + 039       :stock +
+ + 040       ;; `stock` is the quantity of each commodity in the market at any +
+ + 041       ;; given time. It is adjusted for production and consumption at +
+ + 042       ;; the end of each game day. +
+ + 043       {:cloth 0 +
+ + 044        :fish 0 +
+ + 045        :leather 0 +
+ + 046        :iron 0 +
+ + 047        :whisky 0} +
+ + 048       :cash 100} +
+ + 049      :buckie +
+ + 050      {:id :buckie +
+ + 051       :supplies +
+ + 052       {:fish 20} +
+ + 053       :demands +
+ + 054       {:cloth 5 +
+ + 055        :leather 3 +
+ + 056        :whisky 5 +
+ + 057        :iron 1} +
+ + 058       :port true +
+ + 059       :prices {:cloth 1 +
+ + 060                :fish 1 +
+ + 061                :leather 1 +
+ + 062                :iron 1 +
+ + 063                :whisky 1} +
+ + 064       :stock {:cloth 0 +
+ + 065               :fish 0 +
+ + 066               :leather 0 +
+ + 067               :iron 0 +
+ + 068               :whisky 0} +
+ + 069       :cash 100} +
+ + 070      :callander +
+ + 071      {:id :callander +
+ + 072       :supplies {:leather 20} +
+ + 073       :demands +
+ + 074       {:cloth 5 +
+ + 075        :fish 3 +
+ + 076        :whisky 5 +
+ + 077        :iron 1} +
+ + 078       :prices {:cloth 1 +
+ + 079                :fish 1 +
+ + 080                :leather 1 +
+ + 081                :iron 1 +
+ + 082                :whisky 1} +
+ + 083       :stock {:cloth 0 +
+ + 084               :fish 0 +
+ + 085               :leather 0 +
+ + 086               :iron 0 +
+ + 087               :whisky 0} +
+ + 088       :cash 100} +
+ + 089      :dundee {:id :dundee} +
+ + 090      :edinburgh {:id :dundee} +
+ + 091      :falkirk +
+ + 092      {:id :falkirk +
+ + 093       :supplies {:iron 10} +
+ + 094       :demands +
+ + 095       {:cloth 5 +
+ + 096        :leather 3 +
+ + 097        :whisky 5 +
+ + 098        :fish 10} +
+ + 099       :port true +
+ + 100       :prices {:cloth 1 +
+ + 101                :fish 1 +
+ + 102                :leather 1 +
+ + 103                :iron 1 +
+ + 104                :whisky 1} +
+ + 105       :stock {:cloth 0 +
+ + 106               :fish 0 +
+ + 107               :leather 0 +
+ + 108               :iron 0 +
+ + 109               :whisky 0} +
+ + 110       :cash 100} +
+ + 111      :glasgow +
+ + 112      {:id :glasgow +
+ + 113       :supplies {:whisky 10} +
+ + 114       :demands +
+ + 115       {:cloth 5 +
+ + 116        :leather 3 +
+ + 117        :iron 5 +
+ + 118        :fish 10} +
+ + 119       :port true +
+ + 120       :prices {:cloth 1 +
+ + 121                :fish 1 +
+ + 122                :leather 1 +
+ + 123                :iron 1 +
+ + 124                :whisky 1} +
+ + 125       :stock {:cloth 0 +
+ + 126               :fish 0 +
+ + 127               :leather 0 +
+ + 128               :iron 0 +
+ + 129               :whisky 0} +
+ + 130       :cash 100}} +
+ + 131     :merchants +
+ + 132     {:archie {:id :archie +
+ + 133               :home :aberdeen :location :aberdeen :cash 100 :capacity 10 +
+ + 134               :known-prices {} +
+ + 135               :stock {}} +
+ + 136      :belinda {:id :belinda +
+ + 137                :home :buckie :location :buckie :cash 100 :capacity 10 +
+ + 138                :known-prices {} +
+ + 139                :stock {}} +
+ + 140      :callum {:id :callum +
+ + 141               :home :callander :location :calander :cash 100 :capacity 10 +
+ + 142               :known-prices {} +
+ + 143               :stock {}} +
+ + 144      :deirdre {:id :deidre +
+ + 145                :home :dundee :location :dundee :cash 100 :capacity 10 +
+ + 146                :known-prices {} +
+ + 147                :stock {}} +
+ + 148      :euan {:id :euan +
+ + 149             :home :edinbirgh :location :edinburgh :cash 100 :capacity 10 +
+ + 150               :known-prices {} +
+ + 151               :stock {}} +
+ + 152      :fiona {:id :fiona +
+ + 153              :home :falkirk :location :falkirk :cash 100 :capacity 10 +
+ + 154              :known-prices {} +
+ + 155              :stock {}}} +
+ + 156     :routes +
+ + 157     ;; all routes can be traversed in either direction and are assumed to +
+ + 158     ;; take the same amount of time. +
+ + 159     [[:aberdeen :buckie] +
+ + 160      [:aberdeen :dundee] +
+ + 161      [:callander :glasgow] +
+ + 162      [:dundee :callander] +
+ + 163      [:dundee :edinburgh] +
+ + 164      [:dundee :falkirk] +
+ + 165      [:edinburgh :falkirk] +
+ + 166      [:falkirk :glasgow]] +
+ + 167     :commodities +
+ + 168     ;; cost of commodities is expressed in person/days; +
+ + 169     ;; weight in packhorse loads. Transport in this model +
+ + 170     ;; is all overland; you don't take bulk cargoes overland +
+ + 171     ;; in this period, it's too expensive. +
+ + 172     {:cloth {:id :cloth :cost 1 :weight 0.25} +
+ + 173      :fish {:id :fish :cost 1 :weight 1} +
+ + 174      :leather {:id :leather :cost 1 :weight 0.5} +
+ + 175      :whisky {:id :whisky :cost 1 :weight 0.1} +
+ + 176      :iron {:id :iron :cost 1 :weight 10}}}) +
+ + 177   +
+ + 178  (defn actual-price +
+ + 179    "Find the actual current price of this `commodity` in this `city` given +
+ + 180    this `world`. **NOTE** that merchants can only know the actual prices in +
+ + 181    the city in which they are currently located." +
+ + 182    [world commodity city] +
+ + 183    (-> world :cities city :prices commodity)) +
+ + 184   +
+ + 185  (defn run +
+ + 186    "Return a world like this `world` with only the `:date` to this `date` +
+ + 187    (or id `date` not supplied, the current value incremented by one). For +
+ + 188    running other aspects of the simulation, see [[the-great-game.world.run]]." +
+ + 189    ([world] +
+ + 190     (run world (inc (or (:date world) 0)))) +
+ + 191    ([world date] +
+ + 192     (assoc world :date date))) +
+ + diff --git a/docs/cloverage/index.html b/docs/cloverage/index.html index 6901d4d..724b600 100644 --- a/docs/cloverage/index.html +++ b/docs/cloverage/index.html @@ -15,44 +15,102 @@ TotalBlankInstrumented - the-great-game.gossip.gossip
cc.journeyman.the-great-game.agent.agent
3
+100.00 % +
3
+100.00 % +4553 + + + cc.journeyman.the-great-game.buildings.rectangular
106
36
+74.65 % +
24
1
6
+80.65 % +1802531 + + + cc.journeyman.the-great-game.gossip.gossip
5
103
4.63 %
5
34
-12.82 % -66539 + style="width:87.5%; + float:left;"> 35
+12.50 % +73740 - the-great-game.gossip.news-items
477
37
-92.80 % + cc.journeyman.the-great-game.gossip.news-items
437
197
+68.93 %
96
8
5
-95.41 % -25631109 + style="width:63.07692307692308%; + float:left;"> 82
10
38
+70.77 % +31336130 - the-great-game.merchants.markets
191
cc.journeyman.the-great-game.holdings.holding
3
18
+14.29 % +
3
4
+42.86 % +4637 + + + cc.journeyman.the-great-game.location.location
4
22
+15.38 % +
4
10
+28.57 % +47814 + + + cc.journeyman.the-great-game.merchants.markets
192
7
-96.46 % +96.48 %
41
84844 - the-great-game.merchants.merchant-utils
cc.journeyman.the-great-game.merchants.merchant-utils
197
106772 - the-great-game.merchants.merchants
cc.journeyman.the-great-game.merchants.merchants
2
69
-2.82 % + style="width:97.26027397260275%; + float:left;"> 71
+2.74 %
2
28316 - the-great-game.merchants.planning
cc.journeyman.the-great-game.merchants.planning
258
1591185 - the-great-game.merchants.strategies.simple
cc.journeyman.the-great-game.merchants.strategies.simple
5
600
-0.83 % + style="width:99.18433931484502%; + float:left;"> 608
+0.82 %
5
1736124 - the-great-game.objects.container
cc.journeyman.the-great-game.objects.container
2
100.00 % @@ -139,48 +197,86 @@ 1112 - the-great-game.objects.game-object
cc.journeyman.the-great-game.objects.game-object
3
2
-60.00 % + style="width:50.0%; + float:left;"> 3
+50.00 %
3
2
-60.00 % -1925 + style="width:50.0%; + float:left;"> 3
+50.00 % +2126 - the-great-game.time
240
1
-99.59 % + cc.journeyman.the-great-game.playroom
463
75
+86.06 %
59
28
5
2
+94.29 % +721235 + + + cc.journeyman.the-great-game.time
236
5
+97.93 % +
58
1
1
-100.00 % +98.33 % 1442160 - the-great-game.utils
69
-100.00 % + cc.journeyman.the-great-game.utils
70
13
+84.34 %
19
-100.00 % -35319 + style="width:95.23809523809524%; + float:left;"> 20
1
+95.24 % +45521 - the-great-game.world.location
cc.journeyman.the-great-game.world.heightmap
11
295
+3.59 % +
9
62
+12.68 % +1591671 + + + cc.journeyman.the-great-game.world.location
73
37417 - the-great-game.world.routes
cc.journeyman.the-great-game.world.mw
1
+100.00 % +
1
+100.00 % +711 + + + cc.journeyman.the-great-game.world.routes
123
55242 - the-great-game.world.run
cc.journeyman.the-great-game.world.run
3
39220 - the-great-game.world.world
cc.journeyman.the-great-game.world.world
420
-66.55 % +61.00 % -68.63 % +61.78 % diff --git a/src/the_great_game/architecture.md b/src/cc/journeyman/architecture.md similarity index 100% rename from src/the_great_game/architecture.md rename to src/cc/journeyman/architecture.md diff --git a/src/cc/journeyman/the_great_game/buildings/rectangular.clj b/src/cc/journeyman/the_great_game/buildings/rectangular.clj index a58a4d7..1000a6d 100644 --- a/src/cc/journeyman/the_great_game/buildings/rectangular.clj +++ b/src/cc/journeyman/the_great_game/buildings/rectangular.clj @@ -115,36 +115,6 @@ :cultures #{:coastal} :modules []}}) -;; TODO: So, modules need to contain -;; -;; 1. Ground floor modules, having external doors; -;; 2. Craft modules -- workshops -- which will normally be ground floor (except -;; weavers) and may have the constraint that no upper floor module can cover them; -;; 3. Upper floor modules, having NO external doors (but linking internal doors); -;; 4. Roof modules -;; -;; There also needs to be an undercroft or platform module, such that the area of -;; the top of the platform is identical with the footprint of the building, and -;; the altitude of the top of the platform is equal to the altitude of the -;; terrain at the heighest corner of the building; so that the actual -;; building doesn't float in the air, and also so that none of the doors or windows -;; are partly underground. -;; -;; Each module needs to wrap an actual 3d model created in Blender or whatever, -;; and have a list of optional textures with which that model can be rendered. -;; So an upper floor bedroom module might have the following renders: -;; -;; 1. Bare masonry - constrained to upland or plateau terrain, and to coastal culture -;; 2. Painted masonry - constrained to upland or plateau terrain, and to coastal culture -;; 3. Half-timbered - not available on plateau terrain -;; 4. Weatherboarded - constrained to forest terrain -;; 5. Brick - constrained to arable or arid terrain -;; -;; of course these are only examples, and also, it's entirely possible to have -;; for example multiple different weatherboard renders for the same module. -;; There needs to be a way of rendering what can be built above what: for -;; example, you can't have a masonry clad module over a half timbered one, -;; but you can have a half-timbered one over a masonry one (defn building-family "A building family is essentially a collection of models of building modules diff --git a/src/cc/journeyman/the_great_game/gossip/news_items.clj b/src/cc/journeyman/the_great_game/gossip/news_items.clj index 10e4883..18600de 100644 --- a/src/cc/journeyman/the_great_game/gossip/news_items.clj +++ b/src/cc/journeyman/the_great_game/gossip/news_items.clj @@ -1,5 +1,5 @@ (ns cc.journeyman.the-great-game.gossip.news-items - "Categories of news events interesting to gossip agents. + "Using news items (propositions) to transfer knowledge between gossip agents. The ideas here are based on the essay [The spread of knowledge in a large game world](The-spread-of-knowledge-in-a-large-game-world.html), q.v.; @@ -22,7 +22,8 @@ list of propositions, each of which must be checked every time any new proposition is offered. This is woefully inefficient. " (:require [cc.journeyman.the-great-game.world.location :refer [distance-between]] - [cc.journeyman.the-great-game.time :refer [game-time]])) + [cc.journeyman.the-great-game.time :refer [game-time]] + [taoensso.timbre :as l])) (def news-topics @@ -155,8 +156,8 @@ (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)) + [gossip location] + (> (interest-in-location gossip location) 0)) (defn interesting-object? [gossip object] @@ -190,13 +191,16 @@ learning that 'someone killed Sweet Daisy', but there is point in learning 'someone killed Sweet Daisy _with poison_'." [new-item known-item] - (reduce - #(and %1 %2) - (map #(if - (known-item %) ;; if known-item has this key - (compatible-value? (new-item %) (known-item %)) - true) - (remove #{:nth-hand :confidence :learned-from} (keys new-item))))) + (if + (reduce + #(and %1 %2) + (map #(if + (known-item %) ;; if known-item has this key + (compatible-value? (new-item %) (known-item %)) + true) + (remove #{:nth-hand :confidence :learned-from} (keys new-item)))) + true + false)) (defn known-item? "True if this news `item` is already known to this `gossip`. @@ -205,9 +209,13 @@ the same _or more specific_ values for all the keys of this `item` except `:nth-hand`, `:confidence` and `:learned-from`." [gossip item] - (reduce - #(or %1 %2) - (filter true? (map #(compatible-item? item %) (:knowledge gossip))))) + (if + (reduce + #(or %1 %2) + false + (filter true? (map #(compatible-item? item %) (:knowledge gossip)))) + true + false)) (defn interesting-item? "True if anything about this news `item` is interesting to this `gossip`." @@ -220,30 +228,39 @@ (interesting-object? gossip (:object item)) (interesting-topic? gossip (:verb item))))) +(defn inc-or-one + "If this `val` is a number, return that number incremented by one; otherwise, + return 1. TODO: should probably be in `utils`." + [val] + (if + (number? val) + (inc val) + 1)) + (defn infer - "Infer a new knowledge item from this `item`, following this `rule`" + "Infer a new knowledge item from this `item`, following this `rule`." [item rule] +;; (l/info "Applying rule '" rule "' to item '" item "'") (reduce merge item (cons - {:verb (:verb rule)} - (map (fn [k] {k (apply (k rule) (list item))}) + {:verb (:verb rule) + :nth-hand (inc-or-one (:nth-hand item))} + (map (fn [k] {k (item (rule k))}) (remove - #{:verb} + #{:verb :nth-hand} (keys rule)))))) (declare learn-news-item) (defn make-all-inferences - "Return a list of knowledge entries that can be inferred from this news + "Return a set 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))))))) + #(infer item %) + (:inferences (news-topics (:verb item)))))) (defn degrade-character "Return a character specification like this `character`, but comprising @@ -264,15 +281,6 @@ location))] (when-not (empty? l) l))) -(defn inc-or-one - "If this `val` is a number, return that number incremented by one; otherwise, - return 1. TODO: should probably be in `utils`." - [val] - (if - (number? val) - (inc val) - 1)) - (defn learn-news-item "Return a gossip like this `gossip`, which has learned this news `item` if it is of interest to them." diff --git a/src/cc/journeyman/the_great_game/location/location.clj b/src/cc/journeyman/the_great_game/location/location.clj index 4b5895f..1fdc3b9 100644 --- a/src/cc/journeyman/the_great_game/location/location.clj +++ b/src/cc/journeyman/the_great_game/location/location.clj @@ -43,5 +43,3 @@ ;; (.settlement (OrientedLocation. 123.45 543.76 12.34 0.00 {})) - -;; (OrientedLocation. 123.45 543.76 12.34 0.00 {}) \ No newline at end of file diff --git a/test/cc/journeyman/the_great_game/gossip/news_items_test.clj b/test/cc/journeyman/the_great_game/gossip/news_items_test.clj index ef3abfc..50f062a 100644 --- a/test/cc/journeyman/the_great_game/gossip/news_items_test.clj +++ b/test/cc/journeyman/the_great_game/gossip/news_items_test.clj @@ -1,135 +1,163 @@ (ns cc.journeyman.the-great-game.gossip.news-items-test (:require [clojure.test :refer [deftest is testing]] - [cc.journeyman.the-great-game.gossip.news-items :refer - [degrade-location infer interest-in-location interesting-location? + [cc.journeyman.the-great-game.gossip.news-items :refer + [compatible-item? degrade-location infer interest-in-location interesting-location? learn-news-item make-all-inferences]])) +(deftest compatible-item-test + (testing "Compatible item: items are identical" + (let [expected true + new-item {:verb :kills :location :tchahua :actor :fierce-fred :other :dainty-daisy} + known-item {:verb :kills :location :tchahua :actor :fierce-fred :other :dainty-daisy} + actual (compatible-item? new-item known-item)] + (is (= actual expected) "Items which are identical are compatible."))) + (testing "Compatible item: new item is less specific" + (let [expected true + new-item {:verb :kills :location :tchahua :other :dainty-daisy} + known-item {:verb :kills :location :tchahua :actor :fierce-fred :other :dainty-daisy} + actual (compatible-item? new-item known-item)] + (is (= actual expected) + "An item which is less specific is compatible with existing knowledge."))) + (testing "Compatible item: new item is more specific" + (let [expected true + new-item {:verb :kills :location :tchahua :actor :fierce-fred :other :dainty-daisy :date 20210609} + known-item {:verb :kills :location :tchahua :actor :fierce-fred :other :dainty-daisy} + actual (compatible-item? new-item known-item)] + (is (= actual expected) "A new item which is more specific adds knowledge and is not compatible"))) + (testing "Compatible item: new item conflicts with existing knowledge." + (let [expected false + new-item {:verb :kills :location :tchahua :actor :jealous-joe :other :dainty-daisy} + known-item {:verb :kills :location :tchahua :actor :fierce-fred :other :dainty-daisy} + actual (compatible-item? new-item known-item)] + (is (= actual expected) "A new item which we don't yet intelligently handle but is not compatible")))) + (deftest location-test (testing "Interest in locations" (let [expected 1 actual (interest-in-location - {:knowledge [{:verb :steal - :actor :albert - :other :belinda - :object :foo - :location [{:x 35 :y 23} :auchencairn :galloway]}]} - :galloway)] + {:knowledge [{:verb :steal + :actor :albert + :other :belinda + :object :foo + :location [{:x 35 :y 23} :auchencairn :galloway]}]} + :galloway)] (is (= actual expected))) (let [expected 2 actual (interest-in-location - {:knowledge [{:verb :steal - :actor :albert - :other :belinda - :object :foo - :location [{:x 35 :y 23} :auchencairn :galloway :scotland]}]} - [:galloway :scotland])] + {:knowledge [{:verb :steal + :actor :albert + :other :belinda + :object :foo + :location [{:x 35 :y 23} :auchencairn :galloway :scotland]}]} + [:galloway :scotland])] (is (= actual expected))) (let [expected 2 actual (interest-in-location - {:home [{:x 35 :y 23} :auchencairn :galloway :scotland]} - [:galloway :scotland])] + {:home [{:x 35 :y 23} :auchencairn :galloway :scotland]} + [:galloway :scotland])] (is (= actual expected))) (let [expected 0 actual (interest-in-location - {:knowledge [{:verb :steal - :actor :albert - :other :belinda - :object :foo - :location [{:x 35 :y 23} :auchencairn :galloway]}]} - [:dumfries])] + {:knowledge [{:verb :steal + :actor :albert + :other :belinda + :object :foo + :location [{:x 35 :y 23} :auchencairn :galloway]}]} + [:dumfries])] (is (= actual expected))) (let [expected 7071.067811865475 actual (interest-in-location - {:home [{:x 35 :y 23}]} - [{:x 34 :y 24}])] + {:home [{:x 35 :y 23}]} + [{:x 34 :y 24}])] (is (= actual expected) "TODO: 7071.067811865475 is actually a bad answer.")) (let [expected 0 actual (interest-in-location - {:home [{:x 35 :y 23}]} - [{:x 34 :y 24000}])] + {:home [{:x 35 :y 23}]} + [{:x 34 :y 24000}])] (is (= actual expected) "Too far apart (> 10000).")) (let [expected true actual (interesting-location? - {:knowledge [{:verb :steal - :actor :albert - :other :belinda - :object :foo - :location [{:x 35 :y 23} :auchencairn :galloway]}]} - :galloway)] + {:knowledge [{:verb :steal + :actor :albert + :other :belinda + :object :foo + :location [{:x 35 :y 23} :auchencairn :galloway]}]} + :galloway)] (is (= actual expected))) (let [expected true actual (interesting-location? - {:knowledge [{:verb :steal - :actor :albert - :other :belinda - :object :foo - :location [{:x 35 :y 23} :auchencairn :galloway]}]} - [:galloway :scotland])] + {:knowledge [{:verb :steal + :actor :albert + :other :belinda + :object :foo + :location [{:x 35 :y 23} :auchencairn :galloway]}]} + [:galloway :scotland])] (is (= actual expected))) (let [expected false actual (interesting-location? - {:knowledge [{:verb :steal - :actor :albert - :other :belinda - :object :foo - :location [{:x 35 :y 23} :auchencairn :galloway]}]} - [:dumfries])] + {:knowledge [{:verb :steal + :actor :albert + :other :belinda + :object :foo + :location [{:x 35 :y 23} :auchencairn :galloway]}]} + [:dumfries])] (is (= actual expected))) (let [expected true actual (interesting-location? - {:home [{:x 35 :y 23}]} - [{:x 34 :y 24}])] + {:home [{:x 35 :y 23}]} + [{:x 34 :y 24}])] (is (= actual expected))) (let [expected false actual (interesting-location? - {:home [{:x 35 :y 23}]} - [{:x 34 :y 240000}])] + {:home [{:x 35 :y 23}]} + [{:x 34 :y 240000}])] (is (= actual expected)))) (testing "Degrading locations" (let [expected [:galloway] actual (degrade-location - {:home [{0 0} :test-home :galloway]} - [{-4 55} :auchencairn :galloway])] + {:home [{0 0} :test-home :galloway]} + [{-4 55} :auchencairn :galloway])] (is (= actual expected))) (let [expected nil actual (degrade-location - {:home [{0 0} :test-home :galloway]} - [:froboz])] + {:home [{0 0} :test-home :galloway]} + [:froboz])] (is (= actual expected))))) (deftest inference-tests (testing "Ability to infer new knowledge from news items: single rule tests" (let [expected {:verb :marry, :actor :belinda, :other :adam} - actual (infer {:verb :marry :actor :adam :other :belinda} - {:verb :marry :actor :other :other :actor})] + item {:verb :marry :actor :adam :other :belinda} + rule {:verb :marry :actor :other :other :actor} + actual (infer item rule)] (is (= actual expected))) (let [expected {:verb :attack, :actor :adam, :other :belinda} - actual (infer {:verb :rape :actor :adam :other :belinda} - {:verb :attack})] + item {:verb :rape :actor :adam :other :belinda} + rule {:verb :attack} + actual (infer item rule)] (is (= actual expected))) (let [expected {:verb :sex, :actor :belinda, :other :adam} - actual (infer {:verb :rape :actor :adam :other :belinda} - {:verb :sex :actor :other :other :actor})] + item {:verb :rape :actor :adam :other :belinda} + rule {:verb :sex :actor :other :other :actor} + actual (infer item rule)] (is (= actual expected)))) (testing "Ability to infer new knowledge from news items: all applicable rules" - (let [expected #{{:verb :sex, :actor :belinda, :other :adam, :location nil, :nth-hand 1} - {:verb :sex, :actor :adam, :other :belinda, :location nil, :nth-hand 1} - {:verb :attack, :actor :adam, :other :belinda, :location nil, :nth-hand 1}} + (let [expected #{{:verb :sex, :actor :belinda, :other :adam, :location :test-home, :nth-hand 1} + {:verb :sex, :actor :adam, :other :belinda, :location :test-home, :nth-hand 1} + {:verb :attack, :actor :adam, :other :belinda, :location :test-home, :nth-hand 1}} ;; dates will not be and cannot be expected to be equal - actual (make-all-inferences - {:verb :rape :actor :adam :other :belinda :location :test-home}) - actual' (set (map #(dissoc % :time-stamp) actual))] - (is (= actual' expected))))) + actual (set (make-all-inferences + {:verb :rape :actor :adam :other :belinda :location :test-home :nth-hand 1}))] + (is (= actual expected))))) (deftest learn-tests (testing "Learning from an interesting news item." - (let [expected {:home [{0 0} :test-home], - :knowledge [{:verb :sex, :actor :adam, :other :belinda, :location nil, :nth-hand 1} - {:verb :sex, :actor :belinda, :other :adam, :location nil, :nth-hand 1}]} + (let [expected {:home [{0 0} :test-home] + :knowledge [{:verb :sex, :actor :adam, :other :belinda, :location [:test-home], :nth-hand 1} + {:verb :sex, :actor :belinda, :other :adam, :location [:test-home], :nth-hand 1}]} actual (learn-news-item - {:home [{0, 0} :test-home] :knowledge []} - {:verb :sex :actor :adam :other :belinda :location [:test-home]}) - actual' (assoc actual :knowledge (vec (map #(dissoc % :time-stamp) (:knowledge actual))))] - (is (= actual' expected))))) + {:home [{0, 0} :test-home] :knowledge []} + {:verb :sex :actor :adam :other :belinda :location [:test-home]})] + (is (= actual expected)))))