some key fixes, expecially coord fix, bit work on liberties, and some gogui integration
This commit is contained in:
Dan
parent
f798ac5dcd
commit
94b95cbcdb
2
Makefile
2
Makefile
|
|
@ -5,7 +5,7 @@ CCEND=")' --eval '(quit)'
|
|||
default: fink.fasl
|
||||
|
||||
fink.fasl:
|
||||
sbcl --noinform --load 'env.lisp' --eval '(quit)'
|
||||
sbcl --noinform --load 'env.lisp' --eval '(quit)'
|
||||
|
||||
#$(CC)env.lisp$(CCEND)
|
||||
#$(CC)fink.lisp$(CCEND)
|
||||
|
|
|
|||
60
board.lisp
60
board.lisp
|
|
@ -21,7 +21,9 @@
|
|||
number))
|
||||
|
||||
(defun str-to-coord (str)
|
||||
`( ,(filter-i-number (- (char-code (char (string-upcase str) 0)) 65)) ,(- (parse-integer (subseq str 1)) 1)))
|
||||
`(,(abs (- (parse-integer (subseq str 1)) 19)) ,(filter-i-number (- (char-code (char (string-upcase str) 0)) 65))))
|
||||
|
||||
; `( ,(filter-i-number (- (char-code (char (string-upcase str) 0)) 65)) ,(- (parse-integer (subseq str 1)) 1)))
|
||||
|
||||
(defun filter-i-char (number)
|
||||
(if (>= number 8)
|
||||
|
|
@ -29,8 +31,11 @@
|
|||
number))
|
||||
|
||||
(defun coord-to-str (coord)
|
||||
(concatenate 'string (string (code-char (+ 65 (filter-i-char (first coord)))))
|
||||
(write-to-string (+ (second coord) 1))))
|
||||
(concatenate 'string (string (code-char (+ 65 (filter-i-char (second coord)))))
|
||||
(write-to-string (+ (- (first coord)) 19))))
|
||||
|
||||
; (concatenate 'string (string (code-char (+ 65 (filter-i-char (first coord)))))
|
||||
; (write-to-string (+ (second coord) 1))))
|
||||
|
||||
|
||||
|
||||
|
|
@ -69,6 +74,7 @@
|
|||
;(defgeneric (setf stone) (val coords
|
||||
|
||||
(defmethod initialize-instance :after ((board basic-board) &key from-board)
|
||||
; (format t "init basic-board~%")
|
||||
(if (eql from-board nil)
|
||||
(setf (board board) (make-2d-board (boardsize board) (board-def-type board)))
|
||||
(progn
|
||||
|
|
@ -114,12 +120,15 @@
|
|||
:initform 0
|
||||
:accessor rank-top-count)))
|
||||
|
||||
(defmacro copy-slots (slots src dst)
|
||||
`(progn ,@(loop for slot in slots collect `(setf (,slot ,src) (,slot ,dst)))))
|
||||
(defmacro copy-slots (slots dst src)
|
||||
`(progn ,@(loop for slot in slots collect `(setf (,slot ,dst) (,slot ,src)))))
|
||||
|
||||
(defmethod initialize-instance :after ((board ranked-board) &key from-board)
|
||||
(if (eql from-board nil)
|
||||
(setf (rank-highest board) (rank-highest from-board))
|
||||
(if (not (eql from-board nil))
|
||||
(progn
|
||||
(copy-slots (rank-highest rank-count rank-top-count) board from-board)
|
||||
(setf (rank-list board) (copy-seq (rank-list from-board)))
|
||||
(setf (rank-top-list board) (copy-seq (rank-top-list from-board))))))
|
||||
|
||||
|
||||
|
||||
|
|
@ -130,6 +139,7 @@
|
|||
|
||||
|
||||
(defmethod set-stone :after ((board ranked-board) coords val)
|
||||
; (format t "~a ~a~%" coords val)
|
||||
(incf (rank-count board))
|
||||
(if (or (eql (rank-highest board) nil) (>= val (rank-highest board)))
|
||||
(progn
|
||||
|
|
@ -198,13 +208,14 @@
|
|||
|
||||
|
||||
(defgeneric score (board player)
|
||||
)
|
||||
(:method-combination + :most-specific-last))
|
||||
|
||||
(defmethod score ((board basic-board) player)
|
||||
(defmethod score + ((board basic-board) player)
|
||||
1)
|
||||
|
||||
|
||||
(defgeneric select-move (board) )
|
||||
(defgeneric select-move (board)
|
||||
)
|
||||
|
||||
(defmethod select-move ((board ranked-board))
|
||||
(if (eql (rank-top-count board) 0)
|
||||
|
|
@ -221,7 +232,7 @@
|
|||
|
||||
(defmethod genmove ((board basic-board) player &key (depth 1))
|
||||
(if (= depth 0)
|
||||
`( ,(score board player) nil)
|
||||
`( ,(score board (invert-player player)) 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))
|
||||
(focus-board (gen-board board nil)))
|
||||
|
|
@ -230,6 +241,33 @@
|
|||
(focus board prune-board focus-board player)
|
||||
(search-space board focus-board score-board player depth)
|
||||
(select-move score-board)))))
|
||||
|
||||
(defun board-to-analyze (board)
|
||||
(let ((resp "LABEL "))
|
||||
(dotimes (x (length board))
|
||||
;(format t "x:~a~%" x)
|
||||
(dotimes (y (length board))
|
||||
;(format t "y:~a~%" y)
|
||||
(let ((coord `(,x ,y)))
|
||||
|
||||
(setf resp (concatenate 'string resp (coord-to-str coord) " "
|
||||
(if (eql (get-2d-stone board coord) nil)
|
||||
"0 "
|
||||
(write-to-string (get-2d-stone board coord))) " ")))
|
||||
(concatenate 'string resp '(#\newline))))
|
||||
resp))
|
||||
|
||||
(defun analyze-board-score (board player)
|
||||
(let ((score-board (make-instance 'basic-board :boardsize (boardsize board) :board-def-type nil)))
|
||||
(progn
|
||||
(do-over-board (coord board)
|
||||
(if (eql (get-stone board coord) nil)
|
||||
(let ((newboard (make-instance (class-of board) :from-board board)))
|
||||
(set-stone newboard coord player)
|
||||
(set-stone score-board coord (first (score newboard player))))))
|
||||
(board-to-analyze (board score-board)))))
|
||||
|
||||
|
||||
|
||||
;(defun make-move (board player)
|
||||
; (select-move (score board player)))
|
||||
|
|
|
|||
3
env.lisp
3
env.lisp
|
|
@ -16,10 +16,11 @@
|
|||
(compile-file (concatenate 'string *src-root* "macro-utils.lisp"))
|
||||
(compile-file (concatenate 'string *src-root* "netpipe.lisp"))
|
||||
(compile-file (concatenate 'string *src-root* "board.lisp"))
|
||||
(compile-file (concatenate 'string *src-root* "liberty-shape.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* "fink.fasl"))
|
||||
|
|
|
|||
|
|
@ -7,5 +7,6 @@
|
|||
(load (concatenate 'string *src-root* "macro-utils.fasl"))
|
||||
(load (concatenate 'string *src-root* "netpipe.fasl"))
|
||||
(load (concatenate 'string *src-root* "board.fasl"))
|
||||
(load (concatenate 'string *src-root* "liberty-shape.fasl"))
|
||||
(load (concatenate 'string *src-root* "gobot.fasl"))
|
||||
(load (concatenate 'string *src-root* "gtp.fasl"))
|
||||
|
|
|
|||
24
gobot.lisp
24
gobot.lisp
|
|
@ -16,6 +16,9 @@
|
|||
(defparameter *player* nil)
|
||||
(defparameter *last-player* nil)
|
||||
|
||||
(defclass composite-board (liberty-board)
|
||||
((final
|
||||
:initform 0)))
|
||||
|
||||
(defun set-komi (new-komi)
|
||||
(setf *komi* new-komi))
|
||||
|
|
@ -24,12 +27,15 @@
|
|||
(setf *boardsize* newsize))
|
||||
|
||||
(defun init-board ()
|
||||
(setf *board* (make-instance 'basic-board :boardsize *boardsize*))
|
||||
(setf *board* (make-instance 'composite-board :boardsize *boardsize*))
|
||||
(setf *passed* nil)
|
||||
(setf *player* nil))
|
||||
(setf *player* nil)
|
||||
(setf *last-player* nil))
|
||||
|
||||
|
||||
(defun init ()
|
||||
;(init other game specific stuff)
|
||||
(setf *random-state* (make-random-state t))
|
||||
(setf *cputime* 0.0)
|
||||
(init-board))
|
||||
|
||||
|
|
@ -44,18 +50,26 @@
|
|||
(if (string= coord-str "PASS")
|
||||
(setf *passed* t)
|
||||
;(set-stone *board* (str-to-coord coord-str) player)))
|
||||
(play *board* (str-to-coord coord-str) player)))
|
||||
(progn
|
||||
(setf *passed* nil)
|
||||
(play *board* (str-to-coord coord-str) player))))
|
||||
|
||||
(defun do-genmove (player)
|
||||
(setf *player* player)
|
||||
(if (or (eql *passed* t) (eql *last-player* player))
|
||||
"pass"
|
||||
(let* ((move (genmove *board* player))
|
||||
(score (first move))
|
||||
(board-score (first move))
|
||||
(coord (coord-to-str (second move))))
|
||||
(if (< score 0)
|
||||
(if (< board-score 0)
|
||||
"pass"
|
||||
(progn
|
||||
(do-play player coord)
|
||||
coord)))))
|
||||
|
||||
|
||||
(defun analyze-score ()
|
||||
(analyze-board-score *board* *player*))
|
||||
|
||||
(defun analyze-liberty ()
|
||||
(liberty-to-analyze *board*))
|
||||
|
|
|
|||
37
gtp.lisp
37
gtp.lisp
|
|
@ -4,6 +4,13 @@
|
|||
(defparameter *quit?* nil)
|
||||
;(defparameter *cputime* 0)
|
||||
|
||||
(defmacro inc-cpu-timer (body)
|
||||
`(let ((start (get-internal-run-time))
|
||||
(val ,body)
|
||||
(end (get-internal-run-time)))
|
||||
(setf go-bot:*cputime* (+ go-bot:*cputime* (float (/ (- end start) 1000))))
|
||||
val))
|
||||
|
||||
|
||||
|
||||
(defun gtp-net-client (server port)
|
||||
|
|
@ -17,18 +24,11 @@
|
|||
(do ()
|
||||
((or (eql socket nil) (eql *quit?* t)))
|
||||
(let ((cmd (netpipe:tcp-read socket)))
|
||||
;(format t "cmd: '~a'~%'" cmd)
|
||||
;(format t "cmd: '~a'~%" cmd)
|
||||
(let ((resp (inc-cpu-timer (dispatch-gtp-command cmd))))
|
||||
;(print resp)
|
||||
;(format t "resp: '~a'~%" resp)
|
||||
(netpipe:tcp-print socket (concatenate 'string "= " resp (string #\newline) (string #\newline))))))))))
|
||||
|
||||
(defmacro inc-cpu-timer (body)
|
||||
`(let ((start (get-internal-run-time))
|
||||
(val ,body)
|
||||
(end (get-internal-run-time)))
|
||||
(setf go-bot:*cputime* (+ go-bot:*cputime* (float (/ (- end start) 1000))))
|
||||
val))
|
||||
|
||||
(defun gtp-client ()
|
||||
(go-bot:init)
|
||||
(setf *quit?* nil)
|
||||
|
|
@ -46,16 +46,22 @@
|
|||
(progn (push (subseq string beg i) strings) (setf beg (+ i 1))))))
|
||||
|
||||
|
||||
(defparameter *supported_commands* '("name" "version" "protocol_version" "komi" "boardsize" "clear_board" "play" "genmove" "cputime" "quit" "game_score" "list_commands" "known_command"))
|
||||
(defparameter *supported_commands* '("name" "version" "protocol_version" "komi" "boardsize" "clear_board" "play" "genmove" "cputime" "quit" "game_score" "list_commands" "known_command" "gogui-analyze_commands" ))
|
||||
|
||||
(defparameter *analyze_commands* '("gfx/Liberties/liberties" "gfx/Scores/scores"))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
(defun match-string (str)
|
||||
(lambda (elem) (string-equal str elem)))
|
||||
|
||||
(defun dispatch-gtp-command (command-string)
|
||||
(let* ((commands (split-string (string-upcase command-string) " "))
|
||||
;(cl-ppcre:split "\\s+" (string-upcase command-string)))
|
||||
(let* ((commands (split-string (string-trim #(#\newline #\space) (string-upcase command-string)) " "))
|
||||
;(cl-ppcre:split "[\\s\\n]+" (string-upcase command-string)))
|
||||
(command (intern (first commands) :gtp-handler)))
|
||||
;(print command)
|
||||
;(format t "~a~%" commands)
|
||||
(case command
|
||||
(name go-bot:*name*)
|
||||
(version go-bot:*version*)
|
||||
|
|
@ -77,7 +83,12 @@
|
|||
(list_commands (let ((str ""))
|
||||
(loop for command in *supported_commands* do (setf str (concatenate 'string str command " ")))
|
||||
str))
|
||||
(gogui-analyze_commands (let ((str ""))
|
||||
(loop for command in *analyze_commands* do (setf str (concatenate 'string str command (string #\newline))))
|
||||
(string-trim #(#\newline) str)))
|
||||
(game_score (format t "Score for ~c: ~s~%" go-bot:*player* (string-trim (string #\newline) (second commands))) "")
|
||||
(liberties (string-trim #(#\newline) (analyze-liberty)))
|
||||
(scores (string-trim #(#\newline)(analyze-score)))
|
||||
(quit (setf *quit?* t) "")
|
||||
(otherwise (concatenate 'string "? unknown command: " (string-downcase (first commands)))))))
|
||||
|
||||
|
|
@ -2,4 +2,55 @@
|
|||
|
||||
(defclass liberty-board (basic-board)
|
||||
((liberty-board
|
||||
:initform nil)))
|
||||
:initform nil
|
||||
:accessor liberty-board)))
|
||||
|
||||
(defun set-symetric-edge (board index stone max)
|
||||
(let ((coords `( (0 ,index) (,index 0) (,max ,index) (,index ,max))))
|
||||
(loop for coord in coords do (set-2d-stone (liberty-board board) coord stone))))
|
||||
|
||||
(defun set-symetric-corner (board stone max)
|
||||
(let ((coords `( (0 0) (,max 0) (,max 0) (,max ,max))))
|
||||
(loop for coord in coords do (set-2d-stone (liberty-board board) coord stone))))
|
||||
|
||||
|
||||
(defmethod initialize-instance :after ((board liberty-board) &key from-board)
|
||||
; (format t "init liberty-board~%")
|
||||
(if (eql from-board nil)
|
||||
(progn
|
||||
(setf (liberty-board board) (make-2d-board (boardsize board) 4))
|
||||
; set up walled edges to have less liberty
|
||||
(loop for i from 1 to (1- (boardsize board)) do
|
||||
(set-symetric-edge board i 3 (1- (boardsize board))))
|
||||
(set-symetric-corner board 2 (1- (boardsize board))))
|
||||
(progn
|
||||
(setf (liberty-board board) (copy-2d-board (liberty-board from-board))))))
|
||||
|
||||
(defmacro dec-2d-stone (board coords)
|
||||
`(set-2d-stone ,board ,coords (1- (get-2d-stone ,board ,coords))))
|
||||
|
||||
(defmethod set-stone :after ((board liberty-board) coords val)
|
||||
(let* ((x (first coords))
|
||||
(y (second coords))
|
||||
(up (1- x))
|
||||
(down (1+ x))
|
||||
(left (1- y))
|
||||
(right (1+ y)))
|
||||
(if (>= up 0) (dec-2d-stone (liberty-board board) `(,up ,y)))
|
||||
(if (>= left 0) (dec-2d-stone (liberty-board board) `(,x ,left)))
|
||||
(if (< down (boardsize board)) (dec-2d-stone (liberty-board board) `(,down ,y)))
|
||||
(if (< right (boardsize board)) (dec-2d-stone (liberty-board board) `(,x ,right)))))
|
||||
|
||||
(defmethod score + ((board liberty-board) player)
|
||||
(let ((liberty 0))
|
||||
(do-over-board (coord board)
|
||||
(let ((stone (get-stone board coord)))
|
||||
(if (eql stone player)
|
||||
(incf liberty (get-2d-stone (liberty-board board) coord))
|
||||
(if (eql stone (invert-player player))
|
||||
(decf liberty (get-2d-stone (liberty-board board) coord))))))
|
||||
liberty))
|
||||
|
||||
(defun liberty-to-analyze (board)
|
||||
(board-to-analyze (liberty-board board)))
|
||||
|
||||
|
|
|
|||
|
|
@ -17,33 +17,45 @@
|
|||
:tcp-read))
|
||||
|
||||
|
||||
(defpackage gtp-handler
|
||||
(:use :common-lisp
|
||||
:netpipe)
|
||||
(:export :gtp-client
|
||||
:gtp-net-client))
|
||||
|
||||
|
||||
(defpackage board
|
||||
(:use :common-lisp
|
||||
:macro-utils)
|
||||
(:export :basic-board
|
||||
:boardsize
|
||||
:ranked-board
|
||||
:get-stone
|
||||
:set-stone
|
||||
:coord-to-str
|
||||
:str-to-coord
|
||||
:genmove))
|
||||
:genmove
|
||||
:copy-2d-board
|
||||
:make-2d-board
|
||||
:do-over-board
|
||||
:def-over-board
|
||||
:set-2d-stone
|
||||
:get-2d-stone
|
||||
:invert-player
|
||||
:prune
|
||||
:focus
|
||||
:score
|
||||
:copy-slots
|
||||
:analyze-board-score
|
||||
:board-to-analyze))
|
||||
|
||||
(defpackage liberty-shape
|
||||
(:use :common-lisp
|
||||
:macro-utils
|
||||
:board)
|
||||
(:export :liberty-board))
|
||||
(:export :liberty-board
|
||||
:liberty-to-analyze))
|
||||
|
||||
|
||||
(defpackage go-bot
|
||||
(:use :common-lisp
|
||||
:board)
|
||||
:board
|
||||
:liberty-shape)
|
||||
(:export :*name*
|
||||
:*version*
|
||||
:*author*
|
||||
|
|
@ -55,4 +67,15 @@
|
|||
:init
|
||||
:do-play
|
||||
:do-genmove
|
||||
))
|
||||
:composite-board
|
||||
:analyze-score
|
||||
:analyze-liberty
|
||||
))
|
||||
|
||||
(defpackage gtp-handler
|
||||
(:use :common-lisp
|
||||
:netpipe
|
||||
:go-bot)
|
||||
(:export :gtp-client
|
||||
:gtp-net-client))
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue