Crapette: a craftier AI (reserve-first, loads you, rearranges houses)

* cg-crapette.el (cg-crap--ai-unload-move): scored move choice preferring
new priority chain; raise the loop guard.  Update the commentary.
* test/card-games-tests.el: add cgt-crap-ai-enabling, cgt-crap-ai-loads-you.
* NEWS: note the smarter opponent.

NEWS

@@ -71,6 +71,12 @@ the mouse as well as the keyboard.
     "Next hand" button and the hand fan.
   - Live multiplayer 500 over TCP (~M-x cg-bid-host~ / ~M-x cg-bid-join~).
 
+** A craftier Russian Bank (Crapette) opponent
+  - The computer now empties its reserve first (the pile you must clear to
+    win), prefers loading its cards onto you, and -- new -- looks a move
+    ahead to rearrange the houses when doing so frees a card it could not
+    otherwise place.
+
 ** Playtest fixes
   - ~q~ now returns to the ~M-x card-game~ menu from any game, instead of
     burying the buffer and leaving the previous buffer on screen.

cg-crapette.el

@@ -56,9 +56,11 @@
 ;; somewhere you keep going, otherwise it goes to your waste and your turn
 ;; ends.
 ;;
-;; SIMPLIFICATION (documented): the AI is a straightforward greedy player
+;; The AI observes foundation priority, empties its reserve first (the
-;; and always observes foundation priority, so in practice only you can be
+;; bottleneck), prefers loading its cards onto you, and looks one move
-;; "stopped".
+;; ahead to rearrange the houses when that frees a stuck reserve or waste
+;; card.  It never breaks foundation priority, so in practice only you can
+;; be "stopped".
 
 ;;; Code:
 
@@ -433,32 +435,62 @@ Return non-nil when the offending action must be abandoned by its caller."
            for fi = (and card (cg-crap--found-for game card))
            when fi return (cons spot (cons 'found fi))))
 
-(defun cg-crap--ai-useful-move (game)
+(defun cg-crap--ai-unload-move (game)
-  "Return an AI (SOURCE . DEST) move that empties its reserve or waste, or nil.
+  "Return the best AI (SOURCE . DEST) move that empties its reserve or waste.
-The AI only moves its own reserve/waste tops -- onto your piles (loading)
+Emptying the RESERVE is the goal of the game, so it outscores the waste;
-or onto a house -- so every such move reduces the AI's cards and its turn
+LOADING a card onto you (which also burdens you) outscores building a
-is guaranteed to end."
+house.  Every such move reduces the AI's own cards, so its turn ends."
-  (catch 'm
+  (let ((best nil) (bestscore 0))
     (dolist (spot (list (cons 'res 1) (cons 'was 1)))
-      (let ((card (cg-crap--spot-top game spot)))
+      (let ((card (cg-crap--spot-top game spot))
+            (base (if (eq (car spot) 'res) 40 0)))   ; the reserve is the bottleneck
         (when card
           (dolist (dst (list (cons 'res 0) (cons 'was 0)))
             (when (cg-crap--load-accepts (cg-crap--spot-top game dst) card)
-              (throw 'm (cons spot dst))))
+              (let ((sc (+ base 60)))                ; loading: rid a card AND burden you
+                (when (> sc bestscore)
+                  (setq bestscore sc best (cons spot dst))))))
           (cl-loop for i below 8
                    when (cg-crap--house-accepts game i card)
-                   do (throw 'm (cons spot (cons 'house i)))))))
+                   do (let ((sc (+ base 50)))        ; else build it onto a house
-    nil))
+                        (when (> sc bestscore)
+                          (setq bestscore sc best (cons spot (cons 'house i)))))
+                   (cl-return)))))
+    best))
+
+(defun cg-crap--ai-enabling-move (game)
+  "Return a single-card house->house move that unlocks an unload, or nil.
+This is the crafty bit: when the AI cannot place its reserve or waste top
+anywhere, it looks one move ahead for a house rearrangement that would
+make such a placement legal.  It only fires when no direct unload exists,
+and only when the shuffle genuinely opens one, so the turn still ends."
+  (when (null (cg-crap--ai-unload-move game))
+    (catch 'found
+      (dotimes (i 8)
+        (dotimes (j 8)
+          (let ((pilei (cg-crap--house game i)) (pilej (cg-crap--house game j)))
+            (when (and (/= i j) pilei)
+              (let ((card (cg-crap--top pilei)))
+                (when (cg-crap--house-accepts game j card)
+                  (aset (cg-get game :houses) i (butlast pilei 1))
+                  (aset (cg-get game :houses) j (append pilej (list card)))
+                  (let ((opens (cg-crap--ai-unload-move game)))
+                    (aset (cg-get game :houses) i pilei)
+                    (aset (cg-get game :houses) j pilej)
+                    (when opens
+                      (throw 'found (cons (cons 'house i) (cons 'house j)))))))))))
+      nil)))
 
 (defun cg-crap--ai-play (game)
   "Play the AI opponent's whole turn on GAME."
   (let ((guard 0))
     (catch 'done
       (while t
-        (when (> (setq guard (1+ guard)) 400) (throw 'done nil))
+        (when (> (setq guard (1+ guard)) 800) (throw 'done nil))
         (when (cg-crap--won-p game 1) (throw 'done nil))
         (let ((mv (or (cg-crap--ai-found-move game)
-                      (cg-crap--ai-useful-move game))))
+                      (cg-crap--ai-unload-move game)
+                      (cg-crap--ai-enabling-move game))))
           (cond
            (mv (cg-crap--move game (car mv) (cdr mv) 1))
            ((cg-crap--hand game 1)

test/card-games-tests.el

@@ -760,6 +760,33 @@
     (let ((cg-crap--recording nil)) (cg-crap--ai-play g))
     (should (eq (cg-get g :winner) 1))))     ; plays its last card, wins
 
+(ert-deftest cgt-crap-ai-enabling ()
+  ;; reserve 5D cannot be placed until the AI shifts 6H off 6S (crafty rearrange)
+  (let ((g (cg-crap--deal (cg-crapette-game))))
+    (aset (cg-get g :reserve) 1 (list '(2 . 4)))            ; 5 of diamonds
+    (aset (cg-get g :waste) 1 nil) (aset (cg-get g :hand) 1 nil)
+    (aset (cg-get g :reserve) 0 nil) (aset (cg-get g :waste) 0 nil)
+    (aset (cg-get g :found) 0 nil)
+    (aset (cg-get g :houses) 0 (list '(0 . 5) '(3 . 5)))    ; 6S (bottom), 6H (top)
+    (aset (cg-get g :houses) 1 (list '(1 . 6)))             ; 7C
+    (dotimes (k 6) (aset (cg-get g :houses) (+ 2 k) (list '(2 . 6)))) ; 7D fillers, none empty
+    (cg-put g :turn 1)
+    (let ((cg-crap--recording nil)) (cg-crap--ai-play g))
+    (should (null (cg-crap--reserve g 1)))))                ; it unstuck and unloaded
+
+(ert-deftest cgt-crap-ai-loads-you ()
+  ;; reserve 6D loads onto your reserve top 7D; the AI should prefer that
+  (let ((g (cg-crap--deal (cg-crapette-game))))
+    (aset (cg-get g :reserve) 1 (list '(2 . 5)))            ; 6D
+    (aset (cg-get g :waste) 1 nil) (aset (cg-get g :hand) 1 nil)
+    (aset (cg-get g :reserve) 0 (list '(2 . 6)))            ; your reserve top 7D
+    (aset (cg-get g :waste) 0 nil) (aset (cg-get g :found) 0 nil)
+    (dotimes (k 8) (aset (cg-get g :houses) k (list '(1 . 10)))) ; nowhere on a house, none empty
+    (cg-put g :turn 1)
+    (let ((cg-crap--recording nil)) (cg-crap--ai-play g))
+    (should (null (cg-crap--reserve g 1)))
+    (should (member '(2 . 5) (cg-crap--reserve g 0)))))     ; loaded onto you
+
 (ert-deftest cgt-crap-house-run ()
   (let ((g (cg-crap--deal (cg-crapette-game))))
     (aset (cg-get g :houses) 0 (list '(2 . 8) '(0 . 7) '(3 . 6)))  ; 9D 8S 7H