CS200: Notes 11 February 2004

Notes: Wednesday 11 February 2004

Schedule

• Wednesday, 11 February: Problem Set 3. Please get started on this early (i.e., already!).
• Friday, 13 Feburary: Friday's class will be in the Tuttle Lounge. Please go there at 2:00 instead of the normal classroom.
• Monday, 16 Feburary: Problem Set 4
• Monday, 23 February: Exam 1 (will be handed out on Friday, 20 February)
• Before 10 March: Read rest of GEB part I (Chapters 2-4 and 6-9, in addition to Chapters 1 and 5 you have already read).

Pegboard Puzzle

;;; A board is a pair of the number of rows and the empty squares
(define (make-board rows holes) (cons rows holes))
(define (board-holes board) (cdr board))
(define (board-rows board) (car board))
;;; make-position creates an row col coordinate that represents a position on the board
;;; e.g. 1,1
;;; 2,1 2,2
;;; 3,1 3,2 3,3
(define (make-position row col) (cons row col))
(define (get-row posn) (car posn))
(define (get-col posn) (cdr posn))
(define (same-position pos1 pos2)
 (and (= (get-row pos1) (get-row pos2))
 (= (get-col pos1) (get-col pos2))))
;;; on-board? takes a board and a position and returns true if it is 
;;; contained in the board.
(define (on-board? board posn)
 (and (>= (get-row posn) 1) (>= (get-col posn) 1)
 (<= (get-row posn) (board-rows board)) (<= (get-col posn) (get-row posn)))) ;;; There are rows + (rows - 1) + ... + 1 squares (holes or pegs) (define (board-squares board) (count-squares (board-rows board))) (define (count-squares nrows) (if (= nrows 1) 1 (+ nrows (count-squares (- nrows 1))))) ;;; peg? returns true if the position on board has a peg in it, and false if it doesn't (define (peg? board posn) (contains (lambda (pos) (same-position posn pos)) (board-holes board))) ;;; remove-peg evaluates to the board you get by removing a peg at posn from ;;; the passed board (define (remove-peg board posn) (make-board (board-rows board) (cons posn (board-holes board)))) ;;; add-peg evaluates to the board you get by adding a peg at posn to board (define (add-peg board posn) (make-board (board-rows board) (remove-hole (board-holes board) posn))) (define (remove-hole lst posn) (filter (lambda (pos) (not (same-position pos posn))) lst)) ;;; Here's a different way to define filter (define (filter f lst) (insertl (lambda (el rest) (if (f el) (cons el rest) rest)) lst null)) (define (contains f lst) (> (length (filter f lst)) 0))
;;; 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 (make-move start jump end) (list start jump end))
(define (get-start move) (first move))
(define (get-jump move) (second move))
(define (get-end move) (third move))
;;; 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)))
;;; generate-moves evaluates to all possible moves that move a peg into
;;; the position empty, even if they are not contained on the board.
(define (generate-moves empty)
 (map (lambda (hops)
	 (let ((hop1 (car hops)) (hop2 (cdr hops)))
	 (make-move (make-position (+ (get-row empty) (car hop1)) (+ (get-col empty) (cdr hop1)))
		 (make-position (+ (get-row empty) (car hop2)) (+ (get-col empty) (cdr hop2)))
		 empty)))
 (list
	(cons (cons 2 0) (cons 1 0)) ;; right of empty, hopping left
	(cons (cons -2 0) (cons -1 0)) ;; left of empty, hopping right
	(cons (cons 0 2) (cons 0 1)) ;; below, hopping up
	(cons (cons 0 -2) (cons 0 -1)) ;; above, hopping down
	(cons (cons 2 2) (cons 1 1)) ;; above right, hopping down-left
	(cons (cons -2 2) (cons -1 1)) ;; above left, hopping down-right
	(cons (cons 2 -2) (cons 1 -1)) ;; below right, hopping up-left
	(cons (cons -2 -2) (cons -1 -1)))))) ;; below left, hopping up-right
(define (all-possible-moves board)
 (apply append (map generate-moves (board-holes holes))))
;;; legal-moves filters the moves on a board to produce only those that are valid.
(define (legal-move? move)
 ;; A move is valid if:
 ;; o the start and end positions are on the board
 ;; o there is a peg at the start position
 ;; o there is a peg at the jump position
 ;; o there is not a peg at the end position
 (and (on-board? board (get-start move))
 (on-board? board (get-end move))
 (peg? board (get-start move))
 (peg? board (get-jump move))
 (not (peg? board (get-end move)))))
(define (legal-moves board)
 (filter legal-move? (all-possible-moves board)))
(define (is-winning-position? board)
 ;; A board is a winning position if only one hole contains a peg
 (= (length (board-holes board)) (- (board-squares board) 1)))
(define (find-first-winner board moves)
 (if (null? moves)
 (if (is-winning-position? board)
	 null ;; Found a winning game, no moves needed to win (eval to null)
	 #f) ;; A losing position, no more moves, but too many pegs.
 ;;; See if the first move is a winner
 (let ((result (solve-pegboard (execute-move board (car moves)))))
	(if result ;; anything other than #f is a winner (null is not #f)
	 (cons (car moves) result) ;; found a winner, this is the first move
	 (find-first-winner board (cdr moves)))))) 
;;; solve-pegboard evaluates to:
;;; #f if the board is a losing position (there is no sequence of moves to win from here)
;;; or a list of moves to win from this position
;;;
;;; NOTE: null is a winning result! It means the board has one peg in it right now and
;;; no moves are required to win.
(define (solve-pegboard board)
 (find-first-winner board (legal-moves board)))