SOLUTIONS FOR EXERCISE SET #7

1. The version of the map procedure presented as program 7.1 in the textbook (page 196) does not use an iterative process. Write one that does.

(define map
  (lambda (proc ls)
    (let loop ((rest ls)
               (result '()))
      (if (null? rest)
          (reverse result)
          (loop (cdr rest) (cons (proc (car rest)) result))))))
or, if one wants to preserve the variable arity of the built-in map,
(define map
  (lambda (proc . lists)
    (let loop ((rest lists)
               (result '()))
      (if (some? null? rest)
          (reverse result)
          (loop (cdrs rest)
                (cons (apply proc (cars rest)) result))))))

(define cdrs
  (lambda (lists)
    (let loop ((rest lists)
               (result '()))
      (if (null? rest)
          (reverse result)
          (loop (cdr rest) (cons (cdar rest) result))))))

(define cars
  (lambda (lists)
    (let loop ((rest lists)
               (result '()))
      (if (null? rest)
          (reverse result)
          (loop (cdr rest) (cons (caar rest) result))))))
2. Define a ``curried'' version of the filter procedure from exercise 9 of set #4 -- a procedure that takes a predicate as argument and returns a procedure that filters non-conforming elements out of lists.

(define filter
  (lambda (pred?)
    (lambda (ls)
      (let loop ((rest ls)
                 (so-far '()))
        (if (null? rest)
            (reverse so-far)
            (loop (cdr rest)
                  (let ((first (car rest)))
                    (if (pred? first)
                        (cons first so-far)
                        so-far))))))))
3. Define a Scheme procedure that takes a list of strings as arguments and returns a list containing strings that are exactly similar except that each vowel in each string has been replaced by a hyphen.

(define replace-vowels-throughout-list
  (let* ((vowel?
          (lambda (ch)
            (memv ch '(#\a #\e #\i #\o #\u #\A #\E #\I #\O #\U))))
         (replace-vowels-in-string
          (lambda (str)
            (let* ((len (string-length str))
                   (result (make-string len)))
              (let loop ((remaining len))
                (if (zero? remaining)
                    result
                    (let* ((position (- remaining 1))
                           (ch (string-ref str position)))
                      (string-set! result position
                                   (if (vowel? ch) #\- ch))
                      (loop position))))))))
    (lambda (ls)
      (let loop ((rest ls)
                 (result '()))
        (if (null? rest)
            (reverse result)
            (loop (cdr rest)
                  (cons (replace-vowels-in-string (car rest))
                        result)))))))
4. Define a Scheme procedure that returns a list of thirty three-letter strings in which the first letter is chosen randomly from the set bdfghjklmnprstvz, the second from the set aeiou, and the third from the set bdfgklmnprstvxz.

(require 'random)

(define random-char
  (lambda (str)
    (string-ref str (random (string-length str)))))

(define sample
  (lambda ()
    (let loop ((remaining 30)
               (so-far '()))
      (if (zero? remaining)
          so-far
          (loop (- remaining 1)
                (cons (string (random-char "bdfghjklmnprstvz")
                              (random-char "aeiou")
                              (random-char "bdfgklmnprstvxz"))
                      so-far))))))
5. Define a Scheme procedure lookup that takes a value and a list of pairs and returns the cdr of the first pair on the list that has the given value as its car. For example, (lookup 'a '((b . 2) (c . 3) (a . 1))) should return 1.

(define lookup
  (lambda (val ls)
    (let lookup-it ((rest ls))
      (if (equal? val (caar rest))
          (cdar rest)
          (lookup-it (cdr rest))))))
6. Define a Scheme procedure consume-line, of arity 0, that reads in and discards characters from the keyboard up to and including the next newline character.

(define consume-line
  (lambda ()
    (let ((next-char (peek-char)))
      (or (eof-object? next-char)
          (begin
            (read-char)
            (or (eq? next-char #\newline)
7. The file /u2/stone/events/scheme-workshop/examples/penny-matcher.scm contains an interactive program that will match pennies with the user for one hundred rounds, winning whenever it succeeds in matching the user's choice of heads or tails on a given round, losing when its own choice doesn't match the user's. The program works by building a very simple model of the user's behavior.

Run this program in batch mode and report the outcome after one hundred rounds. Then study the source code and describe the cognitive model that it relies on.

Since I knew the program's strategy, I was able to win 57 of the 100 rounds -- no more than that, since I relied on my highly fallible memory to try to keep track of its internal state.

The cognitive model that the program uses is that the player, in making her choice, is aware of only the two preceding rounds; the moves made on both sides during those two rounds constitute the ``situation,'' the relevant part of the player's environment. The model assumes that the player tends to make the same choice when the same situation recurs. So, for each of the sixteen possible situations, the program keeps track of what choice the player made previously in that situation, and predicts that she will make the same choice again.

8. Currently the penny-matching program sometimes chooses its plays randomly. Revise it so that it always plays tails in these cases, trying to induce the player to bias her choices towards heads. Keep track of the number of times the player chooses heads and incorporate that information into the final report of the match.

Change the definition of the select-my-move procedure so that it reads as follows:

(define select-my-move
  (lambda (round last-move last-move-but-one transcript)
    (if (<= round 2)
        'tails
        (let ((past-record (lookup (list last-move
                                         last-move-but-one)
                                   transcript)))
          (if (< (car past-record) (cdr past-record))
              'heads
              'tails))))))
To keep track of the number of times the player chooses heads and report it at the end of the session, also change the definitions of penny-matcher and report-results. I've marked the lines that have been added or changed.
(define penny-matcher
  (lambda ()
    (let loop ((round 1)
               (my-wins 0)
               (your-wins 0)
               (your-heads 0)                           ; added
               (transcript (initialize-table))
               (last-move '())
               (last-move-but-one '()))
      (if (< 100 round)
          (report-results my-wins your-wins your-heads) ; changed
          (let ((my-move (select-my-move round
                                         last-move
                                         last-move-but-one
                                         transcript))
                (your-move (select-your-move round)))
            (report-round my-move your-move my-wins
                          your-wins)
            (loop (+ round 1)
                  (if (eq? my-move your-move)
                      (+ my-wins 1)
                      my-wins)
                  (if (eq? my-move your-move)
                      your-wins
                      (+ 1 your-wins))
                  (if (eq? your-move 'heads)            ; added
                      (+ 1 your-heads)                  ; added
                      your-heads)                       ; added
                  (if (<= round 2)
                      transcript
                      (update-table transcript
                                    (list last-move
                                          last-move-but-one)
                                    your-move))
                  (cons my-move your-move)
                  last-move))))))

(define report-results
  (lambda (my-wins your-wins your-heads)                ; changed
    (cond ((< my-wins your-wins)
           (display "Congratulations -- you outwitted me.")
           (newline)
           (display "I owe you ")
           (display (- your-wins my-wins))
           (display " cents.")
           (newline)
           (display "Perhaps John Stone will pay up.")
           (newline))
          ((< your-wins my-wins)
           (display "Hmm.  Looks like you owe me ")
           (display (- my-wins your-wins))
           (display " cents.")
           (newline)
           (display "Keep it -- there's no way for me to spend it anyway.")
           (newline))
          (else
           (display "Hmm.  Well, that was pointless.")
           (newline)
           (display "I guess I need a better cognitive model!")
           (newline)))
    (display "You played heads ")                       ; added
    (display your-heads)                                ; added
    (display " times.")                                 ; added
    (newline)                                           ; added
    (newline)))
9. Currently the penny-matching program assumes that whenever its opponent faces a situation that she has been in before, she'll tend to behave the same way. Revise it so that, if the situation has arisen only once before, the program predicts that the opponent will remember what she did before and do the opposite this time. (On subsequent recurrences of the situation, the program should behave as it does now -- that is, whenever the situation has arisen more than once in previous rounds, the program should predict that its opponent will choose the play that she has most frequently chosen in the past in the same situation.) The idea is to model the cognition of a ``tricky'' player who tries to avoid establishing exploitable patterns, but has a shallow memory of her previous plays and their contexts.

Again, change the definition of the select-my-move procedure, this time as follows:

(define select-my-move
  (lambda (round last-move last-move-but-one transcript)
    (if (<= round 2)
        (toss-a-coin)
        (let ((past-record (lookup (list last-move
                                         last-move-but-one)
                                   transcript)))
          (let ((head-plays (car past-record))
                (tail-plays (cdr past-record)))
            (if (= (+ head-plays tail-plays) 1)
                (if (zero? head-plays)
                    'heads
                    'tails)
              (cond ((< head-plays tail-plays) 'tails)
                    ((< tail-plays head-plays) 'heads)
                    (else (toss-a-coin)))))))))
10. Design a strategy for the penny-matching game that can regularly defeat the initial version of penny-matcher. Implement it as a Scheme procedure and replace the select-your-move procedure in the penny-matcher program with that procedure to prove that it can win.

The sneaky way to do it is to perform the same calculation as the program, then reverse the result:

(define select-your-move
  (lambda (round last-move last-move-but-one transcript)
    (if (<= round 2)
        (toss-a-coin)
        (let ((past-record (lookup (list last-move
                                         last-move-but-one)
                                   transcript)))
          (let ((head-plays (car past-record))
                (tail-plays (cdr past-record)))
            (cond ((< head-plays tail-plays) 'heads)
                  ((< tail-plays head-plays) 'tails)
                  (else (toss-a-coin))))))))
This still loses quite a few rounds, when both it and the program choose moves randomly and happen to get the same result from the coin toss. But it wins every round in which the program makes a non-random play.


created June 18, 1996
last revised June 19, 1996

John David Stone (stone@math.grin.edu)