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.
This commit is contained in:
Corwin Brust 2026-07-01 05:22:47 -05:00
parent fdccde0634
commit b06ca3362b
3 changed files with 80 additions and 15 deletions

6
NEWS
View file

@ -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.

View file

@ -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
;; and always observes foundation priority, so in practice only you can be
;; "stopped".
;; The AI observes foundation priority, empties its reserve first (the
;; bottleneck), prefers loading its cards onto you, and looks one move
;; 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)
"Return an AI (SOURCE . DEST) move that empties its reserve or waste, or nil.
The AI only moves its own reserve/waste tops -- onto your piles (loading)
or onto a house -- so every such move reduces the AI's cards and its turn
is guaranteed to end."
(catch 'm
(defun cg-crap--ai-unload-move (game)
"Return the best AI (SOURCE . DEST) move that empties its reserve or waste.
Emptying the RESERVE is the goal of the game, so it outscores the waste;
LOADING a card onto you (which also burdens you) outscores building a
house. Every such move reduces the AI's own cards, so its turn ends."
(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)))))))
nil))
do (let ((sc (+ base 50))) ; else build it onto a house
(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)

View file

@ -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