From b06ca3362b18440d0f1d74ed446c02338d00a712 Mon Sep 17 00:00:00 2001 From: Corwin Brust Date: Wed, 1 Jul 2026 05:22:47 -0500 Subject: [PATCH] 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 | 6 ++++ cg-crapette.el | 62 ++++++++++++++++++++++++++++++---------- test/card-games-tests.el | 27 +++++++++++++++++ 3 files changed, 80 insertions(+), 15 deletions(-) diff --git a/NEWS b/NEWS index 429db38..ce5345c 100644 --- a/NEWS +++ b/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. diff --git a/cg-crapette.el b/cg-crapette.el index 1faaeac..e68c61e 100644 --- a/cg-crapette.el +++ b/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 -;; 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) diff --git a/test/card-games-tests.el b/test/card-games-tests.el index bffa2c9..53bbc21 100644 --- a/test/card-games-tests.el +++ b/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