some key fixes, expecially coord fix, bit work on liberties, and some gogui integration

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)

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)))))
+  (concatenate 'string (string (code-char (+ 65 (filter-i-char (second coord)))))
-		(write-to-string (+ (second coord) 1))))
+	       (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)
+(defmacro copy-slots (slots dst src)
-  `(progn ,@(loop for slot in slots collect `(setf (,slot ,src) (,slot ,dst)))))
+  `(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)
+  (if (not (eql from-board nil))
-      (setf (rank-highest board) (rank-highest from-board))
+      (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)))
@@ -231,6 +242,33 @@
 	  (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)))
 

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"))

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"))

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*))

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) " "))
+  (let* ((commands (split-string (string-trim #(#\newline #\space) (string-upcase command-string)) " "))
-					;(cl-ppcre:split "\\s+" (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)))))))
   

liberty-shape.lisp

@@ -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)))
+    

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
+	    :composite-board
+	    :analyze-score
+	    :analyze-liberty
 	    ))
+
+(defpackage gtp-handler
+  (:use :common-lisp
+	:netpipe
+	:go-bot)
+  (:export :gtp-client
+	   :gtp-net-client))
+