summaryrefslogtreecommitdiff
path: root/strategies/alpha.scm
blob: 91aa1a82e5309a69a3cbceb13f62a6718f3fe5ba (plain)
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
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
(use-modules (srfi srfi-1))

(define move cons)
(define move->row car)
(define move->col cdr)

(define (move-eq? a b)
  (and (eq? (move->row a)
            (move->row b))
       (eq? (move->col a)
            (move->col b))))

(define corner-moves
  (list (move 0 0)   ; top left
        (move 0 7)   ; top right
        (move 7 0)   ; bottom left
        (move 7 7))) ; bottom right

(define (in-next-row? a b)
  (eq? (+ 1 (move->row a))
       (move->row b)))

(define (in-previous-row? a b)
  (eq? (- 1 (move->row a))
       (move->row b)))

(define (in-next-col? a b)
  (eq? (+ 1 (move->col a))
       (move->row b)))

(define (in-previous-col? a b)
  (eq? (- 1 (move->col a))
       (move->row b)))

(define (corner-move? m)
  (member m corner-moves move-eq?))

; We always want to get a corner move
(define (corner-score m)
  (if (corner-move? m)
    1
    0))

(define (adjacent-to-corner? m)
  (any (lambda (corner)
         (or (and (eq? (move->col m)
                       (move->col corner))
                  (in-next-row? corner m))
             (and (eq? (move->row m)
                       (move->row corner))
                  (in-next-col? corner m))
             (and (eq? (move->col m)
                       (move->col corner))
                  (in-previous-row? corner m))
             (and (eq? (move->row m)
                       (move->row corner))
                  (in-previous-col? corner m))
             (and (in-next-row? corner m)
                  (in-next-col? corner m))
             (and (in-previous-row? corner m)
                  (in-previous-col? corner m))
             (and (in-previous-row? corner m)
                  (in-next-col? corner m))
             (and (in-next-row? corner m)
                  (in-previous-col? corner m))))
       corner-moves))

; Discourage going near a corner, which could allow opponent to go there
(define (near-corner-score m)
  (if (adjacent-to-corner? m)
    1
    0))

(define (is-edge? m)
  (or (eq? 0 (move->row m))
      (eq? 7 (move->row m))
      (eq? 0 (move->col m))
      (eq? 7 (move->col m))))

(define (edge-score m)
  (if (is-edge? m)
    1
    0))

(define (adjacent-to-edge? m)
  (or (eq? 1 (move->row m))
      (eq? 6 (move->row m))
      (eq? 1 (move->col m))
      (eq? 6 (move->col m))))

(define (near-edge-score m)
  (if (adjacent-to-edge? m)
    1
    0))

(define (first-or-else l d)
  (if (null? l)
    d
    (first l)))

(define (available-moves-for-opponent-after-move m)
  (length (valid-moves (apply-move m) (other-player))))

(define (maximum-flips-on-opponents-next-turn m)
  (let ((board-after-move (apply-move m)))
    (reduce
      max
      0
      (map (lambda (n)
             (flipped-by-move n board-after-move (other-player)))
           (valid-moves board-after-move (other-player))))))

; Score is the sum of some weighted conditions for a move
(define (move->score m)
  (+ (* (corner-score m)                             100)
     (* (near-corner-score m)                         -5)
     (* (edge-score m)                                 4)
     (* (near-edge-score m)                           -3)
     (* (flipped-by-move m)                            3)
     (* (available-moves-for-opponent-after-move m) -0.1)
     (* (maximum-flips-on-opponents-next-turn m)      -1)))

(define (score-sort a b)
  (> (move->score a)
     (move->score b)))

(first (sort (valid-moves)
             score-sort))