Tick Tack Toe, http://nabetani.sakura.ne.jp/hena/1/

2012-07-06-tick-tack-toe.lisp

;;;; Last modified: 2013-12-05 21:03:49 tkych


;;====================================================================
;; Tick Tack Toe
;;====================================================================
;; - [Tick-Tack-Toe 〜 横へな 2012.7.6](http://nabetani.sakura.ne.jp/hena/1/)


;;--------------------------------------------------------------------
;; Package
;;--------------------------------------------------------------------

(in-package :cl-user)
(defpackage :tick-tack-toe (:use :cl))
(in-package :tick-tack-toe)


;;--------------------------------------------------------------------
;; Main
;;--------------------------------------------------------------------

(defparameter *board-size* 3)

(defun winp (player board)
  (or ;; row
      (loop :for row :from 0 :below *board-size*
            :thereis (loop :for col :from 0 :below *board-size*
                           :always (eql (aref board row col) player)))
      ;; col
      (loop :for col :from 0 :below *board-size*
            :thereis (loop :for row :from 0 :below *board-size*
                           :always (eql (aref board row col) player)))
      ;; diag: up-left -- down-right
      (loop :for row :from 0 :below *board-size*
            :for col :from 0 :below *board-size*
            :always (eql (aref board row col) player))
      ;; diag: up-right -- down-left
      (loop :for row :from 0 :below *board-size*
            :for col :downfrom (1- *board-size*) :to 0
            :always (eql (aref board row col) player))))

(defun switch (player)
  (if (char= player #\o) #\x #\o))

(defun main (input)
  (loop :with board := (make-array (list *board-size* *board-size*)
                                   :element-type t :initial-element nil)
        :for c :across (subseq input 0 (min (length input) (expt *board-size* 2)))
        :for player := #\o :then (switch player)
        :do ;; (format t "~%~A: ~A-~D" board player c) for DBG
            (let* ((i (1- (digit-char-p c)))
                   (e (row-major-aref board i)))
              (if e
                  (RETURN (format nil "Foul : ~A won." (switch player)))
                  (progn
                    (setf (row-major-aref board i) player)
                    (when (winp player board)
                      (RETURN (format nil "~A won." player))))))
        :finally (return "Draw game.")))


;;--------------------------------------------------------------------
;; Tests
;;--------------------------------------------------------------------

(defun =>? (got want)
  (assert (string= got want)))

(progn
  (=>? (main "79538246") "x won.")
  (=>? (main "35497162193") "x won.")
  (=>? (main "61978543") "x won.")
  (=>? (main "254961323121") "x won.")
  (=>? (main "6134278187") "x won.")
  (=>? (main "4319581") "Foul : x won.")
  (=>? (main "9625663381") "Foul : x won.")
  (=>? (main "7975662") "Foul : x won.")
  (=>? (main "2368799597") "Foul : x won.")
  (=>? (main "18652368566") "Foul : x won.")
  (=>? (main "965715") "o won.")
  (=>? (main "38745796") "o won.")
  (=>? (main "371929") "o won.")
  (=>? (main "758698769") "o won.")
  (=>? (main "42683953") "o won.")
  (=>? (main "618843927") "Foul : o won.")
  (=>? (main "36535224") "Foul : o won.")
  (=>? (main "882973") "Foul : o won.")
  (=>? (main "653675681") "Foul : o won.")
  (=>? (main "9729934662") "Foul : o won.")
  (=>? (main "972651483927") "Draw game.")
  (=>? (main "5439126787") "Draw game.")
  (=>? (main "142583697") "Draw game.")
  (=>? (main "42198637563") "Draw game.")
  (=>? (main "657391482") "Draw game.")
  )


;;====================================================================