128 lines
5.2 KiB
Scheme
128 lines
5.2 KiB
Scheme
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Rate a move by a combination of counting strategies
|
|
;;
|
|
;; This code benefits greatly from mzc compilation.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(module counter mzscheme
|
|
(require "board.ss"
|
|
"utils.ss"
|
|
mzlib/unitsig)
|
|
|
|
(provide params^
|
|
counter@)
|
|
|
|
(define-signature params^
|
|
(US-PIECE-WEIGHT
|
|
US-MIDDLE-PIECE-WEIGHT
|
|
US-LINE-PIECE-WEIGHT
|
|
US-CONNECT-PIECE-WEIGHT
|
|
|
|
THEM-PIECE-WEIGHT
|
|
THEM-MIDDLE-PIECE-WEIGHT
|
|
THEM-LINE-PIECE-WEIGHT
|
|
THEM-CONNECT-PIECE-WEIGHT
|
|
|
|
turn-number))
|
|
|
|
|
|
(define counter@
|
|
(unit/sig ()
|
|
(import (n) params^)
|
|
|
|
(define (counter-based-goodness board orig-board as-player depth)
|
|
(let ([usses 0]
|
|
[thems 0]
|
|
[middle-usses 0]
|
|
[middle-thems 0]
|
|
[us-in-line 0]
|
|
[them-in-line 0]
|
|
[us-connect 0]
|
|
[them-connect 0])
|
|
(let ([traverse
|
|
(lambda (board-cell)
|
|
(n-times n (lambda (i)
|
|
(let ([start-usses usses]
|
|
[start-thems thems]
|
|
[prev #f])
|
|
(n-times n (lambda (j)
|
|
(let ([v (board-cell board i j)])
|
|
(cond
|
|
[(eq? v as-player) (set! usses (add1 usses))
|
|
(set! middle-usses (+ (min i (- (sub1 n) i)) middle-usses))
|
|
(when (eq? v prev)
|
|
(set! us-connect (add1 us-connect)))]
|
|
[(eq? v none) 'nothing]
|
|
[else (set! thems (add1 thems))
|
|
(set! middle-thems (+ (min i (- (sub1 n) i)) middle-thems))
|
|
(when (eq? v prev)
|
|
(set! them-connect (add1 them-connect)))])
|
|
(set! prev v))))
|
|
(set! us-in-line (+ us-in-line (* (- usses start-usses) (- usses start-usses))))
|
|
(set! them-in-line (+ them-in-line (* (- thems start-thems) (- thems start-thems))))))))])
|
|
;; Go down columns
|
|
(traverse board-cell)
|
|
;; Go across rows
|
|
(traverse (lambda (b x y) (board-cell b y x)))
|
|
;; Counted usses and thems twice
|
|
(set! usses (/ usses 2))
|
|
(set! thems (/ thems 2)))
|
|
|
|
'(when (= depth 2)
|
|
(fprintf (current-error-port)
|
|
"us: ~a them: ~a u-m:~a t-m: ~a u-l: ~a t-l: ~a u-c: ~a t-c: ~a~n"
|
|
usses thems
|
|
middle-usses middle-thems
|
|
us-in-line them-in-line
|
|
us-connect them-connect))
|
|
|
|
(+ 0
|
|
|
|
;; If it's early in the game, bias towards the middle
|
|
(* middle-usses US-MIDDLE-PIECE-WEIGHT)
|
|
(* middle-thems THEM-MIDDLE-PIECE-WEIGHT)
|
|
|
|
;; We'd prefer to get rid of thems and not get rid of usses
|
|
(* usses US-PIECE-WEIGHT)
|
|
(* thems THEM-PIECE-WEIGHT)
|
|
|
|
;; Working towards a line is good
|
|
(* us-in-line US-LINE-PIECE-WEIGHT)
|
|
(* them-in-line THEM-LINE-PIECE-WEIGHT)
|
|
|
|
;; Working towards connected parts is good
|
|
(* us-connect US-CONNECT-PIECE-WEIGHT)
|
|
(* them-connect THEM-CONNECT-PIECE-WEIGHT)
|
|
|
|
|
|
;;;;;;;;;;;;; High-level strategy ;;;;;;;;;;;;;;;;;
|
|
|
|
;; o: don't start on the same or opposite edge unless X is immediately
|
|
;; pushed.
|
|
(if (and (= turn-number 1) (= usses 1) (= thems 1)
|
|
(ormap (lambda (x) x)
|
|
(n-map n (lambda (i) (or (eq? (board-cell board i 0) x)
|
|
(eq? (board-cell board i (sub1 n)) x))))))
|
|
-500
|
|
0)
|
|
|
|
;; x, first reply: always meddle with o's move if it's not in a corner
|
|
(if (and (= turn-number 2) (= usses 2) (= thems 1)
|
|
(not (or (eq? (board-cell orig-board 0 0) o)
|
|
(eq? (board-cell orig-board 0 (sub1 n)) o)
|
|
(eq? (board-cell orig-board (sub1 n) 0) o)
|
|
(eq? (board-cell orig-board (sub1 n) 0) o))))
|
|
|
|
(if (ormap (lambda (x) x) (n-map (- n 2) (lambda (i) (eq? (board-cell board (add1 i) 1) o))))
|
|
;; We pushed it
|
|
500
|
|
|
|
;; Do a push, instead
|
|
-500)
|
|
|
|
0)
|
|
|
|
0)))
|
|
|
|
counter-based-goodness)))
|