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

Working on unit tests.

Browse source
This commit is contained in:
Simon Brooke 2021-06-09 20:20:52 +01:00
parent 2461319e57
commit 23032c586c
No known key found for this signature in database
GPG key ID: A7A4F18D1D4DF987
28 changed files with 6602 additions and 207 deletions
Download patch file Download diff file Expand all files Collapse all files

172
test/cc/journeyman/the_great_game/gossip/news_items_test.clj
View file

@ -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)))))