lots of changes, nearly 0.2.0
This commit is contained in:
parent
e92a636ae8
commit
979d1239da
121
board.lisp
121
board.lisp
|
@ -92,23 +92,71 @@
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
(defclass ranked-board (basic-board)
|
||||||
|
((rank-list
|
||||||
|
:initarg rank-list
|
||||||
|
:initform nil
|
||||||
|
:accessor rank-list)
|
||||||
|
(rank-top-list
|
||||||
|
:initarg rank-top-list
|
||||||
|
:initform nil
|
||||||
|
:accessor rank-top-list)
|
||||||
|
(rank-highest
|
||||||
|
:initarg rank-highest
|
||||||
|
:initform nil
|
||||||
|
:accessor rank-highest)
|
||||||
|
(rank-count
|
||||||
|
:initarg rank-count
|
||||||
|
:initform 0
|
||||||
|
:accessor rank-count)
|
||||||
|
(rank-top-count
|
||||||
|
:initarg rank-top-count
|
||||||
|
:initform 0
|
||||||
|
:accessor rank-top-count)))
|
||||||
|
|
||||||
|
|
||||||
|
(defun insert (list comp var)
|
||||||
|
(if (funcall comp (car list) var)
|
||||||
|
(cons var list)
|
||||||
|
(cons (car list) (insert (cdr list) comp var))))
|
||||||
|
|
||||||
|
|
||||||
|
(defmethod set-stone :after ((board ranked-board) coords val)
|
||||||
|
(incf (rank-count board))
|
||||||
|
(if (or (eql (rank-highest board) nil) (>= val (rank-highest board)))
|
||||||
|
(progn
|
||||||
|
(setf (rank-list board) (cons `(,val ,coords) (rank-list board)))
|
||||||
|
(if (or (eql (rank-highest board) nil) (> val (rank-highest board)))
|
||||||
|
(progn
|
||||||
|
(setf (rank-highest board) val)
|
||||||
|
(setf (rank-top-count board) 1)
|
||||||
|
(setf (rank-top-list board) `((,val ,coords))))
|
||||||
|
(progn
|
||||||
|
(incf (rank-top-count board))
|
||||||
|
(setf (rank-top-list board) (cons `(,val ,coords) (rank-top-list board))))))
|
||||||
|
(if (= (rank-count board) 1)
|
||||||
|
(setf (rank-list board) `((,val ,coords)))
|
||||||
|
(setf (rank-list board) (insert (rank-list board) #'(lambda (a b) (>= (first a) (first b))) `(,val ,coords))))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(defgeneric prune (board prune-board)
|
(defgeneric prune (board prune-board)
|
||||||
(:documentation "board is the board we are working from, prune-board is an initially all t's board and each no go place is set to nil"))
|
(:documentation "board is the board we are working from, prune-board is an initially all t's board and each no go place is set to nil"))
|
||||||
|
|
||||||
|
(def-over-board prune-placed-stones (coord board prune-board)
|
||||||
|
(if (not (eql (get-stone board coord) nil))
|
||||||
|
(set-stone prune-board coord nil)))
|
||||||
|
|
||||||
|
|
||||||
(defmethod prune ((board basic-board) prune-board)
|
(defmethod prune ((board basic-board) prune-board)
|
||||||
(prune-placed-stones board prune-board))
|
(prune-placed-stones board prune-board))
|
||||||
|
|
||||||
|
|
||||||
(def-over-board prune-placed-stones (coord board prune-board)
|
|
||||||
(if (not (eql (get-stone board coord) nil))
|
|
||||||
(set-stone prune-board coord nil)))
|
|
||||||
|
|
||||||
;(defun prune-placed-stones (board prune-board)
|
|
||||||
; (do-over-board (coord board)
|
|
||||||
; (if (not (eql (get-stone board coord) nil))
|
|
||||||
; (set-stone prune-board coord nil))))
|
|
||||||
|
|
||||||
;(defgeneric prune :after ((board liberty-board) prune-board)
|
;(defgeneric prune :after ((board liberty-board) prune-board)
|
||||||
; (prunce-suicide board prunce-board))
|
; (prunce-suicide board prunce-board))
|
||||||
|
@ -123,28 +171,57 @@
|
||||||
(if (not (eql (get-stone prune-board coord) nil))
|
(if (not (eql (get-stone prune-board coord) nil))
|
||||||
(set-stone focus-board coord 1))))
|
(set-stone focus-board coord 1))))
|
||||||
|
|
||||||
|
(defgeneric search-space (board focus-board score-board player depth)
|
||||||
|
)
|
||||||
|
|
||||||
|
(defmacro invert-player (player)
|
||||||
|
(if (eql player #\w)
|
||||||
|
#\b
|
||||||
|
#\w))
|
||||||
|
|
||||||
|
; multiplex the search here
|
||||||
|
(defmethod search-space ((board basic-board) focus-board score-board player depth)
|
||||||
|
; (rank-count board) / basic-proc-unit
|
||||||
|
(do-over-board (coord board)
|
||||||
|
(if (not (eql (get-stone focus-board coord) nil))
|
||||||
|
(let ((newboard (make-instance (class-of board) :from-board board)))
|
||||||
|
(set-stone newboard coord player)
|
||||||
|
(set-stone score-board coord (first (genmove newboard (invert-player player):depth (1- depth))))))))
|
||||||
|
|
||||||
|
|
||||||
|
(defgeneric score (board player)
|
||||||
|
)
|
||||||
|
|
||||||
|
(defmethod score ((board basic-board) player)
|
||||||
|
1)
|
||||||
|
|
||||||
|
|
||||||
|
(defgeneric select-move (board) )
|
||||||
|
|
||||||
|
(defmethod select-move ((board ranked-board))
|
||||||
|
(if (eql (rank-top-count board) 0)
|
||||||
|
'(-1 (-1 -1))
|
||||||
|
(car (nthcdr (random (rank-top-count board)) (rank-top-list board)))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
(defgeneric genmove (board player &key))
|
||||||
|
|
||||||
; generate a same sized board with a def type
|
; generate a same sized board with a def type
|
||||||
(defmacro gen-board (board def-type)
|
(defmacro gen-board (board def-type &optional (class ''basic-board))
|
||||||
`(make-instance 'basic-board :boardsize (boardsize ,board) :board-def-type ,def-type))
|
`(make-instance ,class :boardsize (boardsize ,board) :board-def-type ,def-type))
|
||||||
|
|
||||||
(defmethod genmove ((board basic-board) player)
|
(defmethod genmove ((board basic-board) player &key (depth 1))
|
||||||
(let ((prune-board (gen-board board t))
|
(if (= depth 0)
|
||||||
(focus-board (gen-board board nil))
|
`( ,(score board player) nil)
|
||||||
(score-board (gen-board board nil)))
|
(let ((score-board (make-instance 'ranked-board :boardsize (boardsize board) :board-def-type nil)) ;(gen-board board 0 'ranked-board))
|
||||||
|
(prune-board (gen-board board t))
|
||||||
(prune board prune-board)))
|
(focus-board (gen-board board nil)))
|
||||||
|
(progn
|
||||||
|
(prune board prune-board)
|
||||||
(focus board prune-board focus-board player)
|
(focus board prune-board focus-board player)
|
||||||
; (score board focus-board score-board player)
|
(search-space board focus-board score-board player depth)
|
||||||
; (select-move score-board)))
|
(select-move score-board)))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
;(defun make-move (board player)
|
;(defun make-move (board player)
|
||||||
; (select-move (score board player)))
|
; (select-move (score board player)))
|
||||||
|
|
19
env.lisp
19
env.lisp
|
@ -11,14 +11,15 @@
|
||||||
|
|
||||||
(defparameter *src-root* "/home/dan/src/my/gobot/")
|
(defparameter *src-root* "/home/dan/src/my/gobot/")
|
||||||
|
|
||||||
(load (compile-file (concatenate 'string *src-root* "packages.lisp")))
|
(defun recompile ()
|
||||||
(load (compile-file (concatenate 'string *src-root* "macro-utils.lisp")))
|
(compile-file (concatenate 'string *src-root* "packages.lisp"))
|
||||||
(load (compile-file (concatenate 'string *src-root* "netpipe.lisp")))
|
(compile-file (concatenate 'string *src-root* "macro-utils.lisp"))
|
||||||
(load (compile-file (concatenate 'string *src-root* "board.lisp")))
|
(compile-file (concatenate 'string *src-root* "netpipe.lisp"))
|
||||||
(load (compile-file (concatenate 'string *src-root* "gobot.lisp")))
|
(compile-file (concatenate 'string *src-root* "board.lisp"))
|
||||||
(load (compile-file (concatenate 'string *src-root* "gtp.lisp")))
|
(compile-file (concatenate 'string *src-root* "gobot.lisp"))
|
||||||
|
(compile-file (concatenate 'string *src-root* "gtp.lisp"))
|
||||||
|
(compile-file (concatenate 'string *src-root* "fink.lisp")))
|
||||||
|
|
||||||
|
(recompile)
|
||||||
|
|
||||||
;(load (concatenate 'string *src-root* "packages.lisp"))
|
|
||||||
;(load (concatenate 'string *src-root* "gobot.lisp"))
|
|
||||||
;(load (concatenate 'string *src-root* "gtp.lisp"))
|
|
||||||
|
|
||||||
|
|
|
@ -2,6 +2,7 @@
|
||||||
|
|
||||||
(defparameter *src-root* "/home/dan/src/my/gobot/")
|
(defparameter *src-root* "/home/dan/src/my/gobot/")
|
||||||
|
|
||||||
|
|
||||||
(load (concatenate 'string *src-root* "packages.fasl"))
|
(load (concatenate 'string *src-root* "packages.fasl"))
|
||||||
(load (concatenate 'string *src-root* "macro-utils.fasl"))
|
(load (concatenate 'string *src-root* "macro-utils.fasl"))
|
||||||
(load (concatenate 'string *src-root* "netpipe.fasl"))
|
(load (concatenate 'string *src-root* "netpipe.fasl"))
|
||||||
|
|
20
gobot.lisp
20
gobot.lisp
|
@ -1,7 +1,7 @@
|
||||||
(in-package :go-bot)
|
(in-package :go-bot)
|
||||||
|
|
||||||
(defparameter *name* "fink")
|
(defparameter *name* "fink")
|
||||||
(defparameter *version* "0.2.0-dev")
|
(defparameter *version* "0.2.0")
|
||||||
(defparameter *author* "Dan Ballard")
|
(defparameter *author* "Dan Ballard")
|
||||||
|
|
||||||
(defparameter *default-komi* 5.5)
|
(defparameter *default-komi* 5.5)
|
||||||
|
@ -11,7 +11,6 @@
|
||||||
|
|
||||||
(defparameter *board* nil)
|
(defparameter *board* nil)
|
||||||
|
|
||||||
(defparameter *score-functions* '( (score-unused 1)))
|
|
||||||
(defparameter *passed* nil)
|
(defparameter *passed* nil)
|
||||||
(defparameter *player* nil)
|
(defparameter *player* nil)
|
||||||
(defparameter *last-player* nil)
|
(defparameter *last-player* nil)
|
||||||
|
@ -24,7 +23,7 @@
|
||||||
(setf *boardsize* newsize))
|
(setf *boardsize* newsize))
|
||||||
|
|
||||||
(defun init-board ()
|
(defun init-board ()
|
||||||
(setf *board* (make-instance 'board :boardsize *boardsize*))
|
(setf *board* (make-instance 'basic-board :boardsize *boardsize*))
|
||||||
(setf *passed* nil)
|
(setf *passed* nil)
|
||||||
(setf *player* nil))
|
(setf *player* nil))
|
||||||
|
|
||||||
|
@ -34,8 +33,8 @@
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(defmethod play ((board board) coords player)
|
(defun play (board coords player)
|
||||||
(set-stone (board board) coords player))
|
(set-stone board coords player))
|
||||||
|
|
||||||
|
|
||||||
(defun do-play (player coord-str)
|
(defun do-play (player coord-str)
|
||||||
|
@ -49,7 +48,12 @@
|
||||||
(setf *player* player)
|
(setf *player* player)
|
||||||
(if (or (eql *passed* t) (eql *last-player* player))
|
(if (or (eql *passed* t) (eql *last-player* player))
|
||||||
"pass"
|
"pass"
|
||||||
(let ((move (coord-to-str (genmove *board* player))))
|
(let* ((move (coord-to-str (genmove *board* player)))
|
||||||
(do-play player move)
|
(score (first move))
|
||||||
move)))
|
(coord (coord-to-str (second move))))
|
||||||
|
(if (< score 0)
|
||||||
|
"pass"
|
||||||
|
(progn
|
||||||
|
(do-play player coord)
|
||||||
|
coord)))))
|
||||||
|
|
||||||
|
|
4
gtp.lisp
4
gtp.lisp
|
@ -17,9 +17,9 @@
|
||||||
(do ()
|
(do ()
|
||||||
((or (eql socket nil) (eql *quit?* t)))
|
((or (eql socket nil) (eql *quit?* t)))
|
||||||
(let ((cmd (tcp-read socket)))
|
(let ((cmd (tcp-read socket)))
|
||||||
;(format t "cmd: '~a'~%'" cmd)
|
(format t "cmd: '~a'~%'" cmd)
|
||||||
(let ((resp (dispatch-gtp-command cmd)))
|
(let ((resp (dispatch-gtp-command cmd)))
|
||||||
;(print resp)
|
(print resp)
|
||||||
(tcp-print socket (concatenate 'string "= " resp (string #\newline) (string #\newline))))))))))
|
(tcp-print socket (concatenate 'string "= " resp (string #\newline) (string #\newline))))))))))
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -39,7 +39,7 @@ using namespace std;
|
||||||
#define TRUE 1
|
#define TRUE 1
|
||||||
#define FALSE 0
|
#define FALSE 0
|
||||||
|
|
||||||
#define TCPPORT 10000 /* server port value */
|
#define TCPPORT 10001 /* server port value */
|
||||||
#define BUFSIZE 1024 /* size of i/o buffer */
|
#define BUFSIZE 1024 /* size of i/o buffer */
|
||||||
#define NOREADS 10 /* number of buffers transferred */
|
#define NOREADS 10 /* number of buffers transferred */
|
||||||
|
|
||||||
|
|
|
@ -8,7 +8,7 @@
|
||||||
(sb-bsd-sockets:host-ent-address (sb-bsd-sockets:get-host-by-name hostname))
|
(sb-bsd-sockets:host-ent-address (sb-bsd-sockets:get-host-by-name hostname))
|
||||||
nil))
|
nil))
|
||||||
|
|
||||||
(defun tcp-connect (server port); &optional (timeout 10))
|
(defun tcp-connect (server port)
|
||||||
(handler-case
|
(handler-case
|
||||||
(let ((socket (make-instance 'sb-bsd-sockets:inet-socket :type :stream :protocol :tcp)))
|
(let ((socket (make-instance 'sb-bsd-sockets:inet-socket :type :stream :protocol :tcp)))
|
||||||
(sb-bsd-sockets:socket-connect socket (nslookup server) port)
|
(sb-bsd-sockets:socket-connect socket (nslookup server) port)
|
||||||
|
@ -26,7 +26,7 @@
|
||||||
(defun tcp-print (socket line)
|
(defun tcp-print (socket line)
|
||||||
(tcp-print-raw socket (concatenate 'string (format nil "~04d" (length line)) line)))
|
(tcp-print-raw socket (concatenate 'string (format nil "~04d" (length line)) line)))
|
||||||
|
|
||||||
(defun tcp-read-raw (socket &key (maxsize 65536)); (timeout 10))
|
(defun tcp-read-raw (socket &key (maxsize 65536))
|
||||||
(when socket
|
(when socket
|
||||||
(values (sb-bsd-sockets:socket-receive socket nil maxsize))))
|
(values (sb-bsd-sockets:socket-receive socket nil maxsize))))
|
||||||
|
|
||||||
|
|
|
@ -30,7 +30,8 @@
|
||||||
:get-stone
|
:get-stone
|
||||||
:set-stone
|
:set-stone
|
||||||
:coord-to-str
|
:coord-to-str
|
||||||
:str-to-coord))
|
:str-to-coord
|
||||||
|
:genmove))
|
||||||
|
|
||||||
(defpackage go-bot
|
(defpackage go-bot
|
||||||
(:use :common-lisp
|
(:use :common-lisp
|
||||||
|
|
Loading…
Reference in New Issue