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:
parent
fdccde0634
commit
b06ca3362b
3 changed files with 80 additions and 15 deletions
6
NEWS
6
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.
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue