diff options
Diffstat (limited to 'lib/game')
-rw-r--r-- | lib/game/README | 5 | ||||
-rw-r--r-- | lib/game/all-mills.fnl | 25 | ||||
-rw-r--r-- | lib/game/all-mills.test.fnl | 41 | ||||
-rw-r--r-- | lib/game/index.fnl | 11 | ||||
-rw-r--r-- | lib/game/mill.fnl | 41 | ||||
-rw-r--r-- | lib/game/mill.test.fnl | 123 | ||||
-rw-r--r-- | lib/game/no-moves.fnl | 26 | ||||
-rw-r--r-- | lib/game/no-moves.test.fnl | 49 | ||||
-rw-r--r-- | lib/game/space-is-neighbor.fnl | 19 | ||||
-rw-r--r-- | lib/game/space-is-neighbor.test.fnl | 20 |
10 files changed, 360 insertions, 0 deletions
diff --git a/lib/game/README b/lib/game/README new file mode 100644 index 0000000..6dcd00f --- /dev/null +++ b/lib/game/README @@ -0,0 +1,5 @@ +These are all game specific functions that are big and or complex enough that i +wanted to break them out into their own modules so i could test them. + +when you add a function here, add a test file, and be sure to import/export it +to/from index.fnl diff --git a/lib/game/all-mills.fnl b/lib/game/all-mills.fnl new file mode 100644 index 0000000..e5b3d2b --- /dev/null +++ b/lib/game/all-mills.fnl @@ -0,0 +1,25 @@ +(local {: mill-at? } (require :lib.game.mill)) +(local {: mills } (require :lib.constants)) + +(fn toggle-player [p] (if (= p 1) 2 1)) + +(fn only-player-moves [moves player] + (icollect [_ move (ipairs moves)] (if (= move player) player 0))) + +(fn all-moves-are-mills? [player moves] + (accumulate [result true + i m (ipairs moves) ] + (and result (if (= m 0) true (mill-at? mills moves i))))) + +(fn all-mills? [all-moves current-player] + (->> current-player + (toggle-player) + (only-player-moves all-moves) + (all-moves-are-mills? current-player))) + +{: all-mills? + ;; do not use; just for testing: + : toggle-player + : only-player-moves + : all-moves-are-mills? + } diff --git a/lib/game/all-mills.test.fnl b/lib/game/all-mills.test.fnl new file mode 100644 index 0000000..055f6a5 --- /dev/null +++ b/lib/game/all-mills.test.fnl @@ -0,0 +1,41 @@ +(let [{: describe + : test-end} (require :lib.test) + {: all-mills? + : toggle-player + : only-player-moves + : all-moves-are-mills? + } (require :lib.game.all-mills)] + + (describe "# ALL-MILLS" (fn [] + (describe "toggle-player()" (fn [t] + (t {:given "a player" + :should "return the next" + :expected 2 + :actual (toggle-player 1) + }))) + (describe "only-player-moves()" (fn [t] + (let [moves [ 0 2 0 2 2 2 0 0 0 0 0 0 0 2 0 0 0 2 0 2 0 1 1 1 ] + expected [ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 ] + ] + (t {:given "a bunch of moves and a player" + :should "filter out all the moves not belonging to the player" + : expected + :actual (only-player-moves moves 1) + })))) + (describe "all-moves-are-mills?()" (fn [t] + (let [moves [ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 ] + ] + (t {:given "a bunch of moves and a player" + :should "return true if all the player moves are mills" + :expected true + :actual (all-moves-are-mills? 1 moves) + })) + (let [moves [ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 ] + ] + (t {:given "a bunch of moves and no mill and a player" + :should "return false" + :expected false + :actual (all-moves-are-mills? 1 moves) + })))) + (test-end)))) + diff --git a/lib/game/index.fnl b/lib/game/index.fnl new file mode 100644 index 0000000..f542f76 --- /dev/null +++ b/lib/game/index.fnl @@ -0,0 +1,11 @@ +(local {: all-mills?} (require :lib.game.all-mills)) +(local {: mill-at?} (require :lib.game.mill)) +(local {: space-is-neighbor?} (require :lib.game.space-is-neighbor)) +(local {: no-moves?} (require :lib.game.no-moves)) + +{ + : all-mills? + : mill-at? + : no-moves? + : space-is-neighbor? + } diff --git a/lib/game/mill.fnl b/lib/game/mill.fnl new file mode 100644 index 0000000..d15b53e --- /dev/null +++ b/lib/game/mill.fnl @@ -0,0 +1,41 @@ +(local {: contains} (require :lib.table)) + +(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 any [t] + "take a list of booleans, returns true if any of them are true" + (accumulate [acc false + i x (ipairs t)] + (or acc x))) + +(fn move-mills [moves-list] + (icollect [_ moves (ipairs moves-list)] + (let [player (. moves 1)] + (accumulate [acc true + _ m (ipairs moves)] + (and acc (not= m 0) (= player m)))))) + +(fn candidate-moves [moves candidates] + "Just turning board spaces into player moves" + (icollect [_ spaces (ipairs candidates)] + (icollect [_ space (ipairs spaces)] + (. moves space)))) + +(fn mill-at? [all-mills current-moves move] + "Is there a mill at this move?" + (->> (get-candidates all-mills move) + (candidate-moves current-moves) + (move-mills) + (any))) + +{: mill-at? + ;; not for consumption, + ;; just for testing: + : get-candidates + : candidate-moves + : move-mills + : any + } diff --git a/lib/game/mill.test.fnl b/lib/game/mill.test.fnl new file mode 100644 index 0000000..604c759 --- /dev/null +++ b/lib/game/mill.test.fnl @@ -0,0 +1,123 @@ +(let [{: describe + : test-end} (require :lib.test) + {: mill-at? + : get-candidates + : move-mills + : candidate-moves + : any + } (require :lib.game.mill) + {: mills } (require :lib.constants) + with-mills (partial mill-at? 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) })) + (t + (let [move 1 + moves [2 2 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0] + expected [[1 2 3] [1 10 22]] + ] + {:given (string.format "a move of %d" move) + :should "still return [[1 2 3] [1 10 22]]" + : expected + :actual (get-candidates mills move) })))) + + (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 "move-mills()" (fn [t] + (t + (let [moves [[1 1 1] [0 2 2]] ] + {:given "a list of moves" + :should "turn them into true/false if they are mills" + :expected [true false] + :actual (move-mills moves) })) + (t + (let [moves [[0 1 1] [0 2 2]] ] + {:given "no mills" + :should "should return false" + :expected [false false] + :actual (move-mills moves) })) + (t + (let [moves [[2 2 2] [2 0 0]] ] + {:given "mill, no mill" + :should "should return true false" + :expected [true false] + :actual (move-mills moves) })))) + + (describe "candidate-moves()" (fn [t] + (t (let [spaces [[1 2 3] [1 10 22]] + moves [2 2 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0] ] + {:given "spaces [[1 2 3] [1 10 22]]" + :should "map to moves" + :expected [[2 2 2] [2 0 0]] + :actual (candidate-moves moves spaces)})))) + + (describe "mill-at?()" (fn [t] + (t + (let [move 1 + moves [0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0] ] + {:given "no mills" + :should "return false" + :expected false + :actual (mill-at? mills moves move)})) + (t + (let [move 4 + moves [1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0] + with-mills (partial mill-at? mills) + with-moves (partial with-mills moves)] + {:given "a mill but not at Move" + :should "return false" + :expected false + :actual (with-moves move)})) + (t + (let [move 1 + moves [2 2 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0] + with-mills (partial mill-at? mills) + with-moves (partial with-mills moves)] + {:given "a mill" + :should "return true" + :expected true + :actual (with-moves move) })) + (t + (let [move 1 + moves [2 2 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0] + with-mills (partial mill-at? mills) + with-moves (partial with-mills moves)] + {:given "a mill" + :should "return the opposite of false" + :expected false + :actual (not (with-moves move)) })))) + + (test-end)))) diff --git a/lib/game/no-moves.fnl b/lib/game/no-moves.fnl new file mode 100644 index 0000000..02482cc --- /dev/null +++ b/lib/game/no-moves.fnl @@ -0,0 +1,26 @@ +(local {: tail} (require :lib.table)) + +(fn get-player-idxs [player moves] + (icollect [i p (ipairs moves)] (when (= p player) i))) + +(fn idx-to-neighbors [idxs all-neighbors] + (icollect [_ i (ipairs idxs)] (tail (. all-neighbors i)))) + +(fn neighbor-is-occupied? [neighbors moves] + (icollect [_ move (ipairs neighbors)] + (icollect [_ neighbor (ipairs move)] + (not= (. moves neighbor) 0)))) + +(fn reduce-to-bool [xs] + (accumulate [acc true + _ x (ipairs xs)] + (and x))) + +(fn no-moves? [neighbors all-moves player] + (-> (get-player-idxs player all-moves) + (idx-to-neighbors neighbors) + (neighbor-is-occupied? all-moves) + (reduce-to-bool) + (reduce-to-bool))) + +{: no-moves? } diff --git a/lib/game/no-moves.test.fnl b/lib/game/no-moves.test.fnl new file mode 100644 index 0000000..a94d60a --- /dev/null +++ b/lib/game/no-moves.test.fnl @@ -0,0 +1,49 @@ +(let [{: no-moves?} (require :lib.game.no-moves) + {: neighbors} (require :lib.constants) + {: describe : test-end} (require :lib.test) + with-neighbors (partial no-moves? neighbors) + ] + + (describe "# NOMOVES" (fn [t] + (let [moves [ 1 2 0 0 0 0 0 0 0 2 0 0 0 0 0 0 0 0 0 0 0 0 ] + player 1 + ] + (t {:given "one move with no moves" + :should "return true" + :expected true + :actual (with-neighbors moves player) + })) + (let [moves [ 1 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 ] + player 1 + ] + (t {:given "one move with one move" + :should "return false" + :expected false + :actual (with-neighbors moves player) + })) + (let [moves [ 1 1 1 0 2 0 0 0 0 2 0 0 0 0 2 0 0 0 0 0 0 0 ] + player 1 + ] + (t {:given "several moves with no moves" + :should "return true" + :expected true + :actual (with-neighbors moves player) + })) + (let [moves [ 0 2 0 2 1 2 0 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 ] + player 1 + ] + (t {:given "four occupied neighbors" + :should "return true" + :expected true + :actual (with-neighbors moves player) + })) + (let [moves [ 1 2 1 2 0 2 1 2 1 2 1 0 1 2 1 2 2 2 0 1 0 0 0 0 0 ] + player 2 + ] + (t {:given "this turn that is giving me trouble" + :should "return true" + :expected true + :actual (with-neighbors moves player) + })) + + (test-end)))) diff --git a/lib/game/space-is-neighbor.fnl b/lib/game/space-is-neighbor.fnl new file mode 100644 index 0000000..373feaf --- /dev/null +++ b/lib/game/space-is-neighbor.fnl @@ -0,0 +1,19 @@ +(local {: contains + : head + : tail + } (require :lib.table)) + +(lambda space-is-neighbor? [all-neighbors from to] + ;; i have learned to check that i'm passing the correct type of move + ;; i.e. a number and not a string + (assert (= "number" (type from)) "from must be a number") + (assert (= "number" (type to)) "to must be a number") + (assert (= "table" (type all-neighbors)) "all-neighbors must be a table") + + (let [neighborhood-list (icollect [_ n (ipairs all-neighbors)] (if (= from (head n)) n)) + neighborhood (head neighborhood-list) + neighbors (tail neighborhood) + is-neighbor (contains neighbors to)] + is-neighbor)) + +{: space-is-neighbor?} diff --git a/lib/game/space-is-neighbor.test.fnl b/lib/game/space-is-neighbor.test.fnl new file mode 100644 index 0000000..0ae7d4e --- /dev/null +++ b/lib/game/space-is-neighbor.test.fnl @@ -0,0 +1,20 @@ +(let [{: space-is-neighbor?} (require :lib.game.space-is-neighbor) + {: neighbors} (require :lib.constants) + {: describe : test-end} (require :lib.test) + with-neighbors (partial space-is-neighbor? neighbors) ] + + (describe "# SPACE-IS-NEIGHBOR" (fn [t] + (t {:given "space of 3" + :should "know 2 is a neighbor" + :expected true + :actual (with-neighbors 3 2)}) + (t {:given "space of 3" + :should "know 15 is a neighbor" + :expected true + :actual (with-neighbors 3 15)}) + (t {:given "space of 3" + :should "know 1 is not a neighbor" + :expected false + :actual (with-neighbors 3 1)}) + + (test-end)))) |