[an error occurred while processing this directive]

## cs150: Notes 11

#### Lab Hours

There will be make-up lab hours this afternoon 4:30-6. There will be normally scheduled lab hours Sunday 4-5:30 and 8-9:30pm

#### Pegboard Puzzle

```;;; A board is a pair of the number of rows and a list of empty positions
(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))))

(define (remove-peg board posn)
(make-board (board-rows board) (cons posn (board-holes 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))

;;; 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)))

(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 target)
(map (lambda (hops)
(let ((hop1 (car hops)) (hop2 (cdr hops)))
(make-move (make-position
(+ (get-row target) (car hop1))
(+ (get-col target) (cdr hop1)))
(make-position
(+ (get-row target) (car hop2))
(+ (get-col target) (cdr hop2)))
target)))
(list
(cons (cons 2 0) (cons 1 0))         ;; right of target, hopping left
(cons (cons -2 0) (cons -1 0))       ;; left of target, 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))))

(define (legal-move? move)
(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)))

;;; 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)))))

(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 takes a board as input and outputs:
;;;    #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
;;;         null is a winning result: it means the board has one
;;;         peg and no moves are required to win.
(define (solve-pegboard board)
(find-first-winner board (legal-moves board)))
```
Genius is one percent inspiration and 99 percent perspiration.
Thomas Edison

The difference between stupidity and genius is that genius has its limits.
Albert Einstein