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)