Common Lisp 语言编写的Tic-Tac-Toe

;;;; A Tic-Tac-Toe Game written in Common Lisp
;;;; To launch the game, type in (play-one-game)

;; “It pays to take a few minutes at the outset to think about
;; the overall design, particularly the data structures used”
;; 数据结构非常重要——简洁，抓住要点的数据结构，能使之后的算法描述变得清晰有效，
;; 易于实现，否则，后续的开发会举步为艰，且有推倒重来之危险，所以编程伊始一定要
;; 重视数据结构的定义，能用简单的方案就不要用复杂的方案
(defun make-board ()
  ; 列表前面加个board，这样剩下9个元素就能用1～9的下标来获取
  (list 'board 0 0 0 0 0 0 0 0 0))

;; 用0，1和10分别表示“空白”，“O”和“X”，这样通过对三行，三列以及对角线
;; 求和就可以知道这一序列的情况，举例如下
;; 和为0：全是空白
;; 和为3：O | O | O
;; 和为21： X | X | O
(defun number->letter (val)
  (cond ((equal val 1) "O")
    ((equal val 10) "X")
    (t " ")))

(defun print-row (left middle right)
  (format t " ~A | ~A | ~A~&"
      (number->letter left)
      (number->letter middle)
      (number->letter right)))

(defun print-board (board)
  (format t "~%")
  (print-row (nth 1 board) (nth 2 board) (nth 3 board))
  (format t "-----------~%")
  (print-row (nth 4 board) (nth 5 board) (nth 6 board))
  (format t "-----------~%")
  (print-row (nth 7 board) (nth 8 board) (nth 9 board)))

(defun make-move (player pos board)
  (setf (nth pos board) player)
  board)

;; global settings
(defparameter *board* (make-board))
(defparameter *computer* 10)
(defparameter *human* 1)
; corners表示棋盘四个角
(defparameter *corners* '(1 3 7 9))
; sides表示棋盘四个边
(defparameter *sides* '(2 4 6 8))
; 两条对角线
(defparameter *diagonals* '((1 5 9) (3 5 7)))

;; winning configurations
;; 最简单的情况下，将游戏胜利的情况全部枚举出来，作为一种“配置”，用于判断胜利条件
;; 更复杂一些的游戏则需要用到高级数据结构，比如博弈树（game tree）
(defparameter *triplets*
  '((1 2 3) (4 5 6) (7 8 9) ;horizontal
    (1 4 7) (2 5 8) (3 6 9) ;vertical
    (1 5 9) (3 5 7)))       ;diagonal

;; 求三行，三列或三对角线和
(defun sum-triplet (board triplet)
  (+ (nth (first triplet) board)
     (nth (second triplet) board)
     (nth (third triplet) board)))

(defun compute-sums (board)
  (mapcar #'(lambda (triplet)
          (sum-triplet board triplet))
      *triplets*))

;; 判断当前棋盘布局是否出现赢家
(defun winner-p (board)
  (let ((sums (compute-sums board)))
    (or (member (* 3 *computer*) sums)
    (member (* 3 *human*) sums))))

(defun full-board-p (board)
  (not (member 0 board)))

;; 合法判定：用户输入必须在1到9之间，且棋盘上该位置为空白
(defun ask-legal-move (board)
  (format t "~&Type a move [1-9]: ")
  (let ((move (read)))
    (cond ((not (and (integerp move) (<= 1 move 9)))
       (format t "~&Invalid input, try again [1-9]: ")
       (ask-legal-move board))
      ((not (zerop (nth move board)))
       (format t "~&This place occupied, try again [1-9]: ")
       (ask-legal-move board))
      (t move))))

;; 人类玩家下棋，要判断走子之后是否游戏结束，即获胜或平局
(defun human-move (board)
  (let* ((pos (ask-legal-move board))
     ; 函数式风格：绑定新变量，避免assignment，对FP而言，assignment
     ; 一般发生在全局变量上，尽量使用LET，applicative operator,
     ; 有效的尾递归调用来编写优雅的函数式风格程序
     (new-board (make-move *human* pos board)))
    (print-board new-board)
    (cond ((winner-p new-board) (format t "~&Human wins"))
      ((full-board-p new-board) (format t "~&Game ties"))
      (t (computer-move new-board)))))

;;; 计算机下棋，最朴素的一种策略——随机选择一个空白出走子

;; 分离职责：一个函数只做一件事，做好一件事，
;; 提高内聚性，函数之间只有调用关系，高度松耦合
(defun pick-random-position (board)
  (let ((pos (1+ (random 9))))
    (cond ((not (zerop (nth pos board))) (pick-random-position board))
      (t pos))))

(defun random-move-strategy (board)
  (list (pick-random-position board) "random move"))

;;; 更智能的策略，计算机试图将“X”连成一线，或者试图阻止玩家将“O”连成一线
(defun find-empty-place (trip board)
  (find-if #'(lambda (n)
           (zerop (nth n board)))
       trip))

(defun win-or-block (board sum)
  (let ((trip (find-if #'(lambda (triplet)
               (= (sum-triplet board triplet) sum))
               *triplets*)))
    (and trip (find-empty-place trip board))))

;; 计算机策略1，将“X”连成一线
(defun three-in-a-row (board)
  (let ((pos (win-or-block board (* 2 *computer*))))
    (and pos (list pos "make three in a row"))))

;; 计算机策略2，试图阻止玩家获胜
(defun block-opponent (board)
  (let ((pos (win-or-block board (* 2 *human*))))
    (and pos (list pos "block opponent"))))

;; 计算机策略3,防止玩家通过对角线法则（squeeze play）获胜
(defun block-squeeze-play (board)
  (let ((trip (find-if #'(lambda (diagonal)
               (and (equal *computer*
                       (nth (second diagonal) board))
                (equal (sum-triplet board diagonal)
                       (+ *computer* (* 2 *human*)))))
               *diagonals*))
    (pos (find-empty-place *sides* board)))
    (and trip pos (list pos "block squeeze play"))))

;; 计算机策略4,防止玩家以“two on one”的方式获胜
(defun block-two-on-one (board)
  (let ((trip (find-if #'(lambda (diagonal)
               (and (equal *human*
                       (nth (second diagonal) board))
                (equal (sum-triplet board diagonal)
                       (+ *computer* (* 2 *human*)))))
               *diagonals*))
    (pos (find-empty-place *corners* board)))
    (and trip pos (list pos "block two on one"))))

;; 计算机综合采用多种策略来决策如何战胜玩家
(defun choose-best-move-1 (board)
  (or (block-squeeze-play board)
      (block-two-on-one board)
      (three-in-a-row board)
      (block-opponent board)
      (random-move-strategy board)))

(defun choose-best-move (board)
  (choose-best-move-1 board))

;; 计算机下棋，不光显示走子情况，还显示所用的具体策略
(defun computer-move (board)
  (let* ((best-move (choose-best-move board))
     (pos (first best-move))
     (strategy (second best-move))
     (new-board (make-move
             *computer* pos board)))
    (format t "~&Computer move: ~S" pos)
    (format t "~&Strategy: ~S~%" strategy)
    (print-board new-board)
    (cond ((winner-p new-board)
       (format t "~&Computer wins"))
      ((full-board-p new-board)
       (format t "~&Game ties"))
      (t (human-move new-board)))))

;; for start of game
(defun play-one-game ()
  (if (y-or-n-p "Would you like to go first? ")
      (human-move (make-board))
      (computer-move (make-board))))