University of Virginia, Department of Computer Science
CS200: Computer Science, Spring 2003

Notes: Wednesday 29 and Friday 31 January 2003


Recursive Definition Example

(define (sum-colors color-list)
  (if (null? color-list)         ;;; If there are no more colors in the list,
     (make-color 0 0 0)          ;;;    evaluate to the 0-color (black)
     (add-color                  ;;; Otherwise, evaluate to the result of adding
        (first color-list)       ;;;    the first color and
        (sum-colors              ;;;    the sum
           (rest color-list))))) ;;;        of all the other colors.
Cracking the Cracker Barrel

For years the Peg Board Game has been a wonderful measurer of intelligence while waiting for your pancakes. In class today, we will implement the game using scheme. The rules are simple; start with pegs in every hole on the board except for one. The point of the game is to leave as few pegs left standing as possible, and you are able to remove pegs by jumping them. Here is what a fair jump looks like: As you can see, a series of two pegs and an open hole is required for a jump. After you jump a peg, you must take it out.

When there are no more jumps possible, the number of pegs remaining is interpreted as a measure of your intelligence:

Below is the code for the representation of the peg board. Your mission is to design a strategy to win, i.e. leave only one peg on the board, and implement it using the following code:

(require (lib ""))

(define ROWS 5)

;;; posn creates an x,y coordinate that represents a position on the board
;;; e.g.             1,1
;;;               2,1   2,2
;;;            3,1   3,2   3,3
;;;         4,1   4,2   4,3   4,4
;;;      5,1   5,2   5,3   5,4   5,5

(define (posn x y) (list x y))

;;; get-x and get-y get the x or y value from a posn
;;; e.g.   > (get-x (posn 2 3))
;;;        2
;;;        > (get-y (posn 2 3))
;;;        3

(define (get-x posn) (car posn))
(define (get-y posn) (cadr posn))

;;; board creates a peg-board with the peg at posn startpos removed.
;;; e.g.   > (board (posn 3 2))
;;;        ((3 2))
;;;    creates this board (if X's stand for pegs, and O's are empty
;;;                     X
;;;                    X X
;;;                   X O X
;;;                  X X X X
;;;                 X X X X X

(define (board startpos)
  (if (on-board? startpos)
      (list startpos)
      (error "Starting position must be on the board")))

;;; on-board? takes a position and returns true if it is contained in the
;;; board of size ROWS (defined at the top)

(define (on-board? posn)
  (and (<= (get-x posn) ROWS) (<= (get-y posn) (get-x posn))
       (>= (get-x posn) 1) (>= (get-y posn) 1)))

;;; peg? returns true if the posn on board has a peg in it, and false if it doesn't

(define (peg? board posn)
  (if (not (empty? board))
      (if (and (= (get-x posn) (get-x (first board))) 
               (= (get-y posn) (get-y (first board))))
          (peg? (rest board) posn))

;;; remove-peg removes a peg at posn from the board

(define (remove-peg board posn)
  (cons posn board))

;;; add-peg adds a peg at posn on the board

(define (add-peg board posn)
  (remove posn board))
;;; move creates a list of three posn, a start (the posn that the jumping
;;; peg starts from), a jump (the posn that is being jumped over), and end
;;; (the posn that the peg will end up in)

(define (move start jump end) (list start jump end))

;;; get-start gets the start from a move
(define (get-start move) (first move))

;;; get-jump gets the jump from a move
(define (get-jump move) (second move))

;;; get-end the end from a move
(define (get-end move) (third move))

;;; generate-moves evaluates to all possible moves for a posn empty, even if they 
;;; are not contained on the board.

(define (generate-moves empty)
   (move (posn (+ (get-x empty) 2) (get-y empty))
         (posn (+ (get-x empty) 1) (get-y empty)) 
         (posn (get-x empty) (get-y empty)))
   (move (posn (+ (get-x empty) 2) (+ (get-y empty) 2))
         (posn (+ (get-x empty) 1) (+ (get-y empty) 1))
         (posn (get-x empty) (get-y empty)))
   (move (posn (- (get-x empty) 2) (get-y empty))
         (posn (- (get-x empty) 1) (get-y empty))
         (posn (get-x empty) (get-y empty)))
   (move (posn (- (get-x empty) 2) (- (get-y empty) 2)) 
         (posn (- (get-x empty) 1) (- (get-y empty) 1))
         (posn (get-x empty) (get-y empty)))
   (move (posn (get-x empty) (- (get-y empty) 2))
         (posn (get-x empty) (- (get-y empty) 1))
         (posn (get-x empty) (get-y empty)))
   (move (posn (get-x empty) (+ (get-y empty) 2)) 
         (posn (get-x empty) (+ (get-y empty) 1)) 
         (posn (get-x empty) (get-y empty))))) 

(define (valid-moves-helper moves board)
  (if (not (empty? moves))
      (if (and (on-board? (get-start (first moves))) 
               (peg? board (get-start (first moves))) 
               (peg? board (get-jump (first moves))))
          (cons (first moves) (valid-moves-helper (rest moves) board))
          (valid-moves-helper (rest moves) board))

;;; all-moves cycles through the board and generates all possible moves for the board,
;;; even if they are not valid

(define (all-moves board)
  (if (not (empty? board))
      (append (generate-moves (first board)) (all-moves (rest board)))

;;; valid-moves filters the moves on a board to produce only those that are valid.

(define (valid-moves board)
  (valid-moves-helper (all-moves board) board))

;;; execute-move evaluates to the board after making move move on board.
(define (execute-move board move)
  (add-peg (remove-peg (remove-peg board (get-start move)) 
                       (get-jump move))
           (get-end move)))

CS 200

CS 200: Computer Science
Department of Computer Science
University of Virginia
Using these Materials