This program matches pennies with the user. On each round, the program
decides whether to show heads or tails with its
(simulated) penny, and the user simultaneously decides whether to show
heads of tails with hers. The program wins if the
program's choice matches the user's and loses if they are different.
In this version of the program, one hundred rounds are played. The program makes its first two moves randomly. Subsequently it constructs a model of the ``situation'' that it and the player currently face -- the last two moves on each side -- and consults an internal tables to determine how the player has previously behaved in the same situation, using this information to determine its next play.
;; Programmer: John Stone, Grinnell College. ;; Original version: September 20 -- October 8, 1991. ;; Ported to Scheme: June 14 -- 21, 1996. (require 'random)The matcher is implemented as a procedure of arity zero; invoking it commits the player to the full hundred-round game. This procedure uses a number of local variables:
round counts off the rounds (first round = 1, last round =
100).
my-wins and your-wins tally the outcomes of the
rounds, so that the machine can keep track of who is ahead.
transcript is a table, represented as a list of pairs, with a
``situation'' in the left (car) field of each pair, and in the corresponding
right (cdr) field a pair indicating how many times the player has previously
offered heads (car) or tails (cdr) in the same
situation. Since a situation is represented as a list of two moves and a move
is represented as a pair (computer's move in the left field, player's move in
the right), a typical element of transcript has the structure
indicating that in the seven previous occasions in which both competitors offered(((heads . heads) (tails . heads)) . (3 . 4))
heads on the preceding round and the
computer offered tails while the player offered
heads on the round before that, the player offered
heads three times and tails four times.
last-move and last-move-but-one are initially
null objects; beginning in round two, they record both competitor's choices in
the last round and in the one before that.
my-move and your-move record the computer's and
the player's choices on the current round. (define penny-matcher
(lambda ()
(let loop ((round 1)
(my-wins 0)
(your-wins 0)
(transcript (initialize-table))
(last-move '())
(last-move-but-one '()))
(if (< 100 round)
; Game's over; announce the outcome.
(report-results my-wins your-wins)
; Choose a move and get the player's move simultaneously.
(let ((my-move (select-my-move round
last-move
last-move-but-one
transcript))
(your-move (select-your-move round)))
; Announce the outcome of the current round.
(report-round my-move your-move my-wins
your-wins)
; On to the next round, then.
(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 (<= round 2) ; Start recording behavior
; only after round 2.
transcript
(update-table transcript
(list last-move
last-move-but-one)
your-move))
(cons my-move your-move)
last-move))))))
The initialize-table procedure makes a list of the possible
situations -- combinations of moves on the two preceding rounds -- and
associates the pair (0 . 0) with each one initially (``in previous occurrences
of this situation, the player has chosen heads 0 times and tails 0 times'').
(define initialize-table
(lambda ()
(let* ((faces '(heads tails))
(moves (apply append
(map (lambda (face-1)
(map (lambda (face-2)
(cons face-1 face-2))
faces))
faces)))
(situations (apply append
(map (lambda (move-1)
(map (lambda (move-2)
(list move-1 move-2))
moves))
moves))))
(map (lambda (situation)
(cons situation (cons 0 0)))
situations))))
At the end of the game, find out which competitor has more wins. If it's
the player, congratulate her; if it's the computer, gloat; if it's a tie, grouse
about the wasted effort.
(define report-results
(lambda (my-wins your-wins)
(cond ((< my-wins your-wins)
(display "Congratulations -- you outwitted me.")
(newline)
(display "I owe you ")
(display (- your-wins my-wins))
(display " cents.")
(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)))
(newline)))
The select-my-move procedure determines the computer's next
offering. On rounds 1 and 2, it offers heads and tails
at random, with equal probability. Subsequently, it sees what its opponent has
usually done when the same situation occurred in previous rounds and predicts
that she will do the same thing again. If she has offered heads and tails
equally often, again the computer chooses its move at random.
(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)))
(cond ((< head-plays tail-plays) 'tails)
((< tail-plays head-plays) 'heads)
(else (toss-a-coin))))))))
The toss-a-coin procedure returns either the symbol heads or
the symbol tails, with equal probability.
(define toss-a-coin
(lambda ()
(if (zero? (random 2))
'heads
'tails)))
The lookup procedure scans through the given transcript,
looking for the entry for a particular situation. When it finds it, it returns
the cdr of the pair in which that situation is the car.
(define lookup
(lambda (situation transcript)
(let lookup-it ((rest transcript))
(if (equal? situation (caar rest))
(cdar rest)
(lookup-it (cdr rest))))))
The select-your-move procedure prompts the player for a move
-- either the symbol heads or the symbol tails. If the player complies, it
returns the move; otherwise, it complains and prompts again until the player
wakes up.
(define select-your-move
(lambda (round-number)
(display "Round #")
(display round-number)
(newline)
(display "Your move (heads or tails): ")
(let loop ((input (read)))
(consume-line)
(if (or (eq? input 'heads)
(eq? input 'tails))
input
(begin
(display "Type `heads' or `tails', please.")
(newline)
(display "Your move: ")
(loop (read)))))))
The consume-line procedure discards any input following the
symbol that the player supplies, 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)
(consume-line)))))))
The report-round procedure tells the player what the
computer's offering was, reminds her what she played, indicates whether they
match, and tells how many rounds each side has now won.
(define report-round
(lambda (my-move your-move my-wins your-wins)
(display "You showed ")
(display your-move)
(display ", I showed ")
(display my-move)
(display ".")
(newline)
(if (eq? my-move your-move)
(begin
(display "They match, so I win this round.")
(newline)
(display "That's ")
(display (+ my-wins 1))
(display " for me and ")
(display your-wins)
(display " for you.")
(newline))
(begin
(display "They don't match, so you win this round.")
(newline)
(display "That's ")
(display my-wins)
(display " for me and ")
(display (+ your-wins 1))
(display " for you.")
(newline)))
(newline)))
The update-table procedure takes the current table
(transcript), the situation that prevailed at the beginning of a
move, and the player's response to this situation, and constructs and returns a
new table in which the player's response is appropriately tallied. The procedure
takes the opportunity to move the entry for the given situation to the beginning
of the list, on the theory that it is more likely to be needed again soon;
moving it to the front shortens the next search for it.
(define update-table
(lambda (transcript situation your-move)
(let loop ((rest transcript)
(passed '()))
(if (equal? situation (caar rest))
(cons (cons situation
(if (eq? your-move 'heads)
(cons (+ (cadar rest) 1)
(cddar rest))
(cons (cadar rest)
(+ (cddar rest) 1))))
(append (reverse passed)
(cdr rest)))
(loop (cdr rest) (cons (car rest) passed))))))
Now that everything is defined, it remains only to fire up the penny
matcher.
(penny-matcher)