blob: 368472ee6edb6e73e664db9d6c054c55f702d5e7 (
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
|
;;; ttt.scm
;;; Tic-Tac-Toe program
(define (ttt position me)
(one-okay-move (number-squares position) me))
(define (one-okay-move position me)
(find-one (lambda (sq) (no-lose? (plug-in me sq position) me))
(free-squares position)))
(define (no-lose? position me)
(cond ((already-lost? position me) #f)
((already-won? position me) #t)
(else (not (find-one (lambda (pos) (not (one-okay-move pos me)))
(extend position (opponent me)) )))))
(define (free-squares pos)
(keep number? pos))
(define (number-squares pos)
(ns-help pos 1))
(define (ns-help pos num)
(cond ((empty? pos) "")
((equal? (first pos) '_) (word num (ns-help (bf pos) (+ num 1))))
(else (word (first pos) (ns-help (bf pos) (+ num 1)))) ))
(define (plug-in letter sq pos)
(cond ((empty? pos) "")
((= sq 1) (word letter (bf pos)))
(else (word (first pos) (plug-in letter (- sq 1) (bf pos)))) ))
(define (find-one pred stuff)
(cond ((empty? stuff) #f)
((pred (first stuff)) (first stuff))
(else (find-one pred (bf stuff))) ))
(define (extend pos who)
(every (lambda (sq) (plug-in who sq pos))
(free-squares pos)))
(define (opponent letter)
(if (equal? letter 'x) 'o 'x))
(define (already-won? pos me)
(find-one (lambda (win) (match-win? pos me win))
'(yyynnnnnn nnnyyynnn nnnnnnyyy ynnynnynn nynnynnyn nnynnynny
ynnnynnny nnynynynn)))
(define (already-lost? pos me)
(already-won? pos (opponent me)))
(define (match-win? pos me win)
(cond ((empty? win) #t)
((equal? (first win) 'y)
(if (equal? (first pos) me)
(match-win? (bf pos) me (bf win))
#f))
(else (match-win? (bf pos) me (bf win))) ))
|