diff --git a/Makefile b/Makefile index 02cc26b..f6fbb45 100644 --- a/Makefile +++ b/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) diff --git a/board.lisp b/board.lisp index 8f0729c..524a728 100644 --- a/board.lisp +++ b/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))) diff --git a/env.lisp b/env.lisp index fbdb572..8816077 100644 --- a/env.lisp +++ b/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")) diff --git a/fink.lisp b/fink.lisp index e788b36..cb7be1e 100644 --- a/fink.lisp +++ b/fink.lisp @@ -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")) diff --git a/gobot.lisp b/gobot.lisp index 4c0993c..0bfea27 100644 --- a/gobot.lisp +++ b/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*)) diff --git a/gtp.lisp b/gtp.lisp index e5f7133..067f225 100644 --- a/gtp.lisp +++ b/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))))))) \ No newline at end of file diff --git a/liberty-shape.lisp b/liberty-shape.lisp index a166cf2..380872e 100644 --- a/liberty-shape.lisp +++ b/liberty-shape.lisp @@ -2,4 +2,55 @@ (defclass liberty-board (basic-board) ((liberty-board - :initform nil))) \ No newline at end of file + :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))) + diff --git a/packages.lisp b/packages.lisp index 00c5106..81fc23a 100644 --- a/packages.lisp +++ b/packages.lisp @@ -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 - )) \ No newline at end of file + :composite-board + :analyze-score + :analyze-liberty + )) + +(defpackage gtp-handler + (:use :common-lisp + :netpipe + :go-bot) + (:export :gtp-client + :gtp-net-client)) +