simon/the-great-game
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

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

4
test/cc/journeyman/the_great_game/gossip/gossip_test.clj Normal file
View file

@ -0,0 +1,4 @@
(ns cc.journeyman.the-great-game.gossip.gossip-test
(:require [clojure.test :refer :all]
[cc.journeyman.the-great-game.gossip.gossip :refer :all]))

135
test/cc/journeyman/the_great_game/gossip/news_items_test.clj Normal file
View file

@ -0,0 +1,135 @@
(ns cc.journeyman.the-great-game.gossip.news-items-test
(:require [clojure.test :refer :all]
[cc.journeyman.the-great-game.gossip.news-items :refer
[degrade-location infer interest-in-location interesting-location?
learn-news-item make-all-inferences]]))
(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)]
(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])]
(is (= actual expected)))
(let [expected 2
actual (interest-in-location
{: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])]
(is (= actual expected)))
(let [expected 7071.067811865475
actual (interest-in-location
{: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}])]
(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)]
(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])]
(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])]
(is (= actual expected)))
(let [expected true
actual (interesting-location?
{: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}])]
(is (= actual expected))))
(testing "Degrading locations"
(let [expected [:galloway]
actual (degrade-location
{: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])]
(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})]
(is (= actual expected)))
(let [expected {:verb :attack, :actor :adam, :other :belinda}
actual (infer {:verb :rape :actor :adam :other :belinda}
{:verb :attack})]
(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})]
(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}}
;; 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)))))
(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}]}
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)))))

109
test/cc/journeyman/the_great_game/merchants/markets_test.clj Normal file
View file

@ -0,0 +1,109 @@
(ns cc.journeyman.the-great-game.merchants.markets-test
(:require [clojure.test :refer :all]
[cc.journeyman.the-great-game.utils :refer [deep-merge]]
[cc.journeyman.the-great-game.world.world :refer [default-world]]
[cc.journeyman.the-great-game.merchants.markets :refer [adjust-quantity-and-price new-price run]]))
(deftest new-price-test
(testing "Adjustment of prices based on supply and demand"
(is (> (new-price 1 0 10 10) 1)
"If no stock but there is supply and demand, price should rise")
(is (> (new-price 1 0 0 10) 1)
"If no stock but there is demand, price should rise")
(is (> (new-price 1 5 0 10) 1)
"If there is insufficient stock to meet demand, price should rise")
(is (= (new-price 1 10 0 10) 1)
"If there is exactly sufficient stock to meet demand, price should not change")
(is (< (new-price 1 10 0 5) 1)
"If there is surplus stock beyond demand, price should fall")
(is (> (new-price 1 0 0 10) (new-price 1 5 0 10))
"The greater the relative undersupply, the more prices should rise")
(is (< (new-price 1 10 0 0)(new-price 1 10 0 5) 1)
"The greater the relative oversupply, the more prices should fall")
))
(deftest adjust-quantity-and-price-test
(testing "Adjustment in quantity and price: supply only."
(let [world (deep-merge
default-world
{:cities
{:falkirk
{:stock {:iron 0}
:supplies {:iron 12}}}})
actual (adjust-quantity-and-price world :falkirk :iron)]
(is
(=
(-> actual :cities :falkirk :stock :iron)
(-> world :cities :falkirk :supplies :iron))
"If stock is empty it should be topped up by supply amount."))
(let [world (deep-merge
default-world
{:cities
{:falkirk
{:stock {:iron 5}
:supplies {:iron 12}
:prices {:iron 0.9}}}})
actual (adjust-quantity-and-price world :falkirk :iron)]
(is
(=
(-> actual :cities :falkirk :stock :iron)
(-> world :cities :falkirk :supplies :iron))
"If stock is not empty and price is below cost, stock should be topped up only to supply amount."))
(let [world (deep-merge
default-world
{:cities
{:falkirk
{:stock {:iron 5}
:supplies {:iron 12}
:prices {:iron 1.1}}}})
actual (adjust-quantity-and-price world :falkirk :iron)]
(is
(=
(-> actual :cities :falkirk :stock :iron)
(+ (-> world :cities :falkirk :supplies :iron)
(-> world :cities :falkirk :stock :iron)))
"If stock is not empty and price is above cost, stock should be topped up by supply amount.")))
(testing "Adjustment in quantity and price: supply and demand."
(let [world (deep-merge
default-world
{:cities
{:falkirk
{:stock {:iron 10}
:demands {:iron 5}
:supplies {:iron 12}
:prices {:iron 1.1}}}})
actual (adjust-quantity-and-price world :falkirk :iron)]
(is
(=
(-> actual :cities :falkirk :stock :iron)
17)
"Stock should be topped up by the difference between the supply and
the demand amount."))))
(deftest run-test
(let [world (deep-merge
default-world
{:cities
{:aberdeen
{:stock {:fish 5}
:supplies {:fish 12}
:prices {:fish 1.1}}
:falkirk
{:stock {:iron 10}
:demands {:iron 5}
:supplies {:iron 12}
:prices {:iron 1.1}}}})
actual (run world)]
(is
(=
(-> actual :cities :aberdeen :stock :fish)
(+ (-> world :cities :aberdeen :supplies :fish)
(-> world :cities :aberdeen :stock :fish)))
"If stock is not empty and price is above cost, stock should be topped up by supply amount.")
(is
(=
(-> actual :cities :falkirk :stock :iron)
17)
"Stock should be topped up by the difference between the supply and
the demand amount.")))

128
test/cc/journeyman/the_great_game/merchants/merchant_utils_test.clj Normal file
View file

@ -0,0 +1,128 @@
(ns cc.journeyman.the-great-game.merchants.merchant-utils-test
(:require [clojure.test :refer :all]
[cc.journeyman.the-great-game.utils :refer [deep-merge]]
[cc.journeyman.the-great-game.world.world :refer [default-world]]
[cc.journeyman.the-great-game.merchants.merchant-utils :refer
[add-stock burden can-afford can-carry expected-price]]))
(deftest expected-price-test
(testing "Anticipated prices in markets"
(let [world (deep-merge
default-world
{:merchants
{:archie
{:known-prices
{:buckie
{:iron
[{:price 1.7 :date 1}
{:price 2 :date 0}]}}}}})]
(let [actual (expected-price (-> world :merchants :archie) :fish :edinburgh)
expected 1] ;;
(is (= actual expected) "if no information assume 1"))
(let [actual (expected-price (-> world :merchants :archie) :iron :buckie)
expected 1.7] ;;
(is (= actual expected) "if information select the most recent")))))
(deftest burden-test
(testing "Burden of merchant"
(let [world (deep-merge
default-world
{:merchants
{:archie
{:stock
{:iron 1}}
:belinda
{:stock
{:fish 2}}
:callum
{:stock
{:iron 1
:fish 1}}}})]
(let [actual (burden :archie world)
expected (-> world :commodities :iron :weight)]
(is (= actual expected)))
(let [actual (burden :belinda world)
expected (* 2 (-> world :commodities :fish :weight))]
(is (= actual expected)))
(let [actual (burden :callum world)
expected (+
(-> world :commodities :iron :weight)
(-> world :commodities :fish :weight))]
(is (= actual expected)))
(let [actual (burden {} world)
expected 0]
(is (= actual expected)))
(let [actual (burden (-> world :merchants :deidre) world)
expected 0]
(is (= actual expected))))))
(deftest can-carry-test
(testing "What merchants can carry"
(let [world (deep-merge
default-world
{:merchants
{:archie
{:cash 5
:stock
{:iron 1}}
:belinda
{:stock
{:fish 2}}
:callum
{:stock
{:iron 1
:fish 1}}}})]
(let [actual (can-carry :archie world :fish)
expected 0]
(is (= actual expected)))
(let [actual (can-carry :belinda world :fish)
expected 8]
(is (= actual expected)))
(let [actual (can-carry (-> world :merchants :archie) world :fish)
expected 0]
(is (= actual expected)))
(let [actual (can-carry {:stock {:fish 7} :capacity 10} world :fish)
expected 3]
(is (= actual expected))))))
(deftest affordability-test
(testing "What merchants can afford to purchase"
(let [world (deep-merge
default-world
{:merchants
{:archie
{:cash 5
:stock
{:iron 1}}
:belinda
{:stock
{:fish 2}}
:callum
{:stock
{:iron 1
:fish 1}}}})]
(let [actual (can-afford :archie world :fish)
expected 5]
(is (= actual expected)))
(let [actual (can-afford :belinda world :fish)
expected 100]
(is (= actual expected)))
(let [actual (can-afford (-> world :merchants :archie) world :fish)
expected 5]
(is (= actual expected)))
(let [actual (can-afford {:cash 3 :location :buckie} world :fish)
expected 3]
(is (= actual expected)))
(is (thrown-with-msg?
Exception
#"No merchant?"
(can-afford :no-one world :fish)))
(is (thrown-with-msg?
Exception
#"No known location for merchant.*"
(can-afford {:cash 3} world :fish))))))
(deftest add-stock-test
(let [actual (add-stock {:iron 2 :fish 5} {:fish 3 :whisky 7})
expected {:iron 2 :fish 8 :whisky 7}]))

92
test/cc/journeyman/the_great_game/merchants/planning_test.clj Normal file
View file

@ -0,0 +1,92 @@
(ns cc.journeyman.the-great-game.merchants.planning-test
(:require [clojure.test :refer :all]
[cc.journeyman.the-great-game.utils :refer [deep-merge]]
[cc.journeyman.the-great-game.world.world :refer [default-world]]
[cc.journeyman.the-great-game.merchants.planning :refer [plan-trade select-cargo]]))
(deftest plan-trade-test
(testing "Lower level trade planning"
(let [world (deep-merge
default-world
{:merchants
{:fiona
{:known-prices
{:aberdeen
{:iron
[{:price 1.5 :date 1}
{:price 1.3 :date 0}]}
:buckie
{:iron
[{:price 1.7 :date 1}
{:price 2 :date 0}]}}}}
:cities
{:falkirk
{:stock {:iron 20}}}})
actual (plan-trade :fiona world :iron)]
(is (= (:origin actual) :falkirk)
"Fiona is in Falkirk, so her plan must originate there")
(is (= (:commodity actual) :iron)
"Iron is the only thing available in Falkirk, so plan must carry iron")
(is (= (:destination actual) :buckie)
"Fiona believes Buckie offers the best price for iron, so should go there"))))
(deftest select-cargo-test
(testing "Top level single trade planning: single candidate commodity"
(let [world (deep-merge
default-world
{:merchants
{:fiona
{:known-prices
{:aberdeen
{:iron
[{:price 1.5 :date 1}
{:price 1.3 :date 0}]}
:buckie
{:iron
[{:price 1.7 :date 1}
{:price 2 :date 0}]}}}}
:cities
{:falkirk
{:stock {:iron 20}}}})
actual (select-cargo :fiona world)]
(is (= (:origin actual) :falkirk)
"Fiona is in Falkirk, so her plan must originate there")
(is (= (:commodity actual) :iron)
"Iron is the only thing available in Falkirk, so plan must carry iron")
(is (= (:destination actual) :buckie)
"Fiona believes Buckie offers the best price for iron, so should go there")
(is (= (:quantity actual) 1)
"Fiona can carry only one unit of iron.")
(is (= (:expected-profit actual) 0.7))))
(testing "Top level single trade planning: multiple candidate commodities"
(let [world (deep-merge
default-world
{:merchants
{:fiona
{:known-prices
{:aberdeen
{:iron
[{:price 1.5 :date 1}
{:price 1.3 :date 0}]
:whisky [{:price 4 :date 0}]}
:buckie
{:iron
[{:price 1.7 :date 1}
{:price 2 :date 0}]}}}}
:cities
{:falkirk
{:stock
{:iron 20
:whisky 50}}}})
actual (select-cargo :fiona world)]
(is (= (:origin actual) :falkirk)
"Fiona is in Falkirk, so her plan must originate there")
(is (= (:commodity actual) :whisky)
"Whisky has the higher profit, so plan must carry whisky")
(is (= (:destination actual) :aberdeen)
"Fiona believes Aberdeen offers the best price for whisky, so should go there")
(is (= (:quantity actual) 50)
"Fiona can carry 100 units of whisky, but only 50 are available.")
(is (= (:expected-profit actual) 150)))))

81
test/cc/journeyman/the_great_game/time_test.clj Normal file
View file

@ -0,0 +1,81 @@
(ns cc.journeyman.the-great-game.time-test
(:require [clojure.test :refer :all]
;; [clojure.core.async :refer [thread <!]]
[cc.journeyman.the-great-game.time :refer
[date-string day days-in-season days-in-week game-day-length
game-time game-start-time now season week]]))
(deftest now-tests
(testing "Time progresses"
(let [t1 (now)]
(is (> t1 game-start-time))
(Thread/sleep 1000)
(is (> (now) t1)))))
(deftest game-time-tests
(testing "Getting game-time"
(is (= (game-time (inc game-start-time)) 1))))
(deftest calendar-tests
(testing "In-game calendar functions"
(let [expected :foot
actual (day 0)]
(is (= actual expected)))
(let [expected :stomach
actual (day (* 5 game-day-length))]
(is (= actual expected)))
(let [expected :foot
actual (day (* days-in-week game-day-length))]
(is (= actual expected)))
(let [expected :first ;; waiting day
actual (day (* 360 game-day-length))]
(is (= actual expected)))
(let [expected :first
actual (week 0)]
(is (= actual expected)))
(let [expected :second
actual (week (* days-in-week game-day-length))]
(is (= actual expected)))
(let [expected :first
actual (week (* days-in-season game-day-length))]
(is (= actual expected)))
(let [expected :foot
actual (season 0)]
(is (= actual expected)))
(let [expected :mouth
actual (season (* 180 game-day-length))]
(is (= actual expected)))
(let [expected :eye
actual (season (* 359 game-day-length))]
(is (= actual expected)))
(let [expected :waiting
actual (season (* 360 game-day-length))]
(is (= actual expected)))
(let [expected :foot
actual (season (* 365 game-day-length))]
(is (= actual expected)))))
(deftest date-string-tests
(testing "Date-string formatting"
(let [expected "First Foot of the Foot"
actual (date-string 0)]
(is (= actual expected)))
(let [expected "First Foot of the Nose"
actual (date-string
(* days-in-season game-day-length))]
(is (= actual expected)))
(let [expected "Third Mouth of the Mouth"
actual (date-string (* 180 game-day-length))]
(is (= actual expected)))
(let [expected "Fifth Plough of the Eye"
actual (date-string (* 359 game-day-length))]
(is (= actual expected)))
(let [expected "First waiting day"
actual (date-string (* 360 game-day-length))]
(is (= actual expected)))
(let [expected "First Foot of the Foot"
actual (date-string (* 365 game-day-length))]
(is (= actual expected)))))

12
test/cc/journeyman/the_great_game/utils_test.clj Normal file
View file

@ -0,0 +1,12 @@
(ns cc.journeyman.the-great-game.utils-test
(:require [clojure.test :refer :all]
[cc.journeyman.the-great-game.utils :refer [cyclic?]]))
(deftest cyclic-tests
(testing "Detecting cyclic routes"
(let [actual (cyclic? '(:glasgow :edinburgh :glasgow))
expected true]
(is (= actual expected)))
(let [actual (cyclic? '(:edinburgh :dundee :aberdeen :buckie))
expected false]
(is (= actual expected)))))

36
test/cc/journeyman/the_great_game/world/location_test.clj Normal file
View file

@ -0,0 +1,36 @@
(ns cc.journeyman.the-great-game.world.location-test
(:require [clojure.test :refer :all]
[cc.journeyman.the-great-game.world.location :refer :all]))
(deftest get-coords-test
(testing "Get coordinates of location"
(let [expected {:x 5 :y 7}
actual (get-coords {:x 5 :y 7})]
(is (= actual expected)))
(let [expected {:x -4 :y 55}
actual (get-coords [{:x -4 :y 55} :auchencairn :galloway :scotland])]
(is (= actual expected)))
(let [expected nil
actual (get-coords [:auchencairn :galloway :scotland])]
(is (= actual expected)))
))
(deftest distance-test
(testing "Distance between two locations"
(let [expected 4.242640687119285
actual (distance-between {:x 5 :y 5} {:x 2 :y 2})]
(is (= actual expected)))
(let [expected 3
actual (distance-between {:x 5 :y 5} {:x 2 :y 5})]
(is (= actual expected)))
(let [expected 50.80354318352215
actual (distance-between
{:x 5 :y 5}
[{:x -4 :y 55} :auchencairn :galloway :scotland])]
(is (= actual expected)))
(let [expected nil
actual (distance-between
{:x 5 :y 5}
[:auchencairn :galloway :scotland])]
(is (= actual expected)))
))

33
test/cc/journeyman/the_great_game/world/routes_test.clj Normal file
View file

@ -0,0 +1,33 @@
(ns cc.journeyman.the-great-game.world.routes-test
(:require [clojure.test :refer :all]
[cc.journeyman.the-great-game.world.routes :refer :all]
[cc.journeyman.the-great-game.world.world :refer [default-world]]))
(deftest routing-test
(testing "Routing: possible route"
(let [origin :buckie
destination :glasgow
routes (find-routes (:routes default-world) origin destination)]
(is
(= (first (first routes)) origin)
"Routes should be from the specified origin")
(is
(= (last (first routes)) destination)
"Routes should be from the specified destination")
(is
(= (count (set (map first routes))) 1)
"All routes should have the same origin")
(is
(= (count (set (map last routes))) 1)
"All routes should have the same destination")
(is
(= (count (set (map count routes))) 1)
"All selected routes should have the same length")
))
(testing "Impossible route"
(let [origin :buckie
destination :london ;; not present in the routing map
actual (find-routes (:routes default-world) origin destination)]
(is (nil? actual) "There should be no route returned."))))

4
test/cc/journeyman/the_great_game/world/world_test.clj Normal file
View file

@ -0,0 +1,4 @@
(ns cc.journeyman.the-great-game.world.world-test
(:require [clojure.test :refer :all]
[cc.journeyman.the-great-game.world.world :refer :all]))