Skip to content

Instantly share code, notes, and snippets.

Last active November 27, 2017 09:38
Show Gist options
  • Save rarous/695e486df9bd0d4ff2ba to your computer and use it in GitHub Desktop.
Save rarous/695e486df9bd0d4ff2ba to your computer and use it in GitHub Desktop.
Refactoring of Tic-Tac-Toe in Clojure
(ns piskvorky.core
(:require [clojure.string :as s])
(defn usage []
(println "Ahoj v piskvorkach naslepo.\nPovolene prikazy jsou:\nnew - nova hra\nquit - konec\n[a-i][0-9] - tah na pole, kde rada je pozice a, b, c, d, e, f, g, h, i. Sloupec je 1 ... az 9.\nformat zapisu je napr. e5\nZacina x"))
(defn make-board []
(vec (repeat 9 (vec (repeat 9 :nothing)))))
(defn command->position [command]
(if (= 2 (count command))
(let [fst (subs command 0 1)
snd (subs command 1 2)]
(if (and (contains? #{"a" "b" "c" "d" "e" "f" "g" "h" "i"} fst)
(contains? #{"1" "2" "3" "4" "5" "6" "7" "8" "9"} snd))
({"a" 0 "b" 1 "c" 2 "d" 3 "e" 4 "f" 5 "g" 6 "h" 7 "i" 8} fst)
({"1" 0 "2" 1 "3" 2 "4" 3 "5" 4 "6" 5 "7" 6 "8" 7 "9" 8} snd)]
(defn contains-5-iter [[fst & coll] active actual-count]
(if (= fst active)
(if (and (= 4 actual-count) (not= active :nothing))
(recur coll active (inc actual-count)))
(if (= 0 (count coll))
(recur coll fst 1))))
(defn contains-5 [coll]
(if (> (count coll) 4)
(contains-5-iter (rest coll) (first coll) 1)
(defn take-9-around [board position xfn yfn]
(let [xs (map xfn (range -4 5))
ys (map yfn (range -4 5))
positions (map (fn [x y] [x y]) xs ys)
valid-positions (filter (fn [[x y]] (and (>= x 0) (<= x 8) (>= y 0) (<= y 8))) positions)
(map (partial get-in board) valid-positions)))
(defn won [board active-player position]
(contains-5 (take-9-around board position (partial + (first position)) (fn [_] (second position)))) ; L < - > R
(contains-5 (take-9-around board position (fn[_] (first position)) (partial + (second position)))) ; U < - > D
(contains-5 (take-9-around board position (partial + (first position)) (partial + (second position)))) ; LD <-> UR
(contains-5 (take-9-around board position (partial + (first position)) (partial - (second position)))))) ; LU <-> DR
(defn turn [board active-player position]
(assoc-in board position active-player))
(defn full-board [board]
(not (contains? (set (flatten board)) :nothing)))
(def next-player
{:x :o
:o :x})
(defn already-taken [board position]
(not= :nothing (get-in board position)))
(defn print-board [board]
(println (s/reverse (s/join "\n" (map (fn [row]
(s/reverse (s/join " "
(map (fn [item]
(case item
:x "x"
:o "o"
:nothing "_")) row)
))) board)))))
(defn game-loop [board active-player game-status]
(println "Hrac" (name active-player) " ")
(let [command (read-line)
position (command->position command)
args (cond (= command "new") (do (println "Nova hra") (list (make-board) :x :active))
(= command "quit") (println "Navidenou")
(= command "board") (do (print-board board) (list board active-player game-status))
(= position :error) (do (println "Tah ve spatnem formatu")
(list board active-player game-status))
(= game-status :complete) (do (println "Hra dokoncena, dej \"new\" pro novou")
(list board active-player game-status))
(already-taken board position) (do (println "Pole je zabrano, hraj znovu")
(list board active-player game-status))
true (let [new-board (turn board active-player position)]
(if (won new-board active-player position) (do
(println "VYHRA! Gratulace hraci " active-player)
(print-board new-board)
(list new-board (next-player active-player) :complete))
(if (full-board new-board)
(do (println "Remiza, hraci pole zaplneno") (list new-board active-player) :complete)
(do (println "Ok") (list new-board (next-player active-player) game-status))))))]
(when args (recur (first args) (second args) (nth args 2))))))
(defn init []
(game-loop (make-board) :x :active))
(defn -main []
(ns katas.tictactoe
(:require [clojure.string :as s])
(:import [ Writer]))
(defrecord Game [board player status])
(def empty-board (vec (repeat 9 (vec (repeat 9 nil)))))
(def new-game (->Game empty-board :x :active))
(def not-empty? (comp not empty?))
(defn between? [x min max] (and (>= x min) (<= x max)))
(defn full? [board] (not (contains? (set (flatten board)) nil)))
(defn already-taken? [board position] (some? (get-in board position)))
(defn valid-positions [[x y]] (and (between? x 0 8) (between? y 0 8)))
(defn has-5-in-row? [coll]
(when (> (count coll) 4)
(loop [i 1
curr (first coll)
[head & rest] (rest coll)]
(if (and (some? curr) (= head curr))
(or (= i 4) (recur (inc i) curr rest))
(and (not-empty? rest) (recur 1 head rest))))))
(defn take-9-around [board xfn yfn]
(let [xs (map xfn (range -4 5))
ys (map yfn (range -4 5))]
(->> (map vector xs ys)
(filter valid-positions)
(map #(get-in board %)))))
(defn won? [board [x y]]
(let [surroundings (fn [[xfn yfn]] (take-9-around board xfn yfn))
horizontal [(partial + x) (constantly y)]
vertical [(constantly x) (partial + y)]
diagonal+ [(partial + x) (partial + y)]
diagonal- [(partial + x) (partial - y)]]
(->> [horizontal vertical diagonal+ diagonal-]
(map surroundings)
(filter has-5-in-row?)
(defn turn [board player position]
(assoc-in board position player))
(def turn-once-per-round (memoize turn))
(defn rules [pos {:keys [board player status]}]
(nil? pos) [:wrong-position]
(already-taken? board pos) [:occupied]
(not= status :active) [:complete]
(let [next-board (turn-once-per-round board player pos)]
(won? next-board pos) [:win next-board]
(full? next-board) [:tie next-board]
:else [:active next-board]))))
(def next-player
{:x :o
:o :x})
(defmulti play-position (fn [[status & _] _] status))
(defmethod play-position :default [_ game] game)
(defmethod play-position :win [[_ next] game]
(assoc game :board next :status :complete))
(defmethod play-position :tie [[_ next] game]
(assoc game :board next :status :complete))
(defmethod play-position :active [[_ next] {:keys [player] :as game}]
(assoc game :board next :player (next-player player)))
(defmulti play (fn [cmd _] (first cmd)))
(defmethod play :default [_ game] game)
(defmethod play :new [_ _] new-game)
(defmethod play :quit [_ _] nil)
(defmethod play :position [[_ pos] game]
(play-position (rules pos game) game))
(defmulti print-status (fn [[status & _] _] status))
(defmethod print-status :default [_ _] "Ok")
(defmethod print-status :wrong-position [_ _] "Tah ve špatném formátu")
(defmethod print-status :occupied [_ _] "Pole je již zábrano, hraj znovu")
(defmethod print-status :complete [_ _] "Hra dokončena, zadej \"new\" pro novou")
(defmethod print-status :tie [_ _] "Remíza, hrací pole zaplněno")
(defmethod print-status :win [[_ next] {:keys [player] :as game}]
[(str "VÝHRA! Gratulace hráči " (name player))
(assoc game :board next)])
(defmulti print-command (fn [cmd _] (first cmd)))
(defmethod print-command :new [_ _] "Nová hra")
(defmethod print-command :quit [_ _] "Naviděnou")
(defmethod print-command :board [_ game] (prn-str game))
(defmethod print-command :position [[_ pos] game]
(print-status (rules pos game) game))
(def item->str
{:x "x"
:o "o"
nil "_"})
(defn row->str [row]
(->> row (map item->str) s/join s/reverse))
(defn board->str [board]
(->> board (map row->str) (s/join "\n") s/reverse))
(defmethod clojure.core/print-method Game [v ^Writer w]
(.write w (board->str (:board v))))
(def help "
Povolené příkazy jsou:
new - nová hra
quit - konec
board - zobrazit hrací plochu
help - zobrazit tuto nápovědu
[a-i][0-9] - tah na pole, kde řada je pozice a, b, c, d, e, f, g, h, i. Sloupec je 1 až 9.
formát zápisu je např.: e5")
(defmethod print-command :help [_ _] help)
(defn command->position [command]
(let [r (first command)
c (second command)
row (zipmap [\a \b \c \d \e \f \g \h \i] (range 9))
col (zipmap [\1 \2 \3 \4 \5 \6 \7 \8 \9] (range 9))]
(when (and (row r) (col c))
[(row r) (col c)])))
(defn parse-command [cmd]
(case cmd
"new" [:new]
"quit" [:quit]
"board" [:board]
"help" [:help]
[:position (command->position cmd)]))
(defn do-print [res]
(if (sequential? res)
(dorun (map println res))
(println res)))
(defn -main []
(println "Vítej v piškvorkách naslepo.")
(println help)
(loop [{:keys [player] :as game} new-game]
(println "Hráč" (name player))
(let [cmd (parse-command (read-line))]
(do-print (print-command cmd game))
(when-let [next-round (play cmd game)]
(recur next-round)))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment