Frozen
Here is an active version
Use of Memoized Function and Minor Improvements
Although I lose to AI, it can not defeat the monster from the 11th hour game 
And, until I have ideas for improving his work, I’ll do the decorations. To begin with, we will simplify the construction of templates for checking neighboring cells, and at the same time we will make it memoized.
A little combing
;; 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)))))
Several auxiliary predicates
Expressions like (if (eql *ai-player* (game-node-player tree)) do not look nice, so we’ll introduce some predicates.
;; 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)))
New Heuristics
The difference from the old one is that the old one scores the position by counting the lengths of the already constructed lines of the chips, and the new one allows empty cells between the AI cells. In other words, it takes into account potential lines of the chips. Just say that it still does not allow AI to defeat the computer from the 11th hour.
;; 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))))