Need help to write the code to play the game Mancala in Lisp. There\'re two part
ID: 3629879 • Letter: N
Question
Need help to write the code to play the game Mancala in Lisp. There're two parts, this post asks for the second part which is writing the code for "Heuristic Evaluation"
Below is the game rule:
******************************
Mancala
There are several versions of this game. You may not write a program to play by any other set of rules.
Mancala is played with stones and a set of pits. There are two parallel
rows of six pits each, with two large pits located at the ends of the rows.
The large pits are called capture pits. Whichever player goes first chooses
the far row as hers, and her capture pit is the one to the left. The other
player, sitting opposite, takes the far row (from his perspective), and his
capture pit is to his left. Each of the two rows of six pits are filled
with 5 stones initially.
A move consists of a player picking up stones from a one of her six pits
and distributing them one at a time, counterclockwise around both rows, to
successive pits beginning with the one just counterclockwise of the pit from
which the stones were taken (do not drop in the capture pits). If the last pit
into which a stone is dropped has precisely two or three stones (after the
drop) and is the opponents row, then those two or three stones may be placed
in the capture pit of the player who made the move. Moreover, each preceding
pit that also has two or three stones may be captured. This stops either when
a pit is encounterd (again, backwards from the last pit to be dropped into)
with other than two or three stones, or when all stones from that row have been
captured. This means you do not capture from your own row.
Strategies thus involve distributing from available pits that will end in the
longest possible sequence of opponent-pits with two or three stones--or moves
that anticipate the development of such an arrangement. The game ends in one
of two ways. If the player whose turn it is has no stones in his row of pits,
the game is over. If the total number of stones not in capture-pits is strictly
less than ten, the game is over. Stones not captured at the moment the game ends
are left on the board, uncaptured. The winner is the player who has captured
the most stones.
*******************************************
The functions you will be writing--which manipulate the game-state representations--
are:
SPREAD-STONES (first part _ posted separately) -- picks up stones at a given pit for a given player and spreads them around the board according to rules of play; this includes writing the capture-stones portion.
HEURISTIC-EVALUATION (second part) -- applies your own measures (computational versions of the intuitions you gather about what are "good" game-states) in order to generate a score
Representation:
;;; TERMINOLOGY
;;;
;;; A = Player one B = Player two
;;; APR = Player one pit row BPR = Player two pit row
;;; AP1 = Player one pit one BP1 = Player two pit one
;;; ... ...
;;; AP6 = Player one pit six BP6 = Player two pit six
;;; ACP = Player one capture pit BCP = Player two capture pit
;;;
;;;
;;; APR => [ AP1 ] [ AP2 ] [ AP3 ] [ AP4 ] [ AP5 ] [ AP6 ]
;;;
;;; [ ACP ] [ BCP ]
;;;
;;; BPR => [ BP1 ] [ BP2 ] [ BP3 ] [ BP4 ] [ BP5 ] [ BP6 ]
;;;
;;;
;;; This version uses a list of four elements for the game state
;;; They are ( ACP (AP1 ... AP6) BCP (BP1 ... BP6) )
;;; It also assumes that the program translates the user indices, base-1 as
;;; above to the base-0 indices used by LISP functions, such as nth
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Some utility functions
(defun make-new-state (p1-capt p1-pitrow p2-capt p2-pitrow)
(list p1-capt p1-pitrow p2-capt p2-pitrow)
)
(defun make-start-state () (list 0 '(5 5 5 5 5 5) 0 '(5 5 5 5 5 5) )
)
(defun copy-state (game-state)
(make-new-state
(get-captured game-state 1)
(copy-pitrow (get-pitrow game-state 1))
(get-captured game-state 2)
(copy-pitrow (get-pitrow game-state 2))
)
)
(defun copy-pitrow (pitrow)
(cond
((null pitrow) nil)
(t (cons (car pitrow) (copy-pitrow (cdr pitrow))))
)
)
(defun get-captured (game-state player-index)
(cond
((= player-index 1) (car game-state))
((= player-index 2) (caddr game-state)) )
)
(defun get-pitrow (game-state player-index)
(cond
((= player-index 1) (cadr game-state))
((= player-index 2) (cadddr game-state)) )
)
(defun get-pit (game-state player-index pit-index)
(nth pit-index (get-pitrow game-state player-index))
)
(defun set-captured (game-state player-index new-captured-val)
(cond
((= player-index 1) (setf (car game-state) new-captured-val))
((= player-index 2) (setf (caddr game-state) new-captured-val))
)
)
(defun set-pitrow (game-state player-index new-pitrow)
(cond
((= player-index 1) (setf (cadr game-state) new-pitrow))
((= player-index 2) (setf (cadddr game-state) new-pitrow))
)
)
(defun set-pit (game-state player-index pit-index new-pitval)
(cond
((= player-index 1) (setf (nth pit-index (get-pitrow game-state 1)) new-pitval))
((= player-index 2) (setf (nth pit-index (get-pitrow game-state 2)) new-pitval))
)
)
(defun print-game-state (game-state)
(terpri)
(print-pitrow (get-pitrow game-state 1))
(terpri)
(print-capture-pits (get-captured game-state 1) (get-captured game-state 2) )
(terpri)
(print-pitrow (get-pitrow game-state 2))
(terpri) (terpri)
)
(defun print-pitrow (pitrow)
(format t " [~d] [~d] [~d] [~d] [~d] [~d]"
(nth 0 pitrow) (nth 1 pitrow) (nth 2 pitrow)
(nth 3 pitrow) (nth 4 pitrow) (nth 5 pitrow)
)
)
(defun print-capture-pits (pit1 pit2)
(format t "<< ~d >> 1 2 3 4 5 6 << ~d >>"
pit1 pit2
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Some test functions - requires you to have written spread-stones
;;; You could comment out that part just to test the basic game states
(defun test1 ()
(let*
(
(t1 (make-new-state 0 '(3 1 1 1 1 1) 0 '(2 2 1 4 5 2)))
(t2 (spread-stones (copy-state t1) 1 0))
)
(print-game-state t1)
(print-game-state t2)
)
)
(defun test2 ()
(let*
(
(t1 (make-new-state 0 '(3 1 1 1 1 1) 0 '(2 2 1 4 5 2)))
(t2 (spread-stones (copy-state t1) 2 5))
)
(print-game-state t1)
(print-game-state t2)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; SPREAD-STONES -- (suggested format)
;;; Expects to receive a modifiable copy of the game-state
;;; and integers: player-index and pit-index (from which move occurs)
;;; DO NOT JUST HAND IT AN ORIGINAL GAME STATE
;;; Modifies this copy and then returns it as new state after move and capture
;;; Possible helpers you could write to implement this function.
;;; TAKE-STONES (from a pit), RECURSIVE-SPREAD-HELPER (to do the count updates
;;; around the pits), CAPTURE-STONES (to recursively walk backwards around
;;; the pits and place pits in the appropriate capture pit as necessary; the
;;; recursive part is another good candidate for a helper function)
(defun spread-stones (game-state player-index pit-index)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; HEURISTIC-EVALUATION -- (required format; this one of yours will be called)
;;; Expects to receive a game-state and player-index and will NOT modify either
;;; Your heuristic function should return a score from the closed interval [0,100]
(defun heuristic-evaluation-XXXX (game-state player-index)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; GENERATE-CHILDREN - provided
;;; Expects to receive a game-state and player-index and will NOT modify either
;;; Will produce index/state pairs in a list of all the game-states produced
;;; from each pit for the given player. These states are produced by calls
;;; to your own local spread-stones--which handles capturing also. Any empty
;;; pit will produce a NIL state. The game-states in these should be modifiable
;;; (each a copy of its parent, modified and returned as new, just as described
;;; for the spread-stones function. Below is an example of what this returns.
;;; Example result: ( (1 (..g-s...)) (2 nil) (3 (..g-s...)) ... )
(defun generate-children (game-state player-index)
(mapcar
#'(lambda (index)
(cond
((= 0 (get-pit game-state player-index index))
`(,(+ index 1) nil)
)
(t
`(,(+ index 1) ,(spread-stones
(copy-state game-state)
player-index
index
)
)
)
)
)
'(0 1 2 3 4 5)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; ENDTEST -- partially provided
;;; Expects to receive a game-state and player-index and will NOT modify either
;;; Will return NIL if condition for game conclusion is NOT met, and either
;;; the symbol P1 if player 1 won or the symbol P2 if player 2 won.
;;; The symbol 'TIE will be returned for a tie (not nil)
;;; This will be used in conjunction with win-test in the remainder of the
;;; provided code.
(defun end-test (game-state player-index)
(cond
((or
;; there are no moves available to the current player
(null
(member t
(mapcar
#'(lambda (itm) (not (zerop itm)))
(get-pitrow game-state player-index)
)
)
)
;; the total number of stones in play is < 10
(<
(+
(apply #'+ (get-pitrow game-state player-index))
(apply #'+ (get-pitrow game-state
(cond ((= player-index 1) 2)
((= player-index 2) 1)
))
)
)
10
)
)
;;; then return true
t
)
;;; otherwise return false (nil)
(t nil)
)
)
Explanation / Answer
#| Board Representation
x1 x2 x3 x4 x5 x6 <-- Player 1 (M1 = Player 1's Mancala)
M1 M2
y1 y2 y3 y4 y5 y6 <-- Player 2 (M2 = Player 2's Mancala)
List representation:
(M1 (x6 x5 x4 x3 x2 x1) M2 (y1 y2 y3 y4 y5 y6))
|#
;;; Abstract Data Functions
;; Get Bin
;; Returns a list representating the player's bin
(defun Get-Bin (board player)
(cond ((= player 1)
(second board))
(T (fourth board))))
;; Get Mancala
;; Returns the Mancala of the player (ie: the number of stones)
(defun Get-Mancala (board player)
(cond ((= player 1)
(first board))
(T (third board))))
;; Other Player Function
;; Returns other player
(defun other-player (player)
(cond ((= player 1) 2)
(T 1)))
;;; Static Board Evaulator Function
;;; Checks a board and returns a number representing the
;;; "goodness" of the board in relation to the player of
;;; the current turn.
;; Helper Functions
;; help determine value by calculating various parts of the board
;; Stones in Bin
;; Returns the number of stones in the players Bin
(defun Count-stones (bin)
(cond ((null bin) 0)
(T (+ (first bin) (Count-stones (rest bin))))))
(defun stones-in-bin (board player)
(Count-stones (Get-Bin board player)))
;; Checks to see if player can move
(defun Game-Over-p (board whos-turn)
(cond ((= (empty-in-bin board whos-turn)
(length (Get-bin board whos-turn))) T)
(T nil)
)
)
;; Empty in Bin Function
;; Returns the number of empty spaces in the players bin
(defun Count-empty (bin)
(cond ((null bin) 0)
((= (first bin) 0)
(+ 1 (Count-empty (rest bin))))
(T (Count-Empty (rest bin)))))
(defun empty-in-bin (board player)
(Count-empty (Get-Bin board player)))
;; Total Stones function
;; Returns the total stones controlled by Player (bin + mancala)
(defun Total-Stones (board player)
(+ (stones-in-bin board player)
(Get-Mancala board player)))
;; Win Lose Value function
;; Returns -100 if the board is a lose and +100 if the board is a win
(defun Win-Lose-Value (board whos-perspective)
(cond ((< (Total-Stones board whos-perspective)
(Total-Stones board (other-player whos-perspective)))
-100)
((= (Total-Stones board whos-perspective)
(Total-Stones board (other-player whos-perspective)))
0)
(T +100)
)
)
;; Calculates the value of a bin.
(defun Calc-stuff (board player)
(+ (stones-in-bin board player)
(empty-in-bin board player)
(Get-mancala board player)))
(defun static-board-evaluate (board whos-turn whos-perspective)
(cond ((Game-Over-p board whos-turn)
(Win-Lose-Value board whos-turn))
((eql whos-turn whos-perspective)
(- (Calc-stuff board whos-turn)
(Calc-stuff board (other-player whos-turn))))
(T (- (Calc-stuff board (other-player whos-perspective))
(Calc-stuff board whos-perspective)))
))
;;; Generate Moves Function
;;; Generates all the possible moves from the current board.
;; Front End Of Bin function
;; Returns the first x elements of a list
(defun front-end-of-bin (full-bin length)
(cond ((= length 0) nil)
(T (cons (first full-bin)
(front-end-of-bin (rest full-bin) (- length 1))))
)
)
;; Board To List function
;; Converts the standard board format into a list representing the
;; counter-clockwise movement around the board.
(defun board-to-list (board whos-turn rest-of-bin)
(append rest-of-bin
(list (get-mancala board whos-turn))
(get-bin board (other-player whos-turn))
(front-end-of-bin (get-bin board whos-turn)
(- (length (get-bin board whos-turn))
(length rest-of-bin)))
)
)
;; Extract Mancala Function
;; Finds the value of the Mancala in the board-list given
;; by using the bin-length to find the position.
(defun Extract-mancala (board-list bin-length)
(nth bin-length board-list)
)
;; Get Back Value Function
;; Returns the last x values in the list
(defun Get-Back-Value-Helper (list x)
(cond ((= x 0) nil)
(T (cons (first list)
(Get-Back-Value-Helper (rest list) (- x 1))))
)
)
(defun Get-Back-Value (list x)
(reverse (Get-Back-Value-Helper (reverse list) x))
)
;; Get Middle Values function
;; Gets amount values starting at element start in the list
(defun Get-Middle-Helper (list start amount position taken)
(cond ((< position start)
(Get-Middle-Helper (rest list) start amount
(+ 1 position) taken))
((= taken amount) nil)
(T (cons (first list)
(Get-Middle-Helper (rest list) start amount
(+ 1 position) (+ 1 taken))))
)
)
(defun Get-Middle-Values (list start amount)
(Get-Middle-Helper list start amount 0 0)
)
;; Make Last 0 function
;; Changes the last number in the list to zero
(defun Make-Last-0 (list)
(reverse (cons 0 (rest (reverse list)))))
;; Rebuild Board function
;; Takes the list form of the board and converts it back to the original
;; format.
(defun Rebuild-board (board board-list whos-turn bin-length)
(cond ((eql whos-turn 1)
(list (Extract-mancala board-list bin-length)
(append (Get-Back-Value board-list
(- (length (Get-bin board whos-turn))
bin-length))
(Front-end-of-bin board-list bin-length))
(Get-mancala board 2)
(Get-Middle-Values board-list
(+ 1 bin-length)
(length (Get-bin board whos-turn)))
)
)
(T
(list (Get-mancala board 1)
(Get-Middle-Values board-list
(+ 1 bin-length)
(length (Get-bin board whos-turn)))
(Extract-mancala board-list bin-length)
(append (Get-Back-Value board-list
(- (length (Get-bin board whos-turn))
bin-length))
(Front-end-of-bin board-list bin-length))))
)
)
;; Move Stones Around function
;; Distributes the stones from one bin around the board.
(defun Moves-Stones-Around (board-list number)
(cond ((= number 0) board-list)
(T (cons (+ 1 (first board-list))
(Moves-Stones-Around (rest board-list) (- number 1))))
)
)
(defun Make-moves (board whos-turn bin)
(Rebuild-board board
(Make-last-0
(Moves-Stones-around
(Board-to-list board whos-turn (rest bin))
(first bin)))
whos-turn
(- (length bin) 1)
)
)
(defun generate-moves-helper (board whos-turn bin)
(cond ((null bin) nil)
((= 0 (first bin))
(generate-moves-helper board whos-turn (rest bin)))
(T (cons (make-moves board whos-turn bin)
(generate-moves-helper board whos-turn (rest bin))))
)
)
(defun generate-moves (board whos-turn)
(generate-moves-helper board whos-turn (Get-bin board whos-turn))
)
;;; Print Board Function
;;; Prints the current board in a game-style format
(defun board-printer (board)
(format t "~3T ~A" (second board))
(format t "~% ~A" (first board))
(print-depth-indented board)
(format t "~A ~%" (third board))
(format t "~3T ~A" (fourth board))
nil
)
(defun make-indention-string (board)
(format nil "~~~A,4T" (* 3 (length (Get-bin board 1))))
)
(defun print-depth-indented (board)
(format T "~@? " (make-indention-string board))
)
;;; Conversion Functions
;; Universal -> Internal Board
;; converts the universal board format to the format used by the program.
(defun universal-2-board (universal-board)
(list (fourth universal-board)
(third universal-board)
(first universal-board)
(second universal-board))
)
;; Internal -> Universal
;; converts the internal board format to the universal board format.
(defun board-2-universal (internal-board number-of-bins)
(list (Get-mancala internal-board 2)
(get-bin internal-board 2)
(get-bin internal-board 1)
(get-mancala internal-board 1))
)
;;; Mancala Move Function
;;; Main controlling function
;;; Returns the best possible move
(defun mancala-move (board number-of-bins number-stones-per-bin whos-move
moves-ahead print-p)
(setq nodes 0)
(Get-Best (CVL board whos-move whos-move moves-ahead print-p))
)
;; Get Best function
;; Finds the board with the highest value
(defun Get-Best (board-list &optional (dotted-board '(a . -100)))
(cond ((null board-list) (first dotted-board))
((> (rest (first board-list)) (rest dotted-board))
(Get-Best (rest board-list) (first board-list)))
(T (Get-Best (rest board-list) dotted-board))
)
)
;;; Find-Min function
;;; Returns the value of the board with the lowest value
(defun Find-Min (dotted-board-list &optional (lowest 100))
(cond ((null dotted-board-list) lowest)
((< (rest (first dotted-board-list)) lowest)
(Find-Min (rest dotted-board-list)
(rest (first dotted-board-list))))
(T (Find-Min (rest dotted-board-list) lowest))
)
)
;;; Attach Lowest Function
;;; Attaches to a board the lowest value produced from its possible
;;; next-boards.
(defun Attach-Lowest (board board-list)
(cons board (Find-Min board-list))
)
;;; Attach Highest Function
;;; Attaches to a board the highest value produced from its possible
;;; next-boards.
(defun Attach-Highest (board board-list)
(cons board (Find-Max board-list))
)
;;; Find-Max function
;;; Returns the value of the board with the highest value
(defun Find-Max (dotted-board-list &optional (highest -100))
(cond ((null dotted-board-list) highest)
((> (rest (first dotted-board-list)) highest)
(Find-Max (rest dotted-board-list)
(rest (first dotted-board-list))))
(T (Find-Max (rest dotted-board-list) highest))
)
)
;;; Leaf Search function
;;; Finds the value of each board at the leaf level of the tree.
;;; Returns a list of boards dotted with their respective value
;;; due to static-board-evaluate.
;;; ie: ((board1 . value1) (board2 . value2) (board3 . value3) etc...)
(defun leaf-search (board-list whos-turn whos-perspective)
(mapcar #'(lambda (x) (cons x (static-board-evaluate x whos-turn
whos-perspective)))
board-list))
;;; Contruct Value List function
;;; Constructs a list a boards dotted with values based on
;;; Subtrees of that board. (ie. If the boards are not at the leaf
;;; level.
;;; This is the MinMax function
(setq nodes 0)
(defun CVL (board whos-turn whos-perspective level print-p)
(setq nodes (+ 1 nodes))
(cond ((= level 1) (leaf-search (generate-moves board whos-turn)
whos-turn whos-perspective) )
((= whos-turn whos-perspective)
(cond (print-p (format t "~A ~%" (generate-moves
board
whos-turn))))
(mapcar #'(lambda (x)
(attach-Highest x
(CVL x (other-player whos-turn)
whos-perspective
(- level 1) print-p)))
(generate-moves board whos-turn)))
(T
(cond (print-p (format t "~A ~%" (generate-moves
board
whos-turn))))
(mapcar #'(lambda (x)
(attach-Lowest x
(CVL x (other-player whos-turn)
whos-perspective
(- level 1) print-p)))
(generate-moves board whos-turn)))
)
)
;;;; Dribbled Examples
#|
> (mancala-move '(1 (0 6 6 5 5 1) 1 (0 6 6 5 5 1)) 6 4 1 4 nil)
(2 (0 6 6 5 0 2) 1 (1 7 7 5 5 1))
> (mancala-move '(2 (0 6 6 5 0 2) 1 (1 7 7 5 5 1)) 6 4 2 5 nil)
(2 (0 6 6 5 0 2) 1 (0 8 7 5 5 1))
> (mancala-move '(2 (0 6 6 5 0 2) 1 (0 8 7 5 5 1)) 6 4 1 3 T)
((3 (0 0 7 6 1 3) 1 (1 8 7 5 5 1)) (3 (0 6 0 6 1 3) 1 (1 9 7 5 5 1)) (3 (0 6 6 0 1 3) 1 (1 9 7 5 5 1)) (3 (0 6 6 5 0 0) 1 (1 8 7 5 5 1)))
((3 (0 0 7 6 1 3) 1 (0 9 7 5 5 1)) (3 (1 1 8 6 1 3) 2 (1 0 8 6 6 2)) (3 (1 1 8 6 1 3) 2 (1 8 0 6 6 2)) (3 (1 1 7 6 1 3) 2 (1 8 7 0 6 2)) (3 (1 1 8 6 1 3) 2 (1 8 7 5 0 2)) (3 (0 0 7 6 1 3) 2 (1 8 7 5 5 0)))
((3 (0 6 0 6 1 3) 1 (0 10 7 5 5 1)) (3 (1 7 1 7 1 3) 2 (1 0 8 6 6 2)) (3 (1 7 1 6 1 3) 2 (1 9 0 6 6 2)) (3 (1 7 0 6 1 3) 2 (1 9 7 0 6 2)) (3 (1 7 1 6 1 3) 2 (1 9 7 5 0 2)) (3 (0 6 0 6 1 3) 2 (1 9 7 5 5 0)))
((3 (0 6 6 0 1 3) 1 (0 10 7 5 5 1)) (3 (1 7 7 1 1 3) 2 (1 0 8 6 6 2)) (3 (1 7 7 0 1 3) 2 (1 9 0 6 6 2)) (3 (1 7 6 0 1 3) 2 (1 9 7 0 6 2)) (3 (1 7 7 0 1 3) 2 (1 9 7 5 0 2)) (3 (0 6 6 0 1 3) 2 (1 9 7 5 5 0)))
((3 (0 6 6 5 0 0) 1 (0 9 7 5 5 1)) (3 (1 7 7 5 0 0) 2 (1 0 8 6 6 2)) (3 (1 7 7 5 0 0) 2 (1 8 0 6 6 2)) (3 (1 7 6 5 0 0) 2 (1 8 7 0 6 2)) (3 (1 7 7 5 0 0) 2 (1 8 7 5 0 2)) (3 (0 6 6 5 0 0) 2 (1 8 7 5 5 0)))
(3 (0 6 6 0 1 3) 1 (1 9 7 5 5 1))
> (dribble)
;;; Dribble file "dribble.file" finished
|#
;;; EOF
;;;;;;;