Basic random bot functionality
This commit is contained in:
parent
a90e7da354
commit
763245732d
9
env.lisp
9
env.lisp
|
@ -1,5 +1,14 @@
|
||||||
(in-package :common-lisp)
|
(in-package :common-lisp)
|
||||||
|
|
||||||
|
;(setf *invoke-debugger-hook*
|
||||||
|
; (lambda (condition hook)
|
||||||
|
; (declare (ignore hook))
|
||||||
|
;; Uncomment to get backtraces on errors
|
||||||
|
;; (sb-debug:backtrace 20)
|
||||||
|
; (format *error-output* "Error: ~A~%" condition)
|
||||||
|
; (quit)))
|
||||||
|
|
||||||
|
|
||||||
(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")))
|
(load (compile-file (concatenate 'string *src-root* "packages.lisp")))
|
||||||
|
|
93
gobot.lisp
93
gobot.lisp
|
@ -10,10 +10,16 @@
|
||||||
|
|
||||||
(defparameter *board* nil)
|
(defparameter *board* nil)
|
||||||
|
|
||||||
(defun make-board (size)
|
(defparameter *score-functions* '( (score-unused 1)))
|
||||||
|
|
||||||
|
(defparameter *passed* nil)
|
||||||
|
(defparameter *player* nil)
|
||||||
|
(defparameter *last-player* nil)
|
||||||
|
|
||||||
|
(defun make-board (size &optional (initial nil))
|
||||||
(let ((array (make-array size)))
|
(let ((array (make-array size)))
|
||||||
(dotimes (i size)
|
(dotimes (i size)
|
||||||
(setf (aref array i) (make-array size :initial-element nil)))
|
(setf (aref array i) (make-array size :initial-element initial)))
|
||||||
array))
|
array))
|
||||||
|
|
||||||
(defun set-komi (new-komi)
|
(defun set-komi (new-komi)
|
||||||
|
@ -23,20 +29,93 @@
|
||||||
(setf *boardsize* newsize))
|
(setf *boardsize* newsize))
|
||||||
|
|
||||||
(defun init-board ()
|
(defun init-board ()
|
||||||
(setf *board* (make-board *boardsize*)))
|
(setf *board* (make-board *boardsize*))
|
||||||
|
(setf *passed* nil)
|
||||||
|
(setf *player* nil))
|
||||||
|
|
||||||
(defun init ()
|
(defun init ()
|
||||||
;(init other game specific stuff)
|
;(init other game specific stuff)
|
||||||
(init-board))
|
(init-board))
|
||||||
|
|
||||||
(defun str-to-coord (str)
|
(defun filter-i-number (number)
|
||||||
`( ,(- (char-code (char (string-upcase str) 0)) 65) ,(- (parse-integer (subseq str 1)) 1)))
|
(if (> number 8)
|
||||||
|
(1- number)
|
||||||
|
number))
|
||||||
|
|
||||||
(defun get-board (board coord)
|
(defun str-to-coord (str)
|
||||||
|
`( ,(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)
|
||||||
|
(1+ number)
|
||||||
|
number))
|
||||||
|
|
||||||
|
(defun coord-to-str (coord)
|
||||||
|
(concatenate 'string (string (code-char (+ 65 (filter-i-char (first coord)))))
|
||||||
|
(write-to-string (+ (second coord) 1))))
|
||||||
|
|
||||||
|
|
||||||
|
(defun get-stone (board coord)
|
||||||
(aref (aref board (first coord)) (second coord)))
|
(aref (aref board (first coord)) (second coord)))
|
||||||
|
|
||||||
(defun set-board (board coord val)
|
(defun set-stone (board coord val)
|
||||||
(setf (aref (aref board (first coord)) (second coord)) val))
|
(setf (aref (aref board (first coord)) (second coord)) val))
|
||||||
|
|
||||||
|
|
||||||
(defun play (player coord-str)
|
(defun play (player coord-str)
|
||||||
|
(setf *last-player* player)
|
||||||
|
(if (string= coord-str "PASS")
|
||||||
|
(setf *passed* t)
|
||||||
|
(set-stone *board* (str-to-coord coord-str) player)))
|
||||||
|
|
||||||
|
(defun genmove (player)
|
||||||
|
(setf *player* player)
|
||||||
|
(if (or (eql *passed* t) (eql *last-player* player))
|
||||||
|
"pass"
|
||||||
|
(let ((move (coord-to-str (make-move *board* player))))
|
||||||
|
(play player move)
|
||||||
|
move)))
|
||||||
|
|
||||||
|
(defun make-move (board player)
|
||||||
|
(select-move (score board player)))
|
||||||
|
|
||||||
|
(defun score (board player)
|
||||||
|
(let ((score-board (make-board (length board) 0)))
|
||||||
|
(dolist (slist *score-functions*)
|
||||||
|
(merge-score-board score-board (funcall (first slist) board player) (second slist)))
|
||||||
|
score-board))
|
||||||
|
|
||||||
|
(defun merge-score-board (score-board scores weight)
|
||||||
|
(dotimes (x (length score-board))
|
||||||
|
(dotimes (y (length score-board))
|
||||||
|
(set-stone score-board `(,x ,y) (+ (get-stone score-board `(,x ,y)) (* weight (get-stone scores `(,x ,y))))))))
|
||||||
|
|
||||||
|
|
||||||
|
(defun select-move (board)
|
||||||
|
(let ((highest (get-stone board '(0 0)))
|
||||||
|
(coords (make-array 10 :fill-pointer 0 :adjustable t)))
|
||||||
|
(do ((x 0 (1+ x)))
|
||||||
|
((>= x (length board)) (aref coords (random (length coords))))
|
||||||
|
(do ((y 0 (1+ y)))
|
||||||
|
((>= y (length board)))
|
||||||
|
(let ((score (get-stone board `(,x ,y))))
|
||||||
|
(if (> score highest)
|
||||||
|
(progn
|
||||||
|
(setf highest score)
|
||||||
|
(setf coords (make-array 10 :fill-pointer 0 :adjustable t ))
|
||||||
|
(vector-push-extend `(,x ,y) coords))
|
||||||
|
(if (= score highest)
|
||||||
|
(if (= (random 2) 1)
|
||||||
|
(vector-push-extend `(,x ,y) coords)))))))))
|
||||||
|
|
||||||
|
|
||||||
|
(defun score-unused (board player)
|
||||||
|
(let ((scores (make-board (length board) 0)))
|
||||||
|
(dotimes (x (length board))
|
||||||
|
(dotimes (y (length board))
|
||||||
|
;body
|
||||||
|
(if (eql (get-stone board `(,x ,y)) nil)
|
||||||
|
(set-stone scores `(,x ,y) 1))
|
||||||
|
;end
|
||||||
|
))
|
||||||
|
scores))
|
77
gtp.lisp
77
gtp.lisp
|
@ -1,8 +1,65 @@
|
||||||
(in-package :gtp-handler)
|
(in-package :gtp-handler)
|
||||||
|
|
||||||
|
(require :sb-bsd-sockets)
|
||||||
|
|
||||||
(defparameter *quit?* nil)
|
(defparameter *quit?* nil)
|
||||||
|
|
||||||
|
|
||||||
|
(defun nslookup (hostname)
|
||||||
|
"Performs a DNS look up for HOSTNAME and returns the address as a
|
||||||
|
four element array, suitable for socket-connect. If HOSTNAME is
|
||||||
|
not found, a host-not-found-error condition is thrown."
|
||||||
|
(if hostname
|
||||||
|
(host-ent-address (get-host-by-name hostname))
|
||||||
|
nil))
|
||||||
|
|
||||||
|
(defun tcp-connect (server port &optional (timeout 10))
|
||||||
|
(let ((socket (make-instance 'sb-bsd-sockets:inet-socket :type
|
||||||
|
:stream :protocol :tcp)))
|
||||||
|
(sb-bsd-sockets:socket-connect socket (nslookup server) port)
|
||||||
|
socket))
|
||||||
|
|
||||||
|
|
||||||
|
(defun tcp-print-raw (socket line)
|
||||||
|
(when (and socket line)
|
||||||
|
(socket-send socket line nil)))
|
||||||
|
|
||||||
|
(defun tcp-print (socket line)
|
||||||
|
(tcp-print-raw socket (concatenate 'string (format nil "~04d" (length line)) line)))
|
||||||
|
|
||||||
|
(defun tcp-read-raw (socket &key (maxsize 65536) (timeout 10))
|
||||||
|
(when socket
|
||||||
|
(values (socket-receive socket nil maxsize))))
|
||||||
|
|
||||||
|
;(if-timeout (timeout (format t "socket-receive timed out after ~A seconds.~%" timeout) (force-output) nil)
|
||||||
|
|
||||||
|
(defun tcp-read (socket &key (timeout 10))
|
||||||
|
(when socket
|
||||||
|
(let ((len (parse-integer (tcp-read-raw socket :maxsize 4 :timeout timeout))))
|
||||||
|
(tcp-read-raw socket :maxsize len :timeout timeout))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
(defun gtp-net-client (server port)
|
||||||
|
(go-bot:init)
|
||||||
|
;(print "bot inited")
|
||||||
|
(setf *quit?* nil)
|
||||||
|
;(print "get connection")
|
||||||
|
(let ((socket (tcp-connect server port)))
|
||||||
|
;(print "got socket")
|
||||||
|
(do ()
|
||||||
|
((eql *quit?* t))
|
||||||
|
(let ((cmd (tcp-read socket)))
|
||||||
|
; (print cmd)
|
||||||
|
(let ((resp (dispatch-gtp-command cmd)))
|
||||||
|
; (print resp)
|
||||||
|
(tcp-print socket (concatenate 'string "= " resp (string #\newline) (string #\newline))))))))
|
||||||
|
|
||||||
|
; (tcp-print socket (concatenate 'string "= " (dispatch-gtp-command (tcp-read socket)) "\n\n")))))
|
||||||
|
|
||||||
(defun gtp-client ()
|
(defun gtp-client ()
|
||||||
|
(go-bot:init)
|
||||||
(setf *quit?* nil)
|
(setf *quit?* nil)
|
||||||
(do ()
|
(do ()
|
||||||
((eql *quit?* t))
|
((eql *quit?* t))
|
||||||
|
@ -20,22 +77,28 @@
|
||||||
|
|
||||||
|
|
||||||
(defun dispatch-gtp-command (command-string)
|
(defun dispatch-gtp-command (command-string)
|
||||||
(let* ((commands (cl-ppcre:split "\\s+" (string-upcase command-string)))
|
(let* ((commands (split-string (string-upcase command-string) " "))
|
||||||
(command (intern (first commands))))
|
;(cl-ppcre:split "\\s+" (string-upcase command-string)))
|
||||||
|
(command (intern (first commands) :gtp-handler)))
|
||||||
(case command
|
(case command
|
||||||
(name go-bot:*name*)
|
(name go-bot:*name*)
|
||||||
(version go-bot:*version*)
|
(version go-bot:*version*)
|
||||||
|
(protocol_version "gtp2ip-0.1")
|
||||||
(boardsize (go-bot:set-boardsize (parse-integer (second commands)))
|
(boardsize (go-bot:set-boardsize (parse-integer (second commands)))
|
||||||
(go-bot:init-board)
|
(go-bot:init-board)
|
||||||
"")
|
"")
|
||||||
; warning: read-from-string pulls full reader. not safe
|
; warning: read-from-string pulls full reader. not safe
|
||||||
(komi (go-bot:set-komi (read-from-string (second commands)))
|
(komi (go-bot:set-komi (read-from-string (second commands)))
|
||||||
"")
|
"")
|
||||||
(clearboard (go-bot:init) "")
|
(clear_board (go-bot:init) "")
|
||||||
(play (go-bot:play (char (second commands) 0) (third commands)))
|
(play (go-bot:play (char (second commands) 0) (third commands)) "")
|
||||||
;(genmove (go-bot:genmove (char (second commands) 0)))
|
(genmove (go-bot:genmove (char (second commands) 0)))
|
||||||
|
(genmove_black (go-bot:genmove #\b))
|
||||||
|
(genmove_white (go-bot:genmove #\w))
|
||||||
|
;(get_random_seed "0")
|
||||||
;(known_command)
|
;(known_command)
|
||||||
;(list_commands
|
;(list_commands)
|
||||||
|
(game_score (format t "Score for ~c: ~s~%" go-bot:*player* (string-trim (string #\newline) (second commands))) "")
|
||||||
(quit (setf *quit?* t) "")
|
(quit (setf *quit?* t) "")
|
||||||
(otherwise (concatenate 'string "Unkown command '" (first commands) "'")))))
|
(otherwise (concatenate 'string "? unknown command: " (string-downcase (first commands)))))))
|
||||||
|
|
|
@ -1,9 +1,11 @@
|
||||||
(in-package :cl-user)
|
(in-package :common-lisp)
|
||||||
|
|
||||||
(clc:clc-require :cl-ppcre)
|
;(clc:clc-require :cl-ppcre)
|
||||||
|
(asdf:oos 'asdf:load-op :cl-ppcre)
|
||||||
|
(require :sb-bsd-sockets)
|
||||||
|
|
||||||
(defpackage gtp-handler
|
(defpackage gtp-handler
|
||||||
(:use :common-lisp)
|
(:use :common-lisp :sb-bsd-sockets)
|
||||||
(:export :gtp-client))
|
(:export :gtp-client))
|
||||||
|
|
||||||
(defpackage go-bot
|
(defpackage go-bot
|
||||||
|
@ -15,4 +17,6 @@
|
||||||
:set-boardsize
|
:set-boardsize
|
||||||
:init-board
|
:init-board
|
||||||
:init
|
:init
|
||||||
|
:play
|
||||||
|
:genmove
|
||||||
))
|
))
|
Loading…
Reference in New Issue