a bunch of crap, and new players, and stuff
This commit is contained in:
parent
7282958dcc
commit
b3c576b140
10
arena.rkt
10
arena.rkt
|
@ -4,6 +4,12 @@
|
||||||
|
|
||||||
(require "main.rkt" "players.rkt")
|
(require "main.rkt" "players.rkt")
|
||||||
|
|
||||||
(define all-players '(player-random player-first player-last))
|
(define all-players (list player-random player-first player-last player-greedy player-nico player-generous))
|
||||||
|
|
||||||
(define matchups (append (combinations all-players 2) (map reverse (combinations all-players 2))))
|
(define matchups (append (combinations all-players 2) (map reverse (combinations all-players 2)) (for/list ([p all-players]) (list p p))))
|
||||||
|
|
||||||
|
(define (arena)
|
||||||
|
(define matches (for/list ([m matchups])
|
||||||
|
(start-game (first m) (second m) 6 6)))
|
||||||
|
(for ([m matches])
|
||||||
|
(save-game! m (format "/tmp/games/~a Vs ~a.dbn" (player-name (first (GameState-players m))) (player-name (second (GameState-players m)))))))
|
7
main.rkt
7
main.rkt
|
@ -231,15 +231,12 @@
|
||||||
(list (second (assoc 'score data)) (last (assoc 'score data)))
|
(list (second (assoc 'score data)) (last (assoc 'score data)))
|
||||||
`(
|
`(
|
||||||
,(player (last (assoc 'player0 data)) 0)
|
,(player (last (assoc 'player0 data)) 0)
|
||||||
,(player (last (assoc 'player1 data)) 0)
|
,(player (last (assoc 'player1 data)) 0)))))
|
||||||
))))
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
; Grid -> Image
|
; Grid -> Image
|
||||||
; renders grid to an image for showing humans the game.
|
; renders grid to an image for showing humans the game.
|
||||||
(define (render-grid-bitmap g)
|
(define (render-grid-bitmap g)
|
||||||
(let* ([bitmap (make-bitmap (+ 10 (* (grid-width g) GRID-SCALE)) (+ 10 (* (grid-width g) GRID-SCALE)))] ; add border for printing
|
(let* ([bitmap (make-bitmap (* (grid-width g) GRID-SCALE) (* (grid-width g) GRID-SCALE))] ; add border for printing
|
||||||
[dc (new bitmap-dc% [bitmap bitmap])])
|
[dc (new bitmap-dc% [bitmap bitmap])])
|
||||||
(render-grid g dc)
|
(render-grid g dc)
|
||||||
bitmap))
|
bitmap))
|
||||||
|
|
63
players.rkt
63
players.rkt
|
@ -4,7 +4,7 @@
|
||||||
|
|
||||||
(require "main.rkt" racket/random)
|
(require "main.rkt" racket/random)
|
||||||
|
|
||||||
(provide player-random player-first player-last)
|
(provide player-random player-first player-last player-greedy player-generous player-nico)
|
||||||
|
|
||||||
; a Player that plays random moves
|
; a Player that plays random moves
|
||||||
(define player-random
|
(define player-random
|
||||||
|
@ -29,3 +29,64 @@
|
||||||
(lambda (g n)
|
(lambda (g n)
|
||||||
(let ([m (last (valid-moves g))])
|
(let ([m (last (valid-moves g))])
|
||||||
(line (line-from m) (line-to m) n)))))
|
(line (line-from m) (line-to m) n)))))
|
||||||
|
|
||||||
|
; if a move completes a box, play it. Otherwise, play a random move.
|
||||||
|
; This isn't a "perfect" greedy - it will sometimes take a single box instead of two.
|
||||||
|
(define player-greedy
|
||||||
|
(player
|
||||||
|
"Greedy"
|
||||||
|
(lambda (g n)
|
||||||
|
(let* ([moves (valid-moves g)]
|
||||||
|
[box-finishing-moves
|
||||||
|
(filter (lambda (m) (not (= 0 (completes-boxes g m)))) moves)])
|
||||||
|
(cond
|
||||||
|
[(empty? box-finishing-moves)
|
||||||
|
(let ([m (car (random-sample (valid-moves g) 1))])
|
||||||
|
(line (line-from m) (line-to m) n))]
|
||||||
|
[else (line (line-from (first box-finishing-moves)) (line-to (first box-finishing-moves)) n)])))))
|
||||||
|
|
||||||
|
; helper function for determining if a move makes a three-sided box.
|
||||||
|
(define (three? gr l)
|
||||||
|
(let
|
||||||
|
([boxes (boxes-for l gr)]
|
||||||
|
[g (append-move gr l)])
|
||||||
|
(not (= 0 (length (filter (lambda (b) (= (count-box b g) 3)) boxes))))))
|
||||||
|
|
||||||
|
; if a move completes a box, play it. Otherwise, play a move that avoids making a three-sided box. Otherwise, play a random move.
|
||||||
|
; this is reflective of a common simple human strategy, and the strategy that the program author uses. Hence, it is named for them.
|
||||||
|
(define player-nico
|
||||||
|
(player
|
||||||
|
"Nico-bot"
|
||||||
|
(lambda (g n)
|
||||||
|
(let* ([moves (valid-moves g)]
|
||||||
|
[non-three-moves (filter (lambda (m) (not (three? g m))) moves)]
|
||||||
|
[box-finishing-moves
|
||||||
|
(filter (lambda (m) (not (= 0 (completes-boxes g m)))) moves)])
|
||||||
|
(cond
|
||||||
|
[(not (empty? box-finishing-moves)) (line (line-from (first box-finishing-moves)) (line-to (first box-finishing-moves)) n)]
|
||||||
|
[(not (empty? non-three-moves))
|
||||||
|
(let ([m (car (random-sample non-three-moves 1))])
|
||||||
|
(line (line-from m) (line-to m) n))]
|
||||||
|
[else
|
||||||
|
(let ([m (car (random-sample (valid-moves g) 1))])
|
||||||
|
(line (line-from m) (line-to m) n))])))))
|
||||||
|
|
||||||
|
; tries to give up boxes to the opponent whenever possible and deliberately avoids taking boxes ever
|
||||||
|
(define player-generous
|
||||||
|
(player
|
||||||
|
"Generous"
|
||||||
|
(lambda (g n)
|
||||||
|
(let* ([moves (valid-moves g)]
|
||||||
|
[three-moves (filter (lambda (m) (three? g m)) moves)]
|
||||||
|
[non-box-finishing-moves
|
||||||
|
(filter (lambda (m) (= 0 (completes-boxes g m))) moves)])
|
||||||
|
(cond
|
||||||
|
[(not (empty? three-moves))
|
||||||
|
(let ([m (car (random-sample three-moves 1))])
|
||||||
|
(line (line-from m) (line-to m) n))]
|
||||||
|
[(not (empty? non-box-finishing-moves))
|
||||||
|
(let ([m (car (random-sample non-box-finishing-moves 1))])
|
||||||
|
(line (line-from m) (line-to m) n))]
|
||||||
|
[else
|
||||||
|
(let ([m (car (random-sample (valid-moves g) 1))])
|
||||||
|
(line (line-from m) (line-to m) n))])))))
|
Loading…
Reference in New Issue