PPL (201-1289101)
Solution to HW2
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Question 1. Reverse
;;
;; recursive version of reverse
;; Note: this is not only bad because it is recursive, but also because it
;; keeps calling append on longer and longer lists and append is linear.
;; So this ends up being quadratic time.
(define (reverse1 s)
(if (null? s)
'()
(append (reverse1 (cdr s)) (list (car s)))))
;; iterative version of reverse
(define (reverse2 s)
(define (rev-i s res)
(if (null? s)
res
(rev-i (cdr s) (cons (car s) res))))
(rev-i s '()))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Question 2. Ierative version of map
;;
;; A composition of 2 iterative processes is iterative.
(define (mapi proc list1)
(define (doit list res)
(if (null? list)
res
(doit (cdr list) (cons (proc (car list)) res))))
(reverse2 (doit list1 '())))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Question 3. Substitute
;;
(define (substitute tree old new)
(cond ((null? tree) '())
((not (pair? tree)) (if (= old tree) new tree))
(else (cons (substitute (car tree) old new)
(substitute (cdr tree) old new)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Question 4. Remove
;;
;; Note: you have to remove the empty trees before continuing the recursion.
(define (remove tree n)
(cond ((null? tree) '())
((not (pair? tree))
(if (= tree n) '() tree))
(else (let ((rcar (remove (car tree) n)))
(if (null? rcar)
(remove (cdr tree) n)
(cons (remove (car tree) n)
(remove (cdr tree) n)))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; 21 Simulator
;;
(require 'random)
(define (get-a-card) (+ 1 (random 10)))
;; The hand Abstract Data Type
;; Constructor
(define (make-hand visible-card total)
(cons visible-card total))
;; Selectors
(define (hand-visible-card hand)
(car hand))
(define (hand-total hand)
(cdr hand))
;; Operations
(define (make-new-hand first-card)
(make-hand first-card first-card))
(define (hand-add-card hand new-card)
(make-hand (hand-visible-card hand)
(+ new-card (hand-total hand))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Question 5. Twenty-one and test-strategy
;;
(define (interactive-strategy your-hand opponent-visible-card)
(newline)
(princ "Opponent visible card: ")
(princ opponent-visible-card)
(newline)
(princ "Your Total: ")
(princ (hand-total your-hand))
(newline)
(princ "Get another card (Y/N)? ")
(user-says-y?))
(define (user-says-y?)
(eq? (read) 'y))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Twenty-one function
;;
(define (twenty-one player1-strategy player2-strategy)
(let ((player2-initial-hand (make-new-hand (get-a-card))))
(let ((player1-hand (play-hand player1-strategy
(make-new-hand (get-a-card))
(hand-visible-card player2-initial-hand))))
(if (> (hand-total player1-hand) 21)
2 ;;''bust'' for player1
(let ((player2-hand
(play-hand player2-strategy
player2-initial-hand
(hand-visible-card player1-hand))))
(cond ((> (hand-total player2-hand) 21) 1);;``bust'' for player2
((> (hand-total player1-hand)
(hand-total player2-hand)) 1) ;; player2 loses
(else 2))))))) ;; player1 loses
(define (play-hand strategy my-hand opponent-visible-card)
(cond ((> (hand-total my-hand) 21) my-hand) ;; I lose
((strategy my-hand opponent-visible-card) ;; take another card?
(play-hand strategy
(hand-add-card my-hand (get-a-card))
opponent-visible-card))
(else my-hand))) ;; stay
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Test-strategy function
;;
(define (test-strategy strategy1 strategy2 n-games)
(test-strategy-i strategy1 strategy2 n-games 0))
;; This is iterative: just a loop of n time twenty-one.
(define (test-strategy-i strategy1 strategy2 n-games res)
(if (= n-games 0)
res
(test-strategy-i strategy1 strategy2 (- n-games 1)
(+ res
(if (= (twenty-one strategy1 strategy2) 1)
1
0)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Question 6. Strategies stop-at, watch-strategy
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Stop-at function
;;
(define (stop-at n)
(lambda (my-hand opponent-visible-card)
(< (hand-total my-hand) n)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Watch-strategy function
;;
;; This is the simple version without memory for detecting which
;; card we get at each turn.
;; The more complex one will be added later...
(define (watch-player strategy player-name)
(lambda (my-hand opponent-visible-card)
(print player-name 'visible (hand-visible-card my-hand)
'-- 'hand (hand-total my-hand)
'-- 'opponent 'visible opponent-visible-card)
(let ((res (strategy my-hand opponent-visible-card)))
(if res
(print 'ask)
(print 'stop))
res)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Question 7 (optional). Both
;;
(define (both strategy1 strategy2)
(lambda (my-hand opponent-visible-card)
(and (strategy1 my-hand opponent-visible-card)
(strategy2 my-hand opponent-visible-card))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; That's all folks
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Last modified Apr 3rd, 1997
Michael Elhadad