Update progress from Chapter 18: Lazy Programming @ Dice of Doom v2

This implementations of new dice-of-doom seems a little buggy, but now
are working fine.

Let's see if this shit works until the end.

> shoot me down

README.md

@@ -4,7 +4,7 @@ The current content are answers plus code covering of the book [Land of Lisp](ht
 
 
 # Land of Lisp book (reading) [386/482]
-![progress](http://progressed.io/bar/80)
+![progress](http://progressed.io/bar/81)
 
 
  - [x] Section I: Lisp is Power

land-of-lisp/cap18-dice-of-doom-v2.lisp

@@ -66,22 +66,85 @@
   (princ "choose your move:")
   (let ((moves (caddr tree)))
     (labels ((print-moves (moves n)
-               (unless (lazy-null moves)
-                 (let* ((move (lazy-car moves))
-                        (action (car move)))
-                   (fresh-line)
-                   (format t "~a. " n)
-                   (if action
-                       (format t "~a -> ~a" (car action)
-                               (cadr action)))
-                   (princ "end turn")))
-               (print-moves (lazy-cdr moves) (1+ n))))
+               (unless (null moves) ;; hacky fix
+                 (unless (lazy-null moves)
+                   (let* ((move (lazy-car moves))
+                          (action (car move)))
+                     (fresh-line)
+                     (format t "~a. " n)
+                     (if action
+                         (format t "~a -> ~a" (car action) (cadr action))
+                         (princ "end turn"))))
+                 (print-moves (lazy-cdr moves) (1+ n)))))
       (print-moves moves 1))
     (fresh-line)
     (cadr (lazy-nth (1- (read)) moves))))
 
 (defun play-vs-human (tree)
-  (print-info tree)
-  (if (not (lazy-null (caddr tree)))
+  (print-info tree)  (if (not (lazy-null (caddr tree)))
       (play-vs-human (handle-human tree))
       (announce-winner (cadr tree))))
+
+
+(defun limit-tree-depth (tree depth)
+  (list (car tree)
+        (cadr tree)
+        (if (zerop depth)
+            (lazy-nil)
+            (lazy-mapcar (lambda (move)
+                           (list (car move)
+                                 (limit-tree-depth (cadr move) (1- depth))))
+                         (caddr tree)))))
+
+
+(defparameter *ai-level* 4) ;; depth to look on tree of game
+
+(defun handle-computer (tree)
+  (let ((ratings (get-ratings (limit-tree-depth tree *ai-level*)
+                              (car tree))))
+    (cadr (lazy-nth (position (apply #'max ratings) ratings)
+                    (caddr tree)))))
+
+
+(defun play-vs-computer (tree)
+  (print-info tree)
+  (cond ((lazy-null (caddr tree)) (announce-winner (cadr tree)))
+        ((zerop (car tree)) (play-vs-computer (handle-human tree)))
+        (t (play-vs-computer (handle-computer tree)))))
+
+(defun threatened (pos board)
+  (let* ((hex (aref board pos))
+         (player (car hex))
+         (dice (cadr hex)))
+    (loop for n in (neighbors pos)
+          do (let* ((nhex (aref board n))
+                    (nplayer (car nhex))
+                    (ndice (cadr nhex)))
+               (when (and (not (eq player nplayer))
+                          (> ndice dice))
+                 (return t))))))
+
+
+(defun score-board (board player)
+  (loop for hex across board
+        for pos from 0
+        sum (if (eq (car hex) player)
+                (if (threatened pos board)
+                    1
+                    2)
+                -1)))
+
+(defun get-ratings (tree player)
+  (take-all (lazy-mapcar (lambda (move)
+                           (rate-position (cadr move) player))
+                         (caddr tree))))
+
+(defun rate-position (tree player)
+  (let ((moves (caddr tree)))
+    (if (not (lazy-null moves))
+        (apply (if (eq (car tree) player)
+                   #'min
+                   #'max)
+               (get-ratings tree player))
+        (get-ratings tree player))
+    (score-board (cadr tree) player)))