Yellow Rabbit

Использование запоминающей функции и мелкие улучшения

Игра Трилобит на Lisp: мелкие усовершенствования

Хотя я проигрываю AI, он не может победить монстра из 11-го часа :frowning: И, пока у меня не появилось идей по улучшению его работы, займусь украшательствами. Для начала чуть-чуть упростим построение шаблонов для проверки соседних ячеек, ну и заодно сделаем её запоминающей.

Немного причёсывания


;; test pattern for win
;; ((left...) (right...)
;;  (up...) (down...)
;;  (left-up...) (right-down...)
;;  (left-down...) (right-up))
(let 
   ((left-pattern (loop repeat (1- *win-len*) for i from 1 collect (- i)))
    (right-pattern (loop repeat (1- *win-len*) for i from 1 collect i))
    (up-pattern (loop repeat (1- *win-len*)
                                      for i from 1 collect (- (* *board-width* i))))
    (down-pattern (loop repeat (1- *win-len*)
                                      for i from 1 collect (+ (* *board-width* i))))
    (left-up-pattern (loop repeat (1- *win-len*)
                                      for i from 1 collect (- (* i (1+ *board-width*)))))
    (right-down-pattern (loop repeat (1- *win-len*)
                                          for i from 1 collect (* i (1+ *board-width*))))
    (left-down-pattern (loop repeat (1- *win-len*)
                                          for i from 1 collect (+ (* i (1- *board-width*)))))
    (right-up-pattern (loop repeat (1- *win-len*)
                                          for i from 1 collect (- (* i (1- *board-width*))))))
    (defun slow-get-test-patterns (cell)
      (list
        ; left
        (loop
            repeat (min (1- *win-len*) (mod cell *board-width*))
            for off in left-pattern
            collect (+ cell off))
        ; right
        (loop
            repeat (min (1- *win-len*) 
                                   (- *board-width* (mod cell *board-width*) 1))
            for off in right-pattern
            collect (+ cell off))
        ; up
        (loop
            repeat (min (1- *win-len*) (floor cell *board-width*))
            for off in up-pattern
            collect (+ cell off))
        ; down
        (loop
            repeat (min (1- *win-len*)
                                   (- *board-height* (floor cell *board-width*) 1))
            for off in down-pattern
            collect (+ cell off))
        ; left-up
        (loop
            repeat (min (1- *win-len*) (mod cell *board-width*) (floor cell *board-width*))
            for off in left-up-pattern
            collect (+ cell off))
        ; right-down
        (loop
            repeat (min (1- *win-len*)
                        (- *board-width* (mod cell *board-width*) 1)
                        (- *board-height* (floor cell *board-width*) 1))
            for off in right-down-pattern
            collect (+ cell off))
        ; left-down
        (loop
            repeat (min (1- *win-len*)
                        (mod cell *board-width*)
                        (- *board-height* (floor cell *board-width*) 1))
            for off in left-down-pattern
            collect (+ cell off))
        ; right-up
        (loop
            repeat (min (1- *win-len*)
                        (- *board-width* (mod cell *board-width*) 1)
                        (floor cell *board-width*))
            for off in right-up-pattern
            collect (+ cell off)))))

;; memoized version of get-test-patterns
(let
  ((previous (make-hash-table)))
  (defun get-test-patterns (cell)
    (or (gethash cell previous)
        (setf (gethash cell previous) (slow-get-test-patterns cell)))))

Несколько вспомогательных предикатов

Выражения типа (if (eql *ai-player* (game-node-player tree)) смотрятся не очень, поэтому введём несколько предикатов.


;; which player made the move
(defun last-player (tree)
  (change-player (game-node-player tree)))

;; was last player
(defun last-playerp (tree player)
  (eql player (last-player tree)))

;; is current player
(defun cur-playerp (tree player)
  (eql player (game-node-player tree)))

Новая эвристика

Отличие её от старой заключается в том, что старая оценивала позицию подсчитывая длины уже построенных линий из фишек, а новая допускает пустые клетки между клетками с фишками AI. Другими словами она принимает в расчёт потенциальные линии из фишек. Сразу скажу, что она всё равно не позволяет победить компьютер из 11-го часа.


;; count player cells in line
;; empty cells are allowed but other player cells not
(defun count-player-cells (board cell player)
  (let ((pattern (get-test-patterns cell)))
    (labels
      ((test-halfline (pat acc1)
                       (if (and pat (not (cell-playerp board (car pat) (change-player player))))
                         (if (cell-emptyp board (car pat))
                           (test-halfline (cdr pat) acc1)
                           (test-halfline (cdr pat) (1+ acc1)))
                         acc1))
       (test-line (pat acc)
                   (if pat
                     (test-line (cddr pat)
                                (max acc (+ 1
                                             (test-halfline (car pat) 0)
                                             (test-halfline (cadr pat) 0))))
                     acc)))
      (test-line pattern 0))))