diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/constants.fnl | 91 | ||||
| -rw-r--r-- | lib/contains.test.fnl | 28 | ||||
| -rw-r--r-- | lib/either.test.fnl | 81 | ||||
| -rw-r--r-- | lib/equal.fnl | 22 | ||||
| -rw-r--r-- | lib/equal.test.fnl | 28 | ||||
| -rw-r--r-- | lib/flip.fnl | 6 | ||||
| -rw-r--r-- | lib/flip.test.fnl | 13 | ||||
| -rw-r--r-- | lib/head.test.fnl | 23 | ||||
| -rw-r--r-- | lib/index.fnl | 26 | ||||
| -rw-r--r-- | lib/keys.fnl | 7 | ||||
| -rw-r--r-- | lib/keys.test.fnl | 13 | ||||
| -rw-r--r-- | lib/mill.fnl | 57 | ||||
| -rw-r--r-- | lib/mill.test.fnl | 142 | ||||
| -rw-r--r-- | lib/slice.fnl | 5 | ||||
| -rw-r--r-- | lib/slice.test.fnl | 19 | ||||
| -rw-r--r-- | lib/tail.test.fnl | 20 | ||||
| -rw-r--r-- | lib/test.fnl | 52 | ||||
| -rw-r--r-- | lib/test.test.fnl | 19 |
18 files changed, 564 insertions, 88 deletions
diff --git a/lib/constants.fnl b/lib/constants.fnl new file mode 100644 index 0000000..c88b279 --- /dev/null +++ b/lib/constants.fnl @@ -0,0 +1,91 @@ +(local neighbors + [ + [1 2 10] + [2 1 3 5] + [3 2 15] + [4 5 11] + [5 2 4 6 8] + [6 5 14] + [7 8 12] + [8 5 7 9] + [9 8 13] + [10 1 11 22] + [11 4 10 12 19] + [12 7 11 16] + [13 9 14 18] + [14 6 13 15 21] + [15 3 14 24] + [16 12 17] + [17 16 18 20] + [18 13 17] + [19 11 20] + [20 17 19 21 23] + [21 14 20] + [22 10 23] + [23 20 22 24] + [24 15 23] + ]) + +(local mills + [ + [1 2 3] + [4 5 6] + [7 8 9] + [10 11 12] + [13 14 15] + [16 17 18] + [19 20 21] + [22 23 24] + [1 10 22] + [4 11 19] + [7 12 16] + [2 5 8] + [17 20 23] + [9 13 18] + [6 14 21] + [3 15 24] + ]) + +; these are the only moves that are valid +; i am somewhat bothered by all the wasted space +; by 2-3A and 5-6A e.g. +; Incidentally these are all in order of appearance +; so when you find a match, +; you can also update that index of `moves` to the current player number +(local spaces [ + "1A" "4A" "7A" + "2B" "4B" "6B" + "3C" "4C" "5C" + "1D" "2D" "3D" + "5D" "6D" "7D" + "3E" "4E" "5E" + "2F" "4F" "6F" + "1G" "4G" "7G" + ]) + +; This is what the game board looks like +; it's also used to display the state of the game +; the Xs are converted to "%d" later for string templating +; they are Xs here so that it looks pretty =) +(local board [ + " 1 2 3 4 5 6 7" + "A x-----x-----x" ;; 1 2 3 + " | | |" ;; + "B | x---x---x |" ;; 4 5 6 + " | | | | |" ;; + "C | | x-x-x | |" ;; 7 8 9 + " | | | | | |" ;; + "D x-x-x x-x-x" ;; 10 11 12 13 14 15 + " | | | | | |" ;; + "E | | x-x-x | |" ;; 16 17 18 + " | | | | |" ;; + "F | x---x---x |" ;; 19 20 21 + " | | |" ;; + "G x-----x-----x" ;; 22 23 24 + ]) + +{: board + : mills + : neighbors + : spaces} + diff --git a/lib/contains.test.fnl b/lib/contains.test.fnl index 1c7fb06..45a00af 100644 --- a/lib/contains.test.fnl +++ b/lib/contains.test.fnl @@ -1,11 +1,17 @@ -(let [{: contains } (require :lib.contains)] - (let [given "a list and an element it contains" - should "returns true" - expected true - actual (contains [:apple :orange :pear] :apple)] - (assert (= actual expected) (.. "Given " given " should " should))) - (let [given "a list and an element it does not contain" - should "returns false" - expected false - actual (contains [:apple :orange :pear] :gorilla)] - (assert (= actual expected) (.. "Given " given " should " should)))) +(let [{: contains } (require :lib.contains) + {: describe } (require :lib.test) + {: describe :end test-end} (require :lib.test) + ] + + (describe "contains()" (fn [t] + (t {:given "a list and an element it contains" + :should "returns true" + :expected true + :actual (contains [:apple :orange :pear] :apple)} + ) + (t {:given "a list and an element it does not contain" + :should "returns false" + :expected false + :actual (contains [:apple :orange :pear] :gorilla) + }) + (test-end)))) diff --git a/lib/either.test.fnl b/lib/either.test.fnl index fc819dc..8ae0c08 100644 --- a/lib/either.test.fnl +++ b/lib/either.test.fnl @@ -1,40 +1,41 @@ -(local {: pprint} (require :lib.tableprint)) - -(let [{ - : Either - : Left - : Right - } (require :lib.either)] - - ;; either - ;(print "Either Inspection") - ;(pprint Either) - - ;; you can set and get values - (let [ v :poop x (Either:new v)] - (assert (= v x.value) (.. "The value is " v))) - - (let [r (Right:new "rain") - map (r:map #(.. "b" $1)) - expected :brain - actual (. map :value) - ] - (assert (= expected actual) "You can map a Right value")) - - (let [l (Left:new "rain") - map (l:map #(.. "b" $1)) - expected :rain - actual (. map :value) - ] - (assert (= expected actual) "You can NOT map a Left value")) - - (let [e (Either.of "rank") - map (e:map #(.. "f" $1)) - expected :frank - actual (. map :value) - ] - (assert (= expected actual) "You can map a Either.of")) - - - -) +(let [{: pprint} (require :lib.tableprint) + {: describe :end test-end} (require :lib.test) + {: Either : Left : Right } (require :lib.either)] + (describe "Either" (fn [t] + (t {:given "a new either" + :should "set its value correctly" + :expected :poop + :actual (. (Either:new :poop) :value) + }) + (t + (let [r (Right:new "rain") + map (r:map #(.. "b" $1)) + expected :brain + actual (. map :value)] + {:given "a Right of some value" + :should "map" + expected + actual + })) + (t + (let [ l (Left:new "rain") + map (l:map #(.. "b" $1)) + expected :rain + actual (. map :value) + ] + {:given "a Left of some value" + :should "not map" + expected + actual + })) + (t + (let [ e (Either.of "rank") + map (e:map #(.. "f" $1)) + expected :frank + actual (. map :value) ] + {:given "Either.of" + :should "map" + expected + actual + })) + (test-end)))) diff --git a/lib/equal.fnl b/lib/equal.fnl new file mode 100644 index 0000000..cc34ada --- /dev/null +++ b/lib/equal.fnl @@ -0,0 +1,22 @@ +;; thanks: +;; https://gist.github.com/sapphyrus/fd9aeb871e3ce966cc4b0b969f62f539 +;; and antifennel +(fn deep-equals [o1 o2 ignore-mt] + (when (= o1 o2) (lua "return true")) + (local o1-type (type o1)) + (local o2-type (type o2)) + (when (not= o1-type o2-type) (lua "return false")) + (when (not= o1-type :table) (lua "return false")) + (when (not ignore-mt) + (local mt1 (getmetatable o1)) + (when (and mt1 mt1.__eq) + (let [___antifnl_rtn_1___ (= o1 o2)] (lua "return ___antifnl_rtn_1___")))) + (each [key1 value1 (pairs o1)] + (local value2 (. o2 key1)) + (when (or (= value2 nil) (= (deep-equals value1 value2 ignore-mt) false)) + (lua "return false"))) + (each [key2 _ (pairs o2)] + (when (= (. o1 key2) nil) (lua "return false"))) + true) + +{:equal deep-equals} diff --git a/lib/equal.test.fnl b/lib/equal.test.fnl new file mode 100644 index 0000000..0ee8da7 --- /dev/null +++ b/lib/equal.test.fnl @@ -0,0 +1,28 @@ +(let [{: equal} (require :lib.equal) + {: describe :end test-end} (require :lib.test)] + (describe "equal()" (fn [t] + (t {:given "two equal tables" + :should "return true" + :expected true + :actual (equal [:orange :apple :pear] [:orange :apple :pear]) }) + (t {:given "two different tables" + :should "return false" + :expected false + :actual (equal [:apple :pear] [:orange :apple :pear]) }) + (t {:given "equal strings" + :should "be true" + :expected true + :actual (equal :apple :apple) }) + (t {:given "different strings" + :should "be false" + :expected false + :actual (equal :apple :pear) }) + (t {:given "equal bools" + :should "be true" + :expected true + :actual (equal true true) }) + (t {:given "different strings" + :should "be false" + :expected false + :actual (equal true false) }) + (test-end)))) diff --git a/lib/flip.fnl b/lib/flip.fnl new file mode 100644 index 0000000..9d21b63 --- /dev/null +++ b/lib/flip.fnl @@ -0,0 +1,6 @@ +(fn flip [t] + "takes a table of {key value} and returns a table of {value key}" + (collect [k v (pairs t)] (values v k))) + +{: flip} + diff --git a/lib/flip.test.fnl b/lib/flip.test.fnl new file mode 100644 index 0000000..32fa005 --- /dev/null +++ b/lib/flip.test.fnl @@ -0,0 +1,13 @@ +(let [{: flip} (require :lib.flip) + {: describe :end test-end} (require :lib.test)] + (describe "flip()" (fn [t] + (let [input {:apple "red" :banana "yellow"} + expected {:red "apple" :yellow "banana"} + ] + (t {:given "a table" + :should "flip that table!" + : expected + :actual (flip input)}) + (test-end))))) + + diff --git a/lib/head.test.fnl b/lib/head.test.fnl index 7514121..1209599 100644 --- a/lib/head.test.fnl +++ b/lib/head.test.fnl @@ -1,11 +1,12 @@ -(let [{: head } (require :lib.head)] - (let [given "a lift of elements" - it "returns the first element of a list" - expected :apple - actual (head [:apple :orange :pear])] - (assert (= actual expected) (.. "Given " given " it " it))) - (let [given "an empty list" - it "returns an empty list" - expected 0 - actual (length (head []))] - (assert (= actual expected) (.. "Given " given " it " it)))) +(let [{: head} (require :lib.head) + {: describe :end test-end} (require :lib.test)] + (describe "head()" (fn [t] + (t {:given "a list of elements" + :should "returns the first element of a list" + :expected :apple + :actual (head [:apple :orange :pear])}) + (t {:given "an empty list" + :should "returns an empty list" + :expected 0 + :actual (length (head []))}) + (test-end)))) diff --git a/lib/index.fnl b/lib/index.fnl index 4d15b9a..7579a1d 100644 --- a/lib/index.fnl +++ b/lib/index.fnl @@ -1,13 +1,19 @@ -(local {:contains contains} (require :lib.contains)) -(local {:head head} (require :lib.head)) -(local {:mill? mill?} (require :lib.mill)) -(local {:pprint pprint} (require :lib.tableprint)) -(local {:tail tail} (require :lib.tail)) +(local {: contains} (require :lib.contains)) +(local {: flip} (require :lib.flip)) +(local {: head} (require :lib.head)) +(local {: keys} (require :lib.keys)) +(local {: mill?} (require :lib.mill)) +(local {: pprint} (require :lib.tableprint)) +(local {: slice} (require :lib.slice)) +(local {: tail} (require :lib.tail)) { - :contains contains - :head head - :mill? mill? - :pprint pprint - :tail tail + : contains + : flip + : head + : keys + : mill? + : pprint + : slice + : tail } diff --git a/lib/keys.fnl b/lib/keys.fnl new file mode 100644 index 0000000..0f3364a --- /dev/null +++ b/lib/keys.fnl @@ -0,0 +1,7 @@ +(fn keys [t] + "takes a table returns a sequential list of its keys" + (local out []) + (each [k v (pairs t)] (table.insert out k)) + out) + +{: keys} diff --git a/lib/keys.test.fnl b/lib/keys.test.fnl new file mode 100644 index 0000000..413a773 --- /dev/null +++ b/lib/keys.test.fnl @@ -0,0 +1,13 @@ +(let [{: keys} (require :lib.keys) + {: describe :end test-end} (require :lib.test)] + (describe "keys()" (fn [t] + (let [input {:apple :red :banana :yellow} + actual (keys input) + sorted (table.sort actual) ;; SIDE EFFECT!! + ] + (t {:given "a table" + :should "returns a list of keys" + :expected [:apple :banana] + : actual}) + (test-end))))) + diff --git a/lib/mill.fnl b/lib/mill.fnl index de54128..e3b3337 100644 --- a/lib/mill.fnl +++ b/lib/mill.fnl @@ -1,16 +1,45 @@ (local {: contains} (require :lib.contains)) -;; Does this move result in a mill? -(fn mill? [rules state move] - (let [candidates (icollect [_ mill (ipairs rules)] (if (contains mill move) mill)) - candidate->moves (icollect [_ spaces (ipairs candidates)] - (icollect [_ space (ipairs spaces)] (. state space)) ) - candidate-mill? (icollect [_ moves (ipairs candidate->moves)] - (accumulate [acc true - idx m (ipairs moves)] - (and acc (not= 0 m) (= (. moves idx) m)))) ] - (accumulate [acc true - _ x (ipairs candidate-mill?)] - (and acc x)))) - -{: mill?} + +(fn get-candidates [all-mills next-move] + "a list of mills that contain next-move" + (icollect [_ mill (ipairs all-mills)] (if (contains mill next-move) mill))) + +(fn candidates->moves [candidates current-moves move player] + "a list of the candidate mills expressed as current moves" + (icollect [_ spaces (ipairs candidates)] + (icollect [_ space (ipairs spaces)] + (if (= space move) :x (. current-moves space))))) + +(fn moves->mills [spaces player] + "a list of bools if the candidate moves + player are all the same" + (let [next-move (icollect [_ y (ipairs spaces)] + (icollect [_ x (ipairs y)] + (if (= x :x) player x))) ] + (icollect [_ move (ipairs next-move)] + (accumulate [acc true + idx m (ipairs move)] + (and acc (= player m)))))) + +(fn any [t] + (accumulate [acc false + i x (ipairs t)] + (or acc x))) + + +(fn mill? [all-mills current-moves next-move player] + "Does the current move for the current player create a mill?" + (let [candidates (get-candidates all-mills next-move) + moves (candidates->moves candidates current-moves next-move player) + mills (moves->mills moves player) + result (any mills)] + result)) + +{: mill? + ;; not for consumption, + ;; just for testing: + : get-candidates + : candidates->moves + : moves->mills + : any + } diff --git a/lib/mill.test.fnl b/lib/mill.test.fnl index 358b218..8bd3522 100644 --- a/lib/mill.test.fnl +++ b/lib/mill.test.fnl @@ -1 +1,141 @@ -;; TODO: test me +(let [{: describe + :end test-end} (require :lib.test) + {: mill? + : get-candidates + : candidates->moves + : moves->mills + : any + } (require :lib.mill) + {: mills } (require :lib.constants) + with-mills (partial mill? mills)] + + + (describe "Mill" (fn [] + (describe "#get-candidates()" (fn [t] + (t + (let [move 3 + expected [[1 2 3] [3 15 24]] + moves [ 1 1 0 2 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 ] + ] + {:given (string.format "a move of %d" move) + :should "return [[1 2 3] [3 15 24]]" + : expected + :actual (get-candidates mills move) + })) + (t + (let [move 1 + expected [[1 2 3] [1 10 22]] + moves [ 0 0 0 ] + ] + {:given (string.format "a move of %d" move) + :should "return [[1 2 3] [1 10 22]]" + : expected + :actual (get-candidates mills move) + })))) + + + (describe "#candidates->moves()" (fn [t] + (t + (let [candidates [[1 2 3] [1 10 22]] + moves [0 1 1 0 0 0 0 0 0 2 0 0 0 0 0 0 0 0 0 0 0 2] + expected [[:x 1 1] [:x 2 2]] + move 1 + player 2 + ] + {:given "a list of spaces and of current moves" + :should "return a map of spaces to moves" + : expected + :actual (candidates->moves candidates moves move player) + })) + (t + (let [candidates [[1 2 3] [3 15 24]] + moves [ 1 1 0 2 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 ] + expected [[1 1 :x] [:x 0 0]] + move 3 + player 1 + ] + {:given "a list of candidates and of current moves" + :should "return an x-map of spaces to moves" + : expected + :actual (candidates->moves candidates moves move player) + })))) + + + (describe "#moves->mills()" (fn [t] + (t + (let [spaces [[:x 1 1] [:x 2 2]] + moves [0 1 1 0 0 0 0 0 0 2 0 0 0 0 0 0 0 0 0 0 0 2] + player 2 + ] + {:given "a list of spaces and of current moves" + :should "return a map of spaces to moves" + :expected [false true] + :actual (moves->mills spaces player) + })) + (t + (let [spaces [[1 1 :x] [:x 0 0]] + moves [ 1 1 0 2 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 ] + player 1 + ] + {:given "a list of canditate-moves and of current moves" + :should "return a map of spaces to moves" + :expected [true false] + :actual (moves->mills spaces player) + })))) + + + (describe "#any()" (fn [t] + (t {:given "a table of false false true" + :should "return true" + :expected true + :actual (any [false false true]) + }) + (t {:given "a table of true false" + :should "return true" + :expected true + :actual (any [true false]) + }) + (t {:given "a single false" + :should "return false" + :expected false + :actual (any [false]) + }) + (t {:given "a single true" + :should "return true" + :expected true + :actual (any [true]) + }))) + + + (describe "#mill?()" (fn [t] + (t + (let [move 1 + player 1 + moves [0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0] + with-moves (partial with-mills moves)] + {:given (string.format "a move of P%d:%d with moves %s" player move (table.concat moves ",")) + :should "not be a mill" + :expected false + :actual (with-moves move player) + })) + (t + (let [move 3 + player 1 + moves [1 1 0] + with-moves (partial with-mills moves)] + {:given (string.format "a move of P%d:%d with moves %s" player move (table.concat moves ",")) + :should "be a mill" + :expected true + :actual (with-moves move player) + })) + (t + (let [move 3 + player 1 + moves [ 1 1 0 2 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 ] + with-moves (partial with-mills moves)] + {:given (string.format "a move of P%d:%d with moves %s" player move (table.concat moves ",")) + :should "be a mill" + :expected true + :actual (with-moves move player) + })))) + (test-end)))) diff --git a/lib/slice.fnl b/lib/slice.fnl new file mode 100644 index 0000000..4f0de0f --- /dev/null +++ b/lib/slice.fnl @@ -0,0 +1,5 @@ +(fn slice [t start stop] + (fcollect [i start (or stop (length t))] + (. t i))) + +{: slice} diff --git a/lib/slice.test.fnl b/lib/slice.test.fnl new file mode 100644 index 0000000..9293f93 --- /dev/null +++ b/lib/slice.test.fnl @@ -0,0 +1,19 @@ +(let [{: slice} (require :lib.slice) + {: describe :end test-end} (require :lib.test)] + (describe "slice()" (fn [t] + (t + (let [t [:apple :orange :pear :banana :strawberry] + ] + {:given "a list of elements and a start" + :should "return the list starting at start" + :expected [:orange :pear :banana :strawberry] + :actual (slice t 2)})) + (t + (let [t [:apple :orange :pear :banana :strawberry] + ] + {:given "a list of elements and a start and a stop" + :should "return the items between the two" + :expected [:orange :pear] + :actual (slice t 2 3)})) + (test-end)))) + diff --git a/lib/tail.test.fnl b/lib/tail.test.fnl index 358b218..e507a0b 100644 --- a/lib/tail.test.fnl +++ b/lib/tail.test.fnl @@ -1 +1,19 @@ -;; TODO: test me +(let [{: tail} (require :lib.tail) + {: describe :end test-end} (require :lib.test)] + (describe "tail()" (fn [t] + (t {:given "a list" + :should "return it minus the head" + :expected [:apple :pear] + :actual (tail [:orange :apple :pear]) + }) + (t {:given "a single item list" + :should "return empty list" + :expected [] + :actual (tail [:orange]) + }) + (t {:given "an empty list" + :should "return empty list" + :expected [] + :actual (tail []) + }) + (test-end)))) diff --git a/lib/test.fnl b/lib/test.fnl new file mode 100644 index 0000000..fbaaf8d --- /dev/null +++ b/lib/test.fnl @@ -0,0 +1,52 @@ +(local {: pprint} (require :lib.tableprint)) +(local {: equal} (require :lib.equal)) + +(var plan 0) + +(fn once [funky] + (var bang false) + (fn [...] + (if (not bang) + (do + (funky ...) + (set bang true))))) + +(fn test [obj] + (let [{: given : should : actual : expected} obj + ok (if (equal actual expected) :ok "not ok") + description (.. "Given " given " should " should) + ] + (set plan (+ 1 plan)) + (print (.. ok " " plan " - " description)) + (if (= "not ok" ok) + (do + (print " ---") + (if (= :table (type expected)) + (do + (print (.. " expected: " )) + (pprint expected)) + (print (.. " expected: " (tostring expected)))) + (if (= :table (type actual)) + (do + (print (.. " actual: " )) + (pprint actual)) + (print (.. " actual: " (tostring actual)))) + (print " ...") + ) + ) + )) + +(local print-header (once (fn [] (print "TAP version 14")))) + +(fn desc [str cb] + (print-header) + (print (.. "#" str)) + (cb test) + ) +(fn end [] + (print (.. 1 ".." plan)) + ) + + +{:describe desc + : end} diff --git a/lib/test.test.fnl b/lib/test.test.fnl new file mode 100644 index 0000000..7958141 --- /dev/null +++ b/lib/test.test.fnl @@ -0,0 +1,19 @@ +(let [{: describe :end test-end} (require :lib.test)] + (fn add [x y] (let [x (or x 0) + y (or y 0)] + (+ x y))) + (describe "add()" (fn [test] + (let [should "return the right number"] + (test {:given "two numbers" + : should + :actual (add 2 3) + :expected 5}) + (test {:given "no arguments" + :should "return 0" + :actual (add) + :expected 0}) + (test {:given "zero" + : should + :actual (add 0 4) + :expected 4})) + (test-end)))) |