Refactoring of Tic-Tac-Toe in Clojure

orig.clj

(ns piskvorky.core
  (:require [clojure.string :as s])
  (:gen-class))

(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)]
        :error))
    :error))
    
(defn contains-5-iter [[fst & coll] active actual-count]
  (if (= fst active)
    (if (and (= 4 actual-count) (not= active :nothing))
      true
      (recur coll active (inc actual-count)))
    (if (= 0 (count coll))
      false
      (recur coll fst 1))))
      
(defn contains-5 [coll]
  (if (> (count coll) 4)
    (contains-5-iter (rest coll) (first coll) 1)
    false))

(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]
  (or
    (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]
  (do
    (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 []
  (usage)
  (game-loop (make-board) :x :active))

(defn -main []
  (init))

refactored.clj

(ns katas.tictactoe
  (:require [clojure.string :as s])
  (:gen-class)
  (:import [java.io 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?)
         not-empty?)))

(defn turn [board player position]
  (assoc-in board position player))
(def turn-once-per-round (memoize turn))

(defn rules [pos {:keys [board player status]}]
  (cond
    (nil? pos) [:wrong-position]
    (already-taken? board pos) [:occupied]
    (not= status :active) [:complete]
    :else
    (let [next-board (turn-once-per-round board player pos)]
      (cond
        (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)))))