［CLisp］井字過三關代碼

λ posted @ 2011年11月24日 19:44 in Mixture with tags exercise lisp robot , 3733 阅读

做完《Common Lisp: A Gentle Introduction to Symbolic Computation》第 10.6 節中的練習後得到的成果。

TIC-TAC-TOE代碼

遊戲設定數據

;; 設定人類玩家和電腦玩家的棋子數值
(setf *opponent* 1 *computer* 5)

;; 所有連線位置
(setf *triplets*
   '((1 2 3) (4 5 6) (7 8 9)
     (1 4 7) (2 5 8) (3 6 9)
     (1 5 9) (3 5 7)))

;; 邊與角的位置
(setf *corners* '(1 3 7 9) *sides* '(2 4 6 8))

棋盤相關函數

;; 構造新棋盤
(defun make-board ()
  (list 'board 0 0 0 0 0 0 0 0 0))
  ;不能直接用 '(board 0 0 0 0 0 0 0 0 0)
  ;否則下次用的是使用過的同一個棋盤。

;; 將數值轉換成棋子
(defun convert-to-chess (val)
  (cond ((eql 1 val) "O") ; 人類玩家
        ((eql 5 val) "X") ; 電腦玩家
        (t " ")))

;; 打印一行棋子
(defun print-row (x y z)
  (format t "~& ~A | ~A | ~A"
            (convert-to-chess x)
            (convert-to-chess y)
            (convert-to-chess z)))

;; 打印棋盤
(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))
  (format t "~&~%"))

玩家操作函數

;; 進行單次遊戲
(defun play-one-game ()
  (if (y-or-n-p "Would you like to play first? ")
    (opponent-move (make-board))
    (computer-move (make-board))))

;; 開始遊戲
(defun tic-tac-toe ()
  (format t "~&Welcome to play TIC-TAC-TOE!~%~%")
  (play-one-game)
  (format t "~&~%")
  (cond ((y-or-n-p "Play again? ")
         (format t "~%~%")
         (tic-tac-toe))
        (t (format t "~%~%Thanks for playing! Bye."))))

;; 玩家下子
(defun make-move (player pos board)
  (setf (nth pos board) player)
  board)
  
;; 人類玩家輸入有效下子位置
(defun valid-input (board)
  (format t "~&Your move: ")
  (let ((pos (read)))
    (cond ((not (and (integerp pos) (<= 1 pos 9)))
           (format t "~&Invalid input.")
           (valid-input board))
          ((not (zerop (nth pos board)))
           (format t "~&That space is already occupied.")
           (valid-input board))
          (t pos))))

;; 人類玩家下子
(defun opponent-move (board)
  (let* ((pos (valid-input board))
         (new-board (make-move *opponent* pos board)))
    (print-board new-board)
    (cond ((winner-p new-board) (format t "~&You win!."))
          ((full-board-p new-board) (format t "~&Tie game."))
          (t (computer-move new-board)))))

;; 隨機取得可下子位置
(defun pick-random-position (board)
  (let* ((empty-space (all-empty-positions board))
         (range (length empty-space)))
    (nth (random range) empty-space)))

;; 電腦玩家下子
(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 "~&My move: ~S" pos)
    (format t "~&My strategy: ~A" strategy)
    (print-board new-board)
    (cond ((winner-p new-board) (format t "~&I win!."))
          ((full-board-p new-board) (format t "~&Tie game."))
          (t (opponent-move new-board)))))

;; 電腦玩家最佳下子位置及相關策略
(defun choose-best-move (board)
  (or (make-three board)
      (block-win board)
      (block-squeeze-play board)
      (block-two-on-one board)
      (squeeze-trap board)
      (two-on-one-trap board)
      (make-two board)
      (random-move board)))

;; 策略：直接連線成功
(defun make-three (board)
  (let ((pos (win-or-block board (* 2 *computer*))))
    (and pos (list pos "make-three"))))

;; 策略：阻止人類玩家下一回合連線成功
(defun block-win (board)
  (let ((pos (win-or-block board (* 2 *opponent*))))
    (and pos (list pos "block-win"))))

;; 策略：規避斜線上 O-X-O 陷阱
(defun block-squeeze-play (board)
  (let ((block-sum (+ *computer* (* 2 *opponent*))))
    (and (or (eql block-sum (sum-of-triplet board '(1 5 9)))
             (eql block-sum (sum-of-triplet board '(3 5 7))))
         (eql *computer* (nth 5 board))
         (let ((pos (find-empty-postion board *sides*)))
           (and pos (list pos "block-squeeze-play"))))))

;; 策略：規避斜線上 O-O-X 陷阱
(defun block-two-on-one (board)
  (let ((block-sum (+ *computer* (* 2 *opponent*))))
    (and (or (eql block-sum (sum-of-triplet board '(1 5 9)))
             (eql block-sum (sum-of-triplet board '(3 5 7))))
         (eql *opponent* (nth 5 board))
         (let ((pos (find-empty-postion board *corners*)))
           (and pos (list pos "block-two-on-one"))))))

;; 策略：製造斜線上 X-O-X 陷阱
(defun squeeze-trap (board)
  (if (and (find-if #'(lambda (pos)
                        (eql *opponent* (nth pos board)))
                    *corners*)
           (eql 7 (length (all-empty-positions board))))
    (let ((pos (find-if #'integerp
                        (mapcar #'(lambda (triplet)
                                    (find-empty-postion board triplet))
                                '((1 5 9) (3 5 7))))))
      (and pos (list pos "squeeze-trap")))))

;; 策略：製造斜線上 X-X-O 陷阱
(defun two-on-one-trap (board)
  (if (and (find-if #'(lambda (pos)
                        (eql *opponent* (nth pos board)))
                    *sides*)
           (eql 7 (length (all-empty-positions board))))
    (cond ((eql *computer* (nth 5 board))
           (list (find-empty-postion board *corners*) "two-on-one-trap"))
          (t (list 5 "two-on-one-trap")))))

;; 策略：在線上放兩子
(defun make-two (board)
  (let ((pos (win-or-block board *computer*)))
    (and pos (list pos "make-two"))))

;; 策略：隨機下子
(defun random-move (board)
  (list (pick-random-position board) "random-move"))

遊戲信息函數

;; 是否勝利
(defun winner-p (board)
  (let ((sums (sum-of-board board)))
    (or (member (* 3 *opponent*) sums)
        (member (* 3 *computer*) sums))))

;; 棋盤是否已滿
(defun full-board-p (board)
  (not (member 0 board)))

;; 取得指定連線上棋子數值之和
(defun sum-of-triplet (board triplet)
  (apply #'+ (mapcar #'(lambda (pos)
                         (nth pos board))
                     triplet)))

;; 取得棋盤各連線上棋子數值之和
(defun sum-of-board (board)
  (mapcar #'(lambda (triplet)
              (sum-of-triplet board triplet))
          *triplets*))

;; 取得連線成功或能進行阻擋的第一個位置
(defun win-or-block (board target-sum)
  (let ((triplet (find-if #'(lambda (trip)
                             (eql target-sum
                                  (sum-of-triplet board trip)))
                          *triplets*)))
    (when triplet
      (find-empty-postion board triplet))))

;; 取得所有有效下子位置
(defun all-empty-positions (board)
  (remove-if-not #'(lambda (pos)
                     (zerop (nth pos board)))
                 '(1 2 3 4 5 6 7 8 9)))

;; 取得一個有效下子位置
(defun find-empty-postion (board pos-list)
  (find-if #'(lambda (pos)
               (zerop (nth pos board)))
           pos-list))

執行(tic-tac-toe)就能開始遊戲了，電腦不是無敵的，哈。

這些代碼的主要體現如下所述：