Старая версия
Здесь находится настоящий сайт
Использование запоминающей функции и мелкие улучшения
Хотя я проигрываю AI, он не может победить монстра из 11-го часа 
И, пока у меня не появилось идей по улучшению его работы, займусь украшательствами. Для начала чуть-чуть упростим построение шаблонов для проверки соседних ячеек, ну и заодно сделаем её запоминающей.
Немного причёсывания
;; 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))))