blob: 71adb0bdd3b61129b258670189f8b03f5ad4b583 (
plain) (
blame)
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
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
|
;;; ttt.scm
;;; Tic-Tac-Toe program
(define (ttt position me)
(ttt-choose (find-triples position) me))
(define (find-triples position)
(every (lambda (comb) (substitute-triple comb position))
'(123 456 789 147 258 369 159 357)))
(define (substitute-triple combination position)
(accumulate word
(every (lambda (square)
(substitute-letter square position))
combination) ))
(define (substitute-letter square position)
(if (equal? '_ (item square position))
square
(item square position) ))
(define (ttt-choose triples me)
(cond ((i-can-win? triples me))
((opponent-can-win? triples me))
((i-can-fork? triples me))
((i-can-advance? triples me))
(else (best-free-square triples)) ))
(define (i-can-win? triples me)
(choose-win
(keep (lambda (triple) (my-pair? triple me))
triples)))
(define (my-pair? triple me)
(and (= (appearances me triple) 2)
(= (appearances (opponent me) triple) 0)))
(define (opponent letter)
(if (equal? letter 'x) 'o 'x))
(define (choose-win winning-triples)
(if (empty? winning-triples)
#f
(keep number? (first winning-triples)) ))
(define (opponent-can-win? triples me)
(i-can-win? triples (opponent me)) )
(define (i-can-fork? triples me)
(first-if-any (pivots triples me)) )
(define (first-if-any sent)
(if (empty? sent)
#f
(first sent) ))
(define (pivots triples me)
(repeated-numbers (keep (lambda (triple) (my-single? triple me))
triples)))
(define (my-single? triple me)
(and (= (appearances me triple) 1)
(= (appearances (opponent me) triple) 0)))
(define (repeated-numbers sent)
(every first
(keep (lambda (wd) (>= (count wd) 2))
(sort-digits (accumulate word sent)) )))
(define (sort-digits number-word)
(every (lambda (digit) (extract-digit digit number-word))
'(1 2 3 4 5 6 7 8 9) ))
(define (extract-digit desired-digit wd)
(keep (lambda (wd-digit) (equal? wd-digit desired-digit)) wd))
(define (i-can-advance? triples me)
(best-move (keep (lambda (triple) (my-single? triple me)) triples)
triples
me))
(define (best-move my-triples all-triples me)
(if (empty? my-triples)
#f
(best-square (first my-triples) all-triples me) ))
(define (best-square my-triple triples me)
(best-square-helper (pivots triples (opponent me))
(keep number? my-triple)))
(define (best-square-helper opponent-pivots pair)
(if (member? (first pair) opponent-pivots)
(first pair)
(last pair)))
(define (best-free-square triples)
(first-choice (accumulate word triples)
'(5 1 3 7 9 2 4 6 8)))
(define (first-choice possibilities preferences)
(first (keep (lambda (square) (member? square possibilities))
preferences)))
|