Improved debugging, and lots more tests. Ultimately I intend the
enhanced debugging to be optional, because it will have a performance hit
This commit is contained in:
parent
24d76dff2c
commit
d23239a5c6
|
@ -6,5 +6,6 @@
|
|||
:plugins [[lein-marginalia "0.7.1"]]
|
||||
:dependencies [[org.clojure/clojure "1.5.1"]
|
||||
[org.clojure/math.combinatorics "0.0.7"]
|
||||
[org.clojure/tools.trace "0.7.8"]
|
||||
[net.mikera/imagez "0.3.1"]
|
||||
[fivetonine/collage "0.2.0"]])
|
||||
|
|
|
@ -26,11 +26,37 @@
|
|||
;; rules are applied in turn until one matches. Once one rule has matched no
|
||||
;; further rules can be applied.
|
||||
|
||||
|
||||
(defn apply-rule
|
||||
"Apply a single rule to a cell. What this is about is that I want to be able,
|
||||
for debugging purposes, to tag a cell with the rule text of the rule which
|
||||
fired (and especially so when an exception is thrown. So a rule may be either
|
||||
an ifn, or a list (ifn source-text). This function deals with despatching
|
||||
on those two possibilities."
|
||||
([cell world rule]
|
||||
(cond
|
||||
(ifn? rule) (apply-rule cell world rule nil)
|
||||
(seq? rule) (let [[afn src] rule] (apply-rule cell world afn src))))
|
||||
;; {:afn afn :src src})))
|
||||
;; (apply-rule cell world (first rule) (first (rest rule)))))
|
||||
([cell world rule source]
|
||||
(try
|
||||
(let [result (apply rule (list cell world))]
|
||||
(cond
|
||||
(and result source) (merge result {:rule source})
|
||||
true result))
|
||||
(catch Exception e
|
||||
(merge cell {:error (format "%s at generation %d when in state %s"
|
||||
(.getMessage e)
|
||||
(:generation cell)
|
||||
(:state cell))
|
||||
:error-rule source})))))
|
||||
|
||||
(defn- apply-rules
|
||||
"Derive a cell from this cell of this world by applying these rules."
|
||||
[cell world rules]
|
||||
(cond (empty? rules) cell
|
||||
true (let [result (apply (eval (first rules)) (list cell world))]
|
||||
true (let [result (apply-rule cell world (first rules))]
|
||||
(cond result result
|
||||
true (apply-rules cell world (rest rules))))))
|
||||
|
||||
|
|
|
@ -2,6 +2,23 @@
|
|||
(:require [clojure.test :refer :all]
|
||||
[mw-engine.core :refer :all]))
|
||||
|
||||
(deftest a-test
|
||||
(testing "FIXME, I fail."
|
||||
(is (= 0 0))))
|
||||
(deftest apply-rule-test
|
||||
(testing "Application of a single rule"
|
||||
(let [afn (eval
|
||||
(fn [cell world]
|
||||
(cond
|
||||
(= (:state cell) :new)
|
||||
(merge cell {:state :grassland}))))
|
||||
pair (list afn "Test source")]
|
||||
(is (nil? (apply-rule {:state :water} nil afn))
|
||||
"Rule shouldn't fire when state is wrong")
|
||||
(is (nil? (apply-rule {:state :water} nil pair))
|
||||
"Rule shouldn't fire when state is wrong")
|
||||
(is (= (:state (apply-rule {:state :new} nil afn)) :grassland)
|
||||
"Rule should fire when state is correct")
|
||||
(is (= (:state (apply-rule {:state :new} nil pair)) :grassland)
|
||||
"Rule should fire when state is correct")
|
||||
(is (nil? (:rule (apply-rule {:state :new} nil afn)))
|
||||
"No rule text if not provided")
|
||||
(is (= (:rule (apply-rule {:state :new} nil pair)) "Test source")
|
||||
"Rule text cached on cell if provided"))))
|
69
test/mw_engine/utils_test.clj
Normal file
69
test/mw_engine/utils_test.clj
Normal file
|
@ -0,0 +1,69 @@
|
|||
(ns mw-engine.utils-test
|
||||
(:use [mw-engine.core :as core]
|
||||
[mw-engine.world :as world]
|
||||
[mw-engine.heightmap :as height]
|
||||
[mw-engine.natural-rules :as rules])
|
||||
(:require [clojure.test :refer :all]
|
||||
[mw-engine.utils :refer :all]))
|
||||
|
||||
(deftest get-neighbours-test
|
||||
(testing "Gross functionality of get-neighbours: checks the right number of
|
||||
neighbours returned, doesn't actually check they're the right ones."
|
||||
(let [world (make-world 9 9)
|
||||
corner (get-cell world 0 0)
|
||||
midside (get-cell world 0 4)
|
||||
centre (get-cell world 4 4)]
|
||||
(is (= (count (get-neighbours world corner 1)) 3))
|
||||
(is (= (count (get-neighbours world midside 1)) 5))
|
||||
(is (= (count (get-neighbours world centre 1)) 8))
|
||||
(is (= (count (get-neighbours world corner 2)) 8))
|
||||
(is (= (count (get-neighbours world midside 2)) 14))
|
||||
(is (= (count (get-neighbours world centre 2)) 24))
|
||||
(is (= (count (get-neighbours world corner 3)) 15))
|
||||
(is (= (count (get-neighbours world midside 3)) 27))
|
||||
(is (= (count (get-neighbours world centre 3)) 48))
|
||||
(is (= (count (get-neighbours world corner 4)) 24))
|
||||
(is (= (count (get-neighbours world midside 4)) 44))
|
||||
(is (= (count (get-neighbours world centre 4)) 80))
|
||||
)))
|
||||
|
||||
|
||||
(deftest get-neighbours-with-property-value-test
|
||||
(testing "Testing the action of the over-complicated utility function"
|
||||
(let [world '(({ :altitude 13, :x 0, :y 0, }
|
||||
{ :altitude 20, :x 1, :y 0, }
|
||||
{ :altitude 29, :x 2, :y 0, }
|
||||
{ :altitude 39, :x 3, :y 0, }
|
||||
{ :altitude 51, :x 4, :y 0, })
|
||||
({ :altitude 19, :x 0, :y 1, }
|
||||
{ :altitude 29, :x 1, :y 1, }
|
||||
{ :altitude 41, :x 2, :y 1, }
|
||||
{ :altitude 55, :x 3, :y 1, }
|
||||
{ :altitude 72, :x 4, :y 1, })
|
||||
({ :altitude 27, :x 0, :y 2, }
|
||||
{ :altitude 41, :x 1, :y 2, }
|
||||
{ :altitude 55, :x 2, :y 2, }
|
||||
{ :altitude 72, :x 3, :y 2, }
|
||||
{ :altitude 91, :x 4, :y 2, })
|
||||
({ :altitude 33, :x 0, :y 3, }
|
||||
{ :altitude 47, :x 1, :y 3, }
|
||||
{ :altitude 68, :x 2, :y 3, }
|
||||
{ :altitude 91, :x 3, :y 3, }
|
||||
{ :altitude 111, :x 4, :y 3, })
|
||||
({ :altitude 36, :x 0, :y 4, }
|
||||
{ :altitude 53, :x 1, :y 4, }
|
||||
{ :altitude 75, :x 2, :y 4, }
|
||||
{ :altitude 100, :x 3, :y 4, }
|
||||
{ :altitude 123, :x 4, :y 4, }))]
|
||||
(is (= (get-neighbours-with-property-value world 3 3 1 :altitude 100 >)
|
||||
'({ :altitude 111, :x 4, :y 3, }
|
||||
{ :altitude 123, :x 4, :y 4, })))
|
||||
(is (= (get-neighbours-with-property-value world 3 3 1 :altitude 100 <)
|
||||
'({ :altitude 55, :x 2, :y 2, }
|
||||
{ :altitude 68, :x 2, :y 3, }
|
||||
{ :altitude 75, :x 2, :y 4, }
|
||||
{ :altitude 72, :x 3, :y 2, }
|
||||
{ :altitude 91, :x 4, :y 2, })))
|
||||
(is (= (get-neighbours-with-property-value world 3 3 1 :altitude 100)
|
||||
'({ :altitude 100, :x 3, :y 4, }))))))
|
||||
|
28
test/mw_engine/world_test.clj
Normal file
28
test/mw_engine/world_test.clj
Normal file
|
@ -0,0 +1,28 @@
|
|||
(ns mw-engine.world-test
|
||||
(:require [clojure.test :refer :all]
|
||||
[mw-engine.world :refer :all]
|
||||
[clojure.math.combinatorics :as combo]))
|
||||
|
||||
(deftest genesis-test
|
||||
(testing "World creation."
|
||||
(is
|
||||
(empty?
|
||||
(remove
|
||||
true?
|
||||
(flatten
|
||||
(map
|
||||
(fn [size]
|
||||
(let [world (make-world size size)]
|
||||
(is (= (count world) size)
|
||||
"World should be NxN matrix")
|
||||
(is (empty? (remove #(= % size) (map count world)))
|
||||
"World should be NxN matrix")
|
||||
(map #(let [[x y] %
|
||||
cell (nth (nth world y) x)]
|
||||
(is (= (:x cell) x) "Checking x coordinate")
|
||||
(is (= (:y cell) y) "Checking y coordinate")
|
||||
(is (= (:state cell) :new) "Checking state is new"))
|
||||
(combo/cartesian-product (range size) (range size)))
|
||||
))
|
||||
(range 1 10)))))
|
||||
"Comprehensive new world test")))
|
Loading…
Reference in a new issue