;;;; dilemma-project.ss: players in a ``prisoner's dilemma'' tournament ;;; John David Stone ;;; Department of Mathematics and Computer Science ;;; Grinnell College ;;; stone@math.grin.edu ;;; Original version: February 22, 1986 ;;; Last revised: October 2, 1997 ;;; The ``prisoner's dilemma'' is a game for two persons -- call them A and ;;; B. In each round of the game, each player independently selects one of ;;; two options, traditionally called ``cooperation'' and ``defection.'' ;;; The players then reveal their selections simultaneously and score ;;; points according to the following table: ;;; A's play B's play A's score B's score ;;; ------------------------------------------------------- ;;; cooperation cooperation 3 3 ;;; cooperation defection 0 5 ;;; defection cooperation 5 0 ;;; defection defection 1 1 ;;; Thus the game is symmetrical and does not favor either player. Since ;;; the scoring table is such that each player gets more points for ;;; defecting than for cooperating, no matter which option the other player ;;; selects, a rational player always defects if he sees the other player ;;; as an opponent and concerns himself only with trying to outscore the ;;; other player. Two such players, therefore, score one point each. A ;;; different kind of rational player sees the other player as a potential ;;; ally and chooses cooperation in the hope of obtaining a total of six ;;; points (the maximum) for the allies. ;;; Although this latter strategy is in one sense less certain to succeed, ;;; an additional reason for cooperating appears when the same players ;;; participate in several successive rounds of the game: Cooperation in ;;; early rounds may induce the other player to cooperate subsequently, to ;;; the advantage of both players. When such a multi-round game forms part ;;; of a tournament involving a large number of players, each successively ;;; paired with each, with the overall scores determined by adding the ;;; results of the individual matches, there is an even stronger reason to ;;; choose cooperation at least some of the time: If cooperation is ;;; reciprocal, a player who receives three points per round in many games ;;; will accumulate a higher total than a chronic defector who usually ;;; receives one point per round. It is even possible for a player who ;;; never outscores any of her opponents in a single match to place first ;;; in the overall tournament, if the other players obtain lower scores ;;; when matched to one another than when matched to her. ;;; This program defines a roster of players for such a tournament. Each ;;; player is represented by a Scheme procedure that embodies his selection ;;; strategy as a function of the number of rounds previously played in the ;;; current match and the record of each player's selections in previous ;;; rounds. (Such a record is provided in the form of a list in which the ;;; first element is the selection the player made in the previous round, ;;; the second element is the player's selection two rounds back, and so ;;; on.) The mechanism by which each match is played is also defined and ;;; described in this program. ;;; First, let's look at some players. ;;; The JUST-MEAN player defects in every round, regardless of what the ;;; other player does. (define just-mean (lambda (rounds-played my-plays your-plays) 'defection)) ;;; The LOOK-BACK player cooperates in the first round. On every subsequent ;;; round, it does whatever the other player did in the previous round. (define look-back (lambda (rounds-played my-plays your-plays) (if (zero? rounds-played) 'cooperation (car your-plays)))) ;;; The POINT SEVEN player cooperates in the first round and thereafter ;;; cooperates whenever the other player cooperated in the preceding round; ;;; after a defection by the other player, POINT SEVEN generates a random ;;; number in the range from 0 to 1 and defects if the random number is ;;; less than 0.7. ;;; Designer: Bill Murphy (define point-seven (lambda (rounds-played my-plays your-plays) (cond ((zero? rounds-played) 'cooperation) ((eq? (car your-plays) 'cooperation) 'cooperation) ((< (random 10) 7) 'defection) (else 'cooperation)))) ;;; The CHEAP player defects in the first round, but after that it plays ;;; the same strategy as LOOK-BACK. ;;; Designer: Jeff Dunn (define cheap (lambda (rounds-played my-plays your-plays) (if (zero? rounds-played) 'defection (car your-plays)))) ;;; The ABSENTEE player cooperates in the first two rounds and ;;; subsequently defects if the other player has defected in each of the ;;; two preceding rounds, but cooperates if the other player cooperated in ;;; either of those two rounds. (define absentee (lambda (rounds-played my-plays your-plays) (cond ((<= rounds-played 1) 'cooperation) ((eq? (cadr your-plays) 'cooperation) 'cooperation) (else (car your-plays))))) ;;; The OVERTIME player follows a pre-programmed sequence of acts of ;;; cooperation and defection, basing its choice entirely on the round ;;; number and not on the opponent's behavior. The pattern consists of ;;; alternating strings of cooperations and defections, growing longer and ;;; longer as the round number increases. After round 100, it always ;;; defects. (define overtime (lambda (rounds-played my-plays your-plays) (if (member rounds-played '(0 3 4 8 9 14 15 21 22 27 28 32 33 36 37 39 40 43 44 48 49 54 55 61 62 67 68 72 73 76 77 79 80 83 84 88 89 94 95 96 97 98 99)) 'cooperation 'defection))) ;;; GOLDEN-RULE cooperates in the first round, and thereafter always ;;; responds to a defection with a defection. In responding to cooperation ;;; after the first round, it looks to see how frequently its opponent has ;;; defected in all previous rounds and defects with the same probability. ;;; GOLDEN-RULE calls a simple tallying procedure named TALLY-DEFECTIONS to ;;; find out how often its opponent has defected in previous rounds. (define golden-rule (lambda (rounds-played my-plays your-plays) (cond ((zero? rounds-played) 'cooperation) ((eq? (car your-plays) 'defection) 'defection) ((< (random rounds-played) (tally-defections your-plays)) 'defection) (else 'cooperation)))) (define tally-defections (lambda (plays) (if (null? plays) 0 (let ((rest-of-defections (tally-defections (cdr plays)))) (if (eq? (car plays) 'defection) (+ rest-of-defections 1) rest-of-defections))))) ;;; TESTER defects in the first round, cooperates in the second round, and ;;; continues to alternate defection with cooperation as long as the other ;;; player does not defect. TESTER cooperates after the other player's ;;; first defection, but after that plays the same strategy as LOOK-BACK. (define tester (lambda (rounds-played my-plays your-plays) (let ((defections (tally-defections your-plays))) (cond ((zero? defections) (if (even? rounds-played) 'defection 'cooperation)) ((and (= defections 1) (eq? (car your-plays) 'defection)) 'cooperation) (else (car your-plays)))))) ;;; The ZERO-TWO player cooperates indefinitely as long as its opponent ;;; does not make the fatal mistake of defecting twice in a row; ZERO/TWO ;;; responds to this repeated defection by defecting in every subsequent ;;; round. ;;; A separate procedure, DEFECTED-TWICE-IN-A-ROW?, is used to inspect the ;;; opponent's play record. (define zero-two (lambda (rounds-played my-plays your-plays) (if (defected-twice-in-a-row? your-plays) 'defection 'cooperation))) (define defected-twice-in-a-row? (lambda (plays) (and (not (null? plays)) (not (null? (cdr plays))) (or (and (eq? (car plays) 'defection) (eq? (cadr plays) 'defection)) (defected-twice-in-a-row? (cdr plays)))))) ;;; The number of rounds in each match is supposed to be a secret from the ;;; players (otherwise, there would be no reason for them ever to cooperate ;;; in the last round of a match), but it is held constant through any one ;;; tournament: (define rounds-per-match 153) ;;; The PLAY-MATCH procedure stages a match between two given players, ;;; reporting their final scores as a pair in which the car is the first ;;; player's score and the cdr the second player's. (define play-match (lambda (player-A player-B) ;; Make sure that both players are procedures. (if (not (and (procedure? player-A) (procedure? player-B))) (error 'play-match "Both arguments must be procedures")) ;; Start the match going, with empty lists as the play records, 0 as ;; each player's score, and 0 as the number of rounds played. (play-match-kernel player-A player-B '() '() 0 0 0))) (define play-match-kernel (lambda (player-A player-B A-plays B-plays A-score B-score rounds-played) ;; If all the rounds have been played, return the final scores. (if (= rounds-played rounds-per-match) (cons A-score B-score) ;; Otherwise, have each player select cooperation or defection. (let ((A-play (player-A rounds-played A-plays B-plays)) (B-play (player-B rounds-played B-plays A-plays))) ;; Add their choices to the play records, increase their scores ;; by the appropriate amounts, add 1 to the number of rounds ;; played, and proceed to the next round. (play-match-kernel player-A player-B (cons A-play A-plays) (cons B-play B-plays) (advance-score A-score A-play B-play) (advance-score B-score B-play A-play) (+ rounds-played 1)))))) (define advance-score (lambda (previous-score my-play your-play) (if (eq? my-play 'cooperation) (if (eq? your-play 'cooperation) (+ previous-score 3) ; We both cooperate -- 3 points previous-score) ; I cooperate, you defect -- I get 0. (if (eq? your-play 'cooperation) (+ previous-score 5) ; I defect, you cooperate -- I get 5. (+ previous-score 1))))) ; We both defect -- 1 point. ;;; ROSTER is an association list in which each player is associated with a ;;; string that identifies it. The procedures that stage the round-robin ;;; tournament use this association list to prepare the matches and display ;;; the scores. (define roster (list (cons just-mean "Just mean") (cons look-back "Look back") (cons point-seven "Point seven") (cons cheap "Cheap") (cons absentee "Absentee") (cons overtime "Overtime") (cons golden-rule "Golden rule") (cons tester "Tester") (cons zero-two "Zero/two"))) ;;; When you're ready to stage a tournament, load this file into Chez ;;; Scheme and then issue the following command: ;;; ;;; (load "/u2/stone/courses/scheme/tourney.ss") ;;; ;;; The definitions and commands in that file will run the tournament and ;;; display the results.