;mancala.scm ;Written by: Yoav Keren ;Last modified on: 8/18/03 ;Plays the complete mancala game between two human players ;initial board (define board '(4 4 4 4 4 4 0 4 4 4 4 4 4 0)) ;location 7 contains player 2's captured stones and location 14 contains player 1's captured stones ;graphical definitions (define STONE-FONT-SIZE 10) ;size of number displayed within each pit (define GAME-FONT-SIZE 5) ;size of fonts for numbers displayed elsewhere on the board (define WIDTH 510) ;board width (define HEIGHT 250) ;board height (define SMALL-RADIUS 20) ;radius of small pits (define BIG-RADIUS 40) ;redius of big pits (define HEIGHT-DISTANCE 5) ;distance for vertical starting point calculation (define WIDTH-DISTANCE 10) ;distance for the horizontal starting point (define RADIUS-W-DISTANCE (- WIDTH (* 2 BIG-RADIUS) (* 3 WIDTH-DISTANCE) SMALL-RADIUS)) ;distance among centers of pits (define RADIUS-H-D-DISTANCE (+ (/ HEIGHT 2) SMALL-RADIUS HEIGHT-DISTANCE)) ;distance among center of pits and top of board (define RADIUS-H-U-DISTANCE (- (/ HEIGHT 2) SMALL-RADIUS HEIGHT-DISTANCE)) ;distance among center of pits and bottom of board (define NUM-DISTANCE (+ (* 2 SMALL-RADIUS) WIDTH-DISTANCE)) ;distance between the display numbers inside pits (define LEFT-DISTANCE (+ BIG-RADIUS (* 2 WIDTH-DISTANCE))) ;distance between left and right of boards and big pits (define START-LEFT-POS (+ LEFT-DISTANCE BIG-RADIUS SMALL-RADIUS WIDTH-DISTANCE)) ;starting position for location numbers to be displayed ;endgame? ;Purpose: To determine if the game has reached its end (i.e. no more moves left) ;Inputs: board - the game board, num - recursive variable used for referencing locations on the board ;Outputs: boolean, true if game is at the end, false otherwise (define endgame? (lambda (board num) ;checks that the board has reached end on the desired player's side (pending on num) ;returns true if it has been reached (if (or (> (index board 7) 24) (> (index board 14) 24) (= num 14)) #t ;checks if pit is empty, continues to the next pit if so, returns false otherwise (if (or (zero? (index board num)) (= num 7)) (endgame? board (+ num 1)) #f)))) ;ask-move? ;Purpose: To display a request from the player to make a move ;Inputs: player - the number of player whose turn it is ;Outputs: output of the request (define ask-move (lambda (player) (begin (display "player ") (display player) (display " select location: ")))) ;move ;Purpose: To complete a move by a player and return the new board ;Inputs: board - the board at its current state, player - the number of player whose turn it is, ; loc - the location the player has chosen to play from, game - type of game played ;Outputs: the board at the updated state (define move (lambda (board player loc game) (let* ((playloc (+ loc (* 7 (- 2 player)))) ;gets the actual location on board (newboard (set-index board playloc 0))) ;sets location to be 0 (cond ;makes move pending on game-type, since moves vary among game types [(eq? game 'owari) (make-move-owari newboard player playloc (+ playloc 1) (index board playloc))] [(eq? game 'wari) (make-move-wari newboard player playloc (+ playloc 1) (index board playloc))])))) ;make-move-wari ;Purpose: auxilary function used to help complete the move in the version of wari ;Inputs: board - the board at its current state, player - the number of player whose turn it is, ; loc - the location the player has chosen to play from, ; start - variable used to complete the move from one spot to the other, val - the number of seeds at player's hand ;Outputs: the board after the move compeltes (define make-move-wari (lambda (board player loc start val) ;if location is starting position, keep it empty (if (= start loc) (make-move-wari board player loc (+ start 1) val) ;if no stones left, return the board (if (zero? val) board ;else check if big pits were reached (if (= start 14) ;check whether big pit corresponds to play (if (= player 1) ;if so, put a stone in big pit and keep playing ;otherwise, ignore pit and keep playing (let ((newboard (set-index board start (+ (index board start) 1)))) (make-move-wari newboard player loc 1 (- val 1))) (make-move-wari board player loc 1 val)) (if (= start 7) (if (= player 2) (let ((newboard (set-index board start (+ (index board start) 1)))) (make-move-wari newboard player loc (+ start 1) (- val 1))) (make-move-wari board player loc (+ start 1) val)) (let ((newboard (set-index board start (+ (index board start) 1)))) (make-move-wari newboard player loc (+ start 1) (- val 1))))))))) ;make-move-owari ;Purpose: auxilary function used to help complete the move in the version of owari ;Inputs: board - the board at its current state, player - the number of player whose turn it is, ; loc - the location the player has chosen to play from, ; start - variable used to complete the move from one spot to the other, val - the number of seeds at player's hand ;Outputs: the board after the move compeltes (define make-move-owari (lambda (board player loc start val) ;if the current location is the same as the starting location (if (= start loc) (make-move-owari board player loc (+ start 1) val) ;if reached end of board, go to location 1 (if (= start 14) (make-move-owari board player loc 1 val) ;if reached mancala of player 2, ignore it (if (= start 7) (make-move-owari board player loc (+ start 1) val) (let ((newboard (set-index board start (+ (index board start) 1)))) ;in case last seeds is put, prepare for capture checking (i.e. stop cycling) ;else, keep cycling (if (= val 1) (capture-series newboard player start) (make-move-owari newboard player loc (+ start 1) (- val 1))))))))) ;capture-series ;Purpose: To capture all possible seeds starting at given location ;Inputs: board - the board at its current state, player - the number of player whose turn it is, ; start - current location of the hand to capture from ;Outputs: the board after all captures were completed (define capture-series (lambda (board player start) (if (> start 0) ;checks if pits have 2 or 3 stones and in valid position for player. ;if so, captures them, and goes to previous pit. ;otherwise, returns board (if (or (= (index board start) 2) (= (index board start) 3)) (if (and (= player 1) (< start 7)) (let ((newboard (capture-single board player start))) (capture-series newboard player (- start 1))) (if (and (= player 2) (> start 7)) (let ((newboard (capture-single board player start))) (capture-series newboard player (- start 1))) board)) board) board))) ;capture-single ;Purpose: To capture seeds from a single location ;Inputs: board - the board at its current state, player - the number of player whose turn it is, ; loc - the location from which the seed will be captured ;Outputs: the board after the seeds were captured from desired location (define capture-single (lambda (board player loc) (let ((val (index board loc)) (newboard (set-index board loc 0)) (pot (* 7 (- 3 player)))) (set-index newboard pot (+ (index board pot) val))))) ;index ;Purpose: To get the value of desired index in the board ;Inputs: board - the board at its current state, loc - the location which user would like to index to ;Outputs: the value of location loc in board (define index (lambda (board loc) (if (= 1 loc) (car board) (index (cdr board) (- loc 1))))) ;set-index ;Purpose: To set a new value in desired location ;Inputs: board - the board at its current state, loc - the location which user would like to index to, ; newval - the new value user would like to set in location loc ;Outputs: the updated board with the new value in location loc (define set-index (lambda (board loc newval) (if (= 1 loc) (cons newval (cdr board)) (cons (car board) (set-index (cdr board) (- loc 1) newval))))) ;has-moves? ;Purpose: To see if there are any non-empty spots between the desired locations ;Inputs: board - the board at its current state, player - the number of player whose turn it is, ; from - the starting location to check from, to - the ending location to check up to ;Outputs: boolean, true if a non-empty location was found, false otherwise (define has-moves? (lambda (board player from to) (if (< to from) ;if the destination is less than source, no moves are available (begin (display "No moves available for player ") (display player) (display "\n") #f) ;otherwise, check to see if source has pits, if so look at next pit ;otherwise player has moves (if (zero? (index board from)) (has-moves? board player (+ from 1) to) #t)))) ;legal-choice? ;Purpose: To see if the choice of the player is of legal value (i.e. number between 1 and 6) ;Inputs: loc - the player's desired location ;Outputs: boolean, true if the choice is legal, false otherwise (define legal-choice? (lambda (loc) ;checks whether a number was entered, if not returns false (if (not (number? loc)) (begin (display "Must choose a number\n") #f) ;otherwise, checks that it's avalid locatiom, returns true if so, false otherwise (if (and (< loc 7) (> loc 0)) #t (begin (display "Must choose a number between 1 and 6\n") #f))))) ;find-winner ;Purpose: To figure out the outcome of the game ;Inputs: board - the board at its current state ;Outputs: number, 1 if player one is the winner, 2 if player two is the winner, 0 if the game ends in a draw (define find-winner (lambda (board) ;if big pit for player 2 has more stones, player 2 wins (if (> (index board 7) (index board 14)) 2 ;if big pit for player 1 has more stones, player 1 wins ;otherwise, draw (if (< (index board 7) (index board 14)) 1 0)))) ;capture-rest ;Purpose: To capture all seeds on the side of the opponent ;Inputs: board - the board at its current state, player - the number of player whose turn it is, ; loc - current location of the hand to capture from ;Outputs: the board after all captures were completed (define capture-rest (lambda (board player loc) (if (< loc (* 7 player)) (let ((newboard (capture-single board player loc))) ;new board after capture (capture-rest newboard player (+ loc 1))) ;capture next one board))) ;display-outcome ;Purpose: To display the outcome of the game ;Inputs: player - the number of player whose turn it is ;Outputs: output of the game outcome (define display-outcome (lambda (board) (if (= (find-winner board) 1) (display "Player 1 wins") (if (= (find-winner board) 2) (display "Player 2 wins") (display "Game ends in draw"))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;BEGIN DRAWING FUNCTIONS;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;draws the holes for the stones (define draw-circs (lambda (num start-x start-y radius dist dir) (if (zero? num) #t (begin (draw-circle (make-posn start-x start-y) radius 'black) (draw-circs (- num 1) (+ start-x (* dir (+ (* 2 radius) dist))) start-y radius dist dir))))) ;draws the frame for the board (define draw-rect (lambda (start-x start-y height width) (begin (draw-solid-line (make-posn start-x start-y) (make-posn (+ start-x width) start-y) 'black) (draw-solid-line (make-posn (+ start-x width) start-y) (make-posn (+ start-x width) (+ start-y height)) 'black) (draw-solid-line (make-posn (+ start-x width) (+ start-y height)) (make-posn start-x (+ start-y height)) 'black) (draw-solid-line (make-posn start-x (+ start-y height)) (make-posn start-x start-y) 'black)))) ;functions for drawing numbers (define draw-zero (lambda (center-x center-y size) (let ((left (- center-x (/ size 2))) (right (+ center-x (/ size 2))) (top (- center-y size)) (bottom (+ center-y size))) (begin (draw-solid-line (make-posn left top) (make-posn right top) 'black) (draw-solid-line (make-posn right top) (make-posn right bottom) 'black) (draw-solid-line (make-posn right bottom) (make-posn left bottom) 'black) (draw-solid-line (make-posn left bottom) (make-posn left top) 'black))))) (define draw-one (lambda (center-x center-y size) (let ((left (- center-x (/ size 4))) (right (+ center-x (/ size 4))) (top (- center-y size)) (bottom (+ center-y size))) (begin (draw-solid-line (make-posn center-x top) (make-posn center-x bottom) 'black) (draw-solid-line (make-posn center-x top) (make-posn left top) 'black) (draw-solid-line (make-posn left bottom) (make-posn right bottom) 'black))))) (define draw-two (lambda (center-x center-y size) (let ((left (- center-x (/ size 2))) (right (+ center-x (/ size 2))) (top (- center-y size)) (bottom (+ center-y size))) (begin (draw-solid-line (make-posn left top) (make-posn right top) 'black) (draw-solid-line (make-posn right top) (make-posn right center-y) 'black) (draw-solid-line (make-posn right center-y) (make-posn left center-y) 'black) (draw-solid-line (make-posn left center-y) (make-posn left bottom) 'black) (draw-solid-line (make-posn left bottom) (make-posn right bottom) 'black))))) (define draw-three (lambda (center-x center-y size) (let ((left (- center-x (/ size 2))) (right (+ center-x (/ size 2))) (top (- center-y size)) (bottom (+ center-y size))) (begin (draw-solid-line (make-posn left top) (make-posn right top) 'black) (draw-solid-line (make-posn right top) (make-posn right bottom) 'black) (draw-solid-line (make-posn right center-y) (make-posn left center-y) 'black) (draw-solid-line (make-posn left bottom) (make-posn right bottom) 'black))))) (define draw-four (lambda (center-x center-y size) (let ((left (- center-x (/ size 2))) (right (+ center-x (/ size 2))) (top (- center-y size)) (bottom (+ center-y size))) (begin (draw-solid-line (make-posn left top) (make-posn left center-y) 'black) (draw-solid-line (make-posn right top) (make-posn right bottom) 'black) (draw-solid-line (make-posn right center-y) (make-posn left center-y) 'black))))) (define draw-five (lambda (center-x center-y size) (let ((left (- center-x (/ size 2))) (right (+ center-x (/ size 2))) (top (- center-y size)) (bottom (+ center-y size))) (begin (draw-solid-line (make-posn left top) (make-posn right top) 'black) (draw-solid-line (make-posn left top) (make-posn left center-y) 'black) (draw-solid-line (make-posn right center-y) (make-posn left center-y) 'black) (draw-solid-line (make-posn right center-y) (make-posn right bottom) 'black) (draw-solid-line (make-posn left bottom) (make-posn right bottom) 'black))))) (define draw-six (lambda (center-x center-y size) (let ((left (- center-x (/ size 2))) (right (+ center-x (/ size 2))) (top (- center-y size)) (bottom (+ center-y size))) (begin (draw-solid-line (make-posn left top) (make-posn right top) 'black) (draw-solid-line (make-posn left top) (make-posn left bottom) 'black) (draw-solid-line (make-posn right center-y) (make-posn left center-y) 'black) (draw-solid-line (make-posn right center-y) (make-posn right bottom) 'black) (draw-solid-line (make-posn left bottom) (make-posn right bottom) 'black))))) (define draw-seven (lambda (center-x center-y size) (let ((left (- center-x (/ size 2))) (right (+ center-x (/ size 2))) (top (- center-y size)) (bottom (+ center-y size))) (begin (draw-solid-line (make-posn left top) (make-posn right top) 'black) (draw-solid-line (make-posn right top) (make-posn right bottom) 'black))))) (define draw-eight (lambda (center-x center-y size) (let ((left (- center-x (/ size 2))) (right (+ center-x (/ size 2))) (top (- center-y size)) (bottom (+ center-y size))) (begin (draw-solid-line (make-posn left top) (make-posn right top) 'black) (draw-solid-line (make-posn right top) (make-posn right bottom) 'black) (draw-solid-line (make-posn left top) (make-posn left bottom) 'black) (draw-solid-line (make-posn right center-y) (make-posn left center-y) 'black) (draw-solid-line (make-posn left bottom) (make-posn right bottom) 'black))))) (define draw-nine (lambda (center-x center-y size) (let ((left (- center-x (/ size 2))) (right (+ center-x (/ size 2))) (top (- center-y size)) (bottom (+ center-y size))) (begin (draw-solid-line (make-posn left top) (make-posn right top) 'black) (draw-solid-line (make-posn right top) (make-posn right bottom) 'black) (draw-solid-line (make-posn left top) (make-posn left center-y) 'black) (draw-solid-line (make-posn right center-y) (make-posn left center-y) 'black))))) ;Gets the tens digit from a 2 digit number (define get-tens-digit (lambda (n) (cond [(>= n 40) 4] [(>= n 30) 3] [(>= n 20) 2] [else 1]))) ;draws the number in the desired location (define draw-number (lambda (n center-x center-y size single) (cond [(= n 0) (if single #t (draw-zero center-x center-y size))] [(= n 1) (draw-one center-x center-y size)] [(= n 2) (draw-two center-x center-y size)] [(= n 3) (draw-three center-x center-y size)] [(= n 4) (draw-four center-x center-y size)] [(= n 5) (draw-five center-x center-y size)] [(= n 6) (draw-six center-x center-y size)] [(= n 7) (draw-seven center-x center-y size)] [(= n 8) (draw-eight center-x center-y size)] [(= n 9) (draw-nine center-x center-y size)] [(> n 9) (begin (draw-number (get-tens-digit n) (- center-x 7) center-y size single) (draw-number (- n (* (get-tens-digit n) 10)) (+ center-x 7) center-y size #f))]))) ;draws the numbers of stones in the desired holes (define draw-num-stones (lambda (board from to start-x start-y dist dir) (if (> from to) #t (if (= dir -1) (begin (draw-number (index board to) start-x start-y STONE-FONT-SIZE #t) (draw-num-stones board from (- to 1) (- start-x dist) start-y dist dir)) (begin (draw-number (index board to) start-x start-y STONE-FONT-SIZE #t) (draw-num-stones board from (- to 1) (+ start-x dist) start-y dist dir)))))) ;functions for clearing numbers (define clear-zero (lambda (center-x center-y size) (let ((left (- center-x (/ size 2))) (right (+ center-x (/ size 2))) (top (- center-y size)) (bottom (+ center-y size))) (begin (clear-solid-line (make-posn left top) (make-posn right top) 'black) (clear-solid-line (make-posn right top) (make-posn right bottom) 'black) (clear-solid-line (make-posn right bottom) (make-posn left bottom) 'black) (clear-solid-line (make-posn left bottom) (make-posn left top) 'black))))) (define clear-one (lambda (center-x center-y size) (let ((left (- center-x (/ size 4))) (right (+ center-x (/ size 4))) (top (- center-y size)) (bottom (+ center-y size))) (begin (clear-solid-line (make-posn center-x top) (make-posn center-x bottom) 'black) (clear-solid-line (make-posn center-x top) (make-posn left top) 'black) (clear-solid-line (make-posn left bottom) (make-posn right bottom) 'black))))) (define clear-two (lambda (center-x center-y size) (let ((left (- center-x (/ size 2))) (right (+ center-x (/ size 2))) (top (- center-y size)) (bottom (+ center-y size))) (begin (clear-solid-line (make-posn left top) (make-posn right top) 'black) (clear-solid-line (make-posn right top) (make-posn right center-y) 'black) (clear-solid-line (make-posn right center-y) (make-posn left center-y) 'black) (clear-solid-line (make-posn left center-y) (make-posn left bottom) 'black) (clear-solid-line (make-posn left bottom) (make-posn right bottom) 'black))))) (define clear-three (lambda (center-x center-y size) (let ((left (- center-x (/ size 2))) (right (+ center-x (/ size 2))) (top (- center-y size)) (bottom (+ center-y size))) (begin (clear-solid-line (make-posn left top) (make-posn right top) 'black) (clear-solid-line (make-posn right top) (make-posn right bottom) 'black) (clear-solid-line (make-posn right center-y) (make-posn left center-y) 'black) (clear-solid-line (make-posn left bottom) (make-posn right bottom) 'black))))) (define clear-four (lambda (center-x center-y size) (let ((left (- center-x (/ size 2))) (right (+ center-x (/ size 2))) (top (- center-y size)) (bottom (+ center-y size))) (begin (clear-solid-line (make-posn left top) (make-posn left center-y) 'black) (clear-solid-line (make-posn right top) (make-posn right bottom) 'black) (clear-solid-line (make-posn right center-y) (make-posn left center-y) 'black))))) (define clear-five (lambda (center-x center-y size) (let ((left (- center-x (/ size 2))) (right (+ center-x (/ size 2))) (top (- center-y size)) (bottom (+ center-y size))) (begin (clear-solid-line (make-posn left top) (make-posn right top) 'black) (clear-solid-line (make-posn left top) (make-posn left center-y) 'black) (clear-solid-line (make-posn right center-y) (make-posn left center-y) 'black) (clear-solid-line (make-posn right center-y) (make-posn right bottom) 'black) (clear-solid-line (make-posn left bottom) (make-posn right bottom) 'black))))) (define clear-six (lambda (center-x center-y size) (let ((left (- center-x (/ size 2))) (right (+ center-x (/ size 2))) (top (- center-y size)) (bottom (+ center-y size))) (begin (clear-solid-line (make-posn left top) (make-posn right top) 'black) (clear-solid-line (make-posn left top) (make-posn left bottom) 'black) (clear-solid-line (make-posn right center-y) (make-posn left center-y) 'black) (clear-solid-line (make-posn right center-y) (make-posn right bottom) 'black) (clear-solid-line (make-posn left bottom) (make-posn right bottom) 'black))))) (define clear-seven (lambda (center-x center-y size) (let ((left (- center-x (/ size 2))) (right (+ center-x (/ size 2))) (top (- center-y size)) (bottom (+ center-y size))) (begin (clear-solid-line (make-posn left top) (make-posn right top) 'black) (clear-solid-line (make-posn right top) (make-posn right bottom) 'black))))) (define clear-eight (lambda (center-x center-y size) (let ((left (- center-x (/ size 2))) (right (+ center-x (/ size 2))) (top (- center-y size)) (bottom (+ center-y size))) (begin (clear-solid-line (make-posn left top) (make-posn right top) 'black) (clear-solid-line (make-posn right top) (make-posn right bottom) 'black) (clear-solid-line (make-posn left top) (make-posn left bottom) 'black) (clear-solid-line (make-posn right center-y) (make-posn left center-y) 'black) (clear-solid-line (make-posn left bottom) (make-posn right bottom) 'black))))) (define clear-nine (lambda (center-x center-y size) (let ((left (- center-x (/ size 2))) (right (+ center-x (/ size 2))) (top (- center-y size)) (bottom (+ center-y size))) (begin (clear-solid-line (make-posn left top) (make-posn right top) 'black) (clear-solid-line (make-posn right top) (make-posn right bottom) 'black) (clear-solid-line (make-posn left top) (make-posn left center-y) 'black) (clear-solid-line (make-posn right center-y) (make-posn left center-y) 'black))))) ;clears the number from desired location (define clear-number (lambda (n center-x center-y size single) (cond [(= n 0) (if single #t (clear-zero center-x center-y size))] [(= n 1) (clear-one center-x center-y size)] [(= n 2) (clear-two center-x center-y size)] [(= n 3) (clear-three center-x center-y size)] [(= n 4) (clear-four center-x center-y size)] [(= n 5) (clear-five center-x center-y size)] [(= n 6) (clear-six center-x center-y size)] [(= n 7) (clear-seven center-x center-y size)] [(= n 8) (clear-eight center-x center-y size)] [(= n 9) (clear-nine center-x center-y size)] [(> n 9) (begin (clear-number (get-tens-digit n) (- center-x 7) center-y size single) (clear-number (- n (* (get-tens-digit n) 10)) (+ center-x 7) center-y size #f))]))) ;clears the number of stones from each hole in order to redraw numbers (define clear-num-stones (lambda (board from to start-x start-y dist dir) (if (> from to) #t (if (= dir -1) (begin (clear-number (index board to) start-x start-y STONE-FONT-SIZE #t) (clear-num-stones board from (- to 1) (- start-x dist) start-y dist dir)) (begin (clear-number (index board to) start-x start-y STONE-FONT-SIZE #t) (clear-num-stones board from (- to 1) (+ start-x dist) start-y dist dir)))))) ;draws locations of each hole in the board to assist players (define draw-board-locs (lambda (from to start-x start-y dist dir) (if (> from to) #t (if (= dir -1) (begin (draw-number from start-x start-y GAME-FONT-SIZE #t) (draw-board-locs (+ from 1) to (- start-x dist) start-y dist dir)) (begin (draw-number from start-x start-y GAME-FONT-SIZE #t) (draw-board-locs (+ from 1) to (+ start-x dist) start-y dist dir)))))) ;draws the board (define draw-board (lambda () (begin (draw-rect WIDTH-DISTANCE (- (/ HEIGHT 2) BIG-RADIUS (* 2 HEIGHT-DISTANCE)) (+ (* 2 BIG-RADIUS) (* 4 HEIGHT-DISTANCE)) (- WIDTH (* 2 WIDTH-DISTANCE))) (draw-circle (make-posn (- WIDTH BIG-RADIUS (* 2 WIDTH-DISTANCE)) (/ HEIGHT 2)) BIG-RADIUS 'black) (draw-circs 6 RADIUS-W-DISTANCE RADIUS-H-D-DISTANCE SMALL-RADIUS WIDTH-DISTANCE -1) (draw-circs 6 RADIUS-W-DISTANCE RADIUS-H-U-DISTANCE SMALL-RADIUS WIDTH-DISTANCE -1) (draw-circle (make-posn LEFT-DISTANCE (/ HEIGHT 2)) BIG-RADIUS 'black) (draw-board-locs 1 6 RADIUS-W-DISTANCE (- (/ HEIGHT 2) BIG-RADIUS (* 4 HEIGHT-DISTANCE)) NUM-DISTANCE -1) (draw-board-locs 1 6 START-LEFT-POS (+ (/ HEIGHT 2) BIG-RADIUS (* 4 HEIGHT-DISTANCE)) NUM-DISTANCE 1)))) ;draws the number of stones in each hole (define draw-numbers (lambda (board) (begin (draw-number (index board 14) (- WIDTH BIG-RADIUS (* 2 WIDTH-DISTANCE)) (/ HEIGHT 2) STONE-FONT-SIZE #t) (draw-num-stones board 8 13 RADIUS-W-DISTANCE RADIUS-H-D-DISTANCE NUM-DISTANCE -1) (draw-num-stones board 1 6 START-LEFT-POS RADIUS-H-U-DISTANCE NUM-DISTANCE 1) (draw-number (index board 7) LEFT-DISTANCE (/ HEIGHT 2) STONE-FONT-SIZE #t)))) ;clears the number of stones from each hole (define clear-board (lambda (board) (begin (clear-number (index board 14) (- WIDTH BIG-RADIUS (* 2 WIDTH-DISTANCE)) (/ HEIGHT 2) STONE-FONT-SIZE #t) (clear-num-stones board 8 13 RADIUS-W-DISTANCE RADIUS-H-D-DISTANCE NUM-DISTANCE -1) (clear-num-stones board 1 6 START-LEFT-POS RADIUS-H-U-DISTANCE NUM-DISTANCE 1) (clear-number (index board 7) LEFT-DISTANCE (/ HEIGHT 2) STONE-FONT-SIZE #t)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;END DRAWING FUNCTIONS;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;play-game-aux ;Purpose: auxilary function used to complete a turn of one player ;Inputs: board - the board at its current state, player - the number of player whose turn it is, ; game - the type of game played, ptype - the type of player whose turn it is ; ply - the depth of the minimax search ;Outputs: the board after the turn is compelted (define play-game-aux (lambda (board player game ptype ply) (let ((playloc (* 7 (- 2 player))) ;gets player's starting location (opplayloc (* 7 (- player 1)))) ;gets opponent's starting location (if (has-moves? board player (+ playloc 1) (+ playloc 6)) ;checks if player can make any move (begin (ask-move player) ;asks for a move (if (eq? ptype 'human) ;if player is human, ask for move (let ((choice (read))) (if (legal-choice? choice) ;checks for a legal choice (from 1-6) ;if location is empty restarts the move (if (zero? (index board (+ choice playloc))) (begin (display "Cannot choose an empty location\n") (play-game-aux board player game ptype ply)) ;if all valid, player plays (begin (clear-board board) (move board player choice game))) (play-game-aux board player game ptype ply))) ;otherwise, play computer move (let ((choice (cadr (minimax board player game ply ptype 1)))) (begin (display choice) (display "\n") (clear-board board) (move board player choice game))))) ;if no moves for play, capture all stones and give opponent (begin (clear-board board) (capture-rest board player (+ opplayloc 1))))))) ;play-game ;Purpose: To play a complete game of mancala ;Inputs: board - the board at its current state, player - the number of player whose turn it is, ; game - the type of game played, plist - the list of types of players that play the game ; ply - the depth of the minimax search ;Outputs: outputs the winner at the end of the game (define play-game (lambda (board player game plist ply) (if (endgame? board 1) ;checks for end-game situation (display-outcome board) (let ((newboard (play-game-aux board player game (index plist player) ply))) ;play one move (begin (draw-numbers newboard) (play-game newboard (- 3 player) game plist ply)))))) ;draw board and have next player play ;legal-moves ;Purpose: To figure out the possible locations that the player can play from ;Inputs: board - the board at its current state, player - the number of player whose turn it is, ; loc - the recursive variable used to check whether it can be selected ;Outputs: a list of the possible legal moves (define legal-moves (lambda (board player loc) (if (> loc 6) ;if location is past 6, end list '() ;if location is 0, do not add to list, otherwise add location to list (if (zero? (index board (+ (* 7 (- 2 player)) loc))) (legal-moves board player (+ loc 1)) (cons loc (legal-moves board player (+ loc 1))))))) ;minimax ;Purpose: To use a minimax tree search algorithm to figure out the most appropriate move for a ; based on its evaluation function ;Inputs: board - the board at its current state, player - the number of player whose turn it is, ; game - the type of game played, ply - the depth the tree should have, ; eval-fn - the evaluation function used to evaluate the state of the board ; move - the move to be made and determine the new board state ;Outputs: A list of the best move and it's corresponding value (define minimax (lambda (board player game ply eval-fn move) ;if at 0th ply, return a the outcome and move corresponds to that outcome (if (zero? ply) (list (eval-fn board player 1) move) ;otherwise, get list of possible moves (let ((moves (legal-moves board player 1))) ;if no moves, check for endgame (if (null? moves) ;if not at endgame, get opponent's possible best move and value, otherwise just get opponent's possible move (if (not (endgame? board 1)) (let ((vals (minimax board (- 3 player) game (- ply 1) eval-fn move))) (list (- (car vals)) (cadr vals))) (list (- (index board (* 7 (- 3 player))) (index board (* 7 player))) move)) ;if no empty list of moves, get best possible move (let ((best-move 0) (best-val -25)) (minimizer board player game moves ply eval-fn -25 best-move best-val))))))) ;minimizer ;Purpose: Auxilary function for minimax, to determine which move of the list of possible move is the best ;Inputs: board - the board at its current state, player - the number of player whose turn it is, ; game - the type of game played, moves - the list of possible moves for the player ; ply - the depth the tree should have, ; eval-fn - the evaluation function used to evaluate the state of the board ; val - evaluated value for the current move, best-loc - the move that currently gives the best value ; best-val - the evaluated value for the best move ;Outputs: A list of the best move and its corresponding value (define minimizer (lambda (board player game moves ply eval-fn val best-loc best-val) ;if list is empty, return best value and best location (if (null? moves) (list best-val best-loc) ;else get new boal and new value and figure whether it is better than current best value (let* ((newboard (move board player (car moves) game)) (val (- (cadr (minimax newboard (- 3 player) game (- ply 1) eval-fn (car moves)))))) (if (or (zero? best-val) (> val best-val)) (minimizer board player game (cdr moves) ply eval-fn -25 (car moves) val) (minimizer board player game (cdr moves) ply eval-fn -25 best-loc best-val)))))) ;can-capture? ;Purpose: To check whether stones in current location can be captured ;Inputs: board - the board at its current state, loc - the location which is checked for capturing ; compare - recursive variable that has the opponent location ;Outputs: boolean, true if stones at location can be captured, false otherwise (define can-capture? (lambda (board loc compare) ;if at big pits, then can't capture (if (zero? (modulo compare 7)) #f ;otherwise, check if with number of stones in source pit, current pit will be capturable ;if so return true, otherwise go to next pit (if (= (modulo (index board compare) 11) (abs (- compare loc))) #t (can-capture? board loc (+ compare 1)))))) ;The following functions are different heuristic evaluaation functions, inputs and outputs apply for all ;Inputs: board - the board at its current state, player - the number of player whose turn it is, ; loc - recursive variable which goes the locations on the board ;Output: The value evaluated at the state of the board ;singles-eval: calculates the difference between the opponent's holes which contain 1 or 2 stones and those of the player (define singles-eval (lambda (board player loc) (if (> loc 6) (- (index board (* 7 (- 3 player))) (index board (* 7 player))) (let* ((playloc (+ loc (* 7 (- 2 player)))) (opplayloc (+ loc (* 7 (- player 1)))) (tosub (if (and (> (index board playloc) 0) (< (index board playloc) 3)) (index board playloc) 0)) (toadd (if (and (> (index board opplayloc) 0) (< (index board opplayloc) 3)) (index board opplayloc) 0))) (+ (- (singles-eval board player (+ loc 1)) tosub) toadd))))) ;singles-eval-2: calculates the difference between the opponent's holes which contain 1 or 2 stones (doubled) and those of the player (define singles-eval-2 (lambda (board player loc) (if (> loc 6) (- (index board (* 7 (- 3 player))) (index board (* 7 player))) (let* ((playloc (+ loc (* 7 (- 2 player)))) (opplayloc (+ loc (* 7 (- player 1)))) (tosub (if (and (> (index board playloc) 0) (< (index board playloc) 3)) (index board playloc) 0)) (toadd (if (and (> (index board opplayloc) 0) (< (index board opplayloc) 3)) (index board opplayloc) 0))) (+ (- (singles-eval-2 board player (+ loc 1)) tosub) (* 2 toadd)))))) ;singles-eval-3: calculates the difference between the opponent's holes which contain 1 or 2 stones and those of the player (doubled) (define singles-eval-3 (lambda (board player loc) (if (> loc 6) (- (index board (* 7 (- 3 player))) (index board (* 7 player))) (let* ((playloc (+ loc (* 7 (- 2 player)))) (opplayloc (+ loc (* 7 (- player 1)))) (tosub (if (and (> (index board playloc) 0) (< (index board playloc) 3)) (index board playloc) 0)) (toadd (if (and (> (index board opplayloc) 0) (< (index board opplayloc) 3)) (index board opplayloc) 0))) (+ (- (singles-eval-3 board player (+ loc 1)) (* 2 tosub)) toadd))))) ;all-eval: calculates the difference between the number of stones on opponent's side and those of the player (define all-eval (lambda (board player loc) (if (> loc 6) (- (index board (* 7 (- 3 player))) (index board (* 7 player))) (let ((playloc (+ loc (* 7 (- 2 player)))) (opplayloc (+ loc (* 7 (- player 1))))) (+ (- (all-eval board player (+ loc 1)) (index board playloc)) (index board opplayloc)))))) ;all-eval-2: calculates the difference between the number of stones on opponent's side (doubled) and those of the player (define all-eval-2 (lambda (board player loc) (if (> loc 6) (- (index board (* 7 (- 3 player))) (index board (* 7 player))) (let ((playloc (+ loc (* 7 (- 2 player)))) (opplayloc (+ loc (* 7 (- player 1))))) (+ (- (all-eval-2 board player (+ loc 1)) (index board playloc)) (* 2 (index board opplayloc))))))) ;all-eval-3: calculates the difference between the number of stones on opponent's side and those of the player (doubled) (define all-eval-3 (lambda (board player loc) (if (> loc 6) (- (index board (* 7 (- 3 player))) (index board (* 7 player))) (let ((playloc (+ loc (* 7 (- 2 player)))) (opplayloc (+ loc (* 7 (- player 1))))) (+ (- (all-eval-3 board player (+ loc 1)) (* 2 (index board playloc))) (index board opplayloc)))))) ;check-capture: calculates the difference between the number of capturable stones of oppnent's and those of player (define check-capture (lambda (board player loc) (if (> loc 6) (- (index board (* 7 (- 3 player))) (index board (* 7 player))) (let* ((playloc (+ loc (* 7 (- 2 player)))) (opplayloc (+ loc (* 7 (- player 1)))) (tosub (if (and (> (index board playloc) 0) (< (index board playloc) 3) (can-capture? board playloc (- opplayloc (- loc 1)))) (index board playloc) 0)) (toadd (if (and (> (index board opplayloc) 0) (< (index board opplayloc) 3) (can-capture? board opplayloc (- playloc (- loc 1)))) (index board opplayloc) 0))) (+ (- (check-capture board player (+ loc 1)) tosub) toadd))))) ;score-difference: calculates the difference between the scores (define score-difference (lambda (board player loc) (- (index board (* 7 (- 3 player))) (index board (* 7 player))))) ; mancala game board (start WIDTH HEIGHT) (draw-board) (draw-numbers board) ; play game, the list requires player types, type 'human for human player, and any of the player function names for the computer to play as that type of player, ply is the depth to which you would like to computer to calculate moves (play-game board 1 'owari (list singles-eval all-eval) 2)