Yellow Rabbit

Use of Memoized Function and Minor Improvements

Trilobite Game in Lisp: Minor Improvements

Although I lose to AI, it can not defeat the monster from the 11th hour game :frowning: 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))))