forked from darius/transparent-dilemma
-
Notifications
You must be signed in to change notification settings - Fork 0
/
play.scm
60 lines (50 loc) · 1.73 KB
/
play.scm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
(define (play player-1 player-2)
(let ((decision-1 (run-1 player-1 player-2))
(decision-2 (run-1 player-2 player-1)))
(let ((p (assoc (list decision-1 decision-2) payoff-matrix)))
(list (if p (cadr p) '(0 0))
decision-1
decision-2))))
(define payoff-matrix
'(((C C) (4 4))
((D D) (1 1))
((C D) (0 7))
((D C) (7 0))))
(define (run-1 player other)
(let ((result (start (list player player other))))
(let ((remaining (car result))
(value (cadr result)))
(and (<= 0 remaining) value))))
;; Tests
(define (test1)
(play all-C all-D))
(define all-C '(lambda (me them) 'C))
(define all-D '(lambda (me them) 'D))
(define erroneous '(lambda (me them) (car)))
(define too-deep '(lambda (me them)
((lambda (f) (f f))
(lambda (f) (f f)))))
;; Example agent: cooperate with shallow, cooperative agents (first cut)
(define eg
'(lambda (me them)
(let ((result (run 1000
(list them them me)
(rebind 'run run ;TODO: interpose a new RUN
(global-environment)))))
(let ((remaining (car result))
(value (cadr result)))
(if (< 500 remaining)
(if (equal? value 'C)
'C
'D)
'D)))))
(define all-players (list all-C all-D erroneous too-deep eg))
(define (tournament)
(let outer ((players all-players))
(if (or (null? players) (null? (cdr players)))
'()
(let ((player (car players))
(others (cdr players)))
(cons (map (lambda (other) (list player other (play player other)))
players)
(outer others))))))