diff options
author | Robby Zambito <contact@robbyzambito.me> | 2022-01-23 20:14:17 -0500 |
---|---|---|
committer | Robby Zambito <contact@robbyzambito.me> | 2022-01-23 20:14:17 -0500 |
commit | bf049a8d4a879140dedce01c6e137a5d6c3d2c83 (patch) | |
tree | ae67cad7e6e6b2c9b7dd0946cf571c3429d81f95 /strategies/alpha.scm | |
parent | 233750ab72abb2101a9b35211b90c0318020b2c9 (diff) |
Added strategy which will weigh possible moves based on conditions
Diffstat (limited to 'strategies/alpha.scm')
-rw-r--r-- | strategies/alpha.scm | 128 |
1 files changed, 128 insertions, 0 deletions
diff --git a/strategies/alpha.scm b/strategies/alpha.scm new file mode 100644 index 0000000..73dfb2e --- /dev/null +++ b/strategies/alpha.scm @@ -0,0 +1,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)) |