reorganizing, fixes of intermitent bugs

board.lisp

@@ -57,12 +57,15 @@
 
 (defun get-2d-stone (board coord)
   (if (not (listp coord))
-      (format t "MASSIVE ERROR!~%trying to access coord:~a on board" coord))
+      (format t "MASSIVE ERROR! trying to access coord:~a on board~%" coord))
   (aref (aref board (first coord)) (second coord)))
 
 (defun set-2d-stone (board coord val)
   (setf (aref (aref board (first coord)) (second coord)) val))
 
+(defmacro coords-eql (a b)
+  `(and (eql (first ,a) (first ,b)) (eql (second ,a) (second ,b))))
+
 
 
 (defclass  basic-board ()
@@ -92,8 +95,10 @@
   `(get-stone ,board ,coords))
 
 (defgeneric remove-stone (board coords))
+;  (:method-combination progn :most-specific-last))
 
 (defmethod remove-stone ((board basic-board) coords)
+  (pdebug "basic-board:remove stone ~a~%" coords)
   (set-2d-stone (board board) coords nil))
 
 ;(defgeneric (setf stone) (val coords
@@ -316,3 +321,9 @@
 	      (set-stone score-board coord (first (score newboard player))))))
       (board-to-analyze (board score-board)))))
 
+
+(defun stones-to-analyze (board)
+  (concatenate 'string (board-to-analyze (board board))
+	       '(#\newline)))
+	       
+    

gobot.lisp

@@ -56,18 +56,19 @@
 
 (defun do-genmove (player)
 ;  (format t "do-genmove ~a~%" player)
-  (setf *player* player)
+  (let ((macro-utils:*print-debug* nil))
-  (if (or (eql *passed* t) (eql *last-player* player))
+    (setf *player* player)
-      "pass"
+    (if (or (eql *passed* t) (eql *last-player* player))
-      (let* ((move (genmove *board* player))
+	"pass"
-;	     (board-score (first move))
+	(let* ((move (genmove *board* player))
-	     (coord (second move)))
+	       ;(board-score (first move))
+	       (coord (second move)))
 	;(format t "score: ~a for player ~a ~%" board-score player)
-	(if (listp coord)  ; string= coord "pass"))
+	  (if (listp coord)  ; string= coord "pass"))
-	    (let ((coord-str (coord-to-str coord)))
+	      (let ((coord-str (coord-to-str coord)))
-	      (do-play player coord-str)
+		(do-play player coord-str)
-	      coord-str)
+		coord-str)
-	    coord))))
+	      coord)))))
 	 
 	;(if (< board-score 0)
 	;    "pass"
@@ -79,6 +80,9 @@
 (defun analyze-score ()
   (analyze-board-score *board* *player*))
 
+(defun analyze-stones ()
+  (stones-to-analyze *board*))
+
 (defun analyze-liberty ()
   (liberty-to-analyze *board*))
 
@@ -89,4 +93,4 @@
   (liberty-shape-to-analyze *board*))
 
 (defun analyze-shape-stone-liberties ()
-  (liberty-shape-stone-to-analyze *board*))
+nil);  (liberty-shape-stone-to-analyze *board*))

gtp.lisp

@@ -48,7 +48,7 @@
 
 (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/Shapes/shapes" "gfx/Shape-Liberties/shape-liberties" "gfx/Shape-Stone-Liberties/shape-stone-liberties"))
+(defparameter *analyze_commands* '("gfx/Stones/stones" "gfx/Liberties/liberties" "gfx/Shapes/shapes" "gfx/Shape-Liberties/shape-liberties" "gfx/Shape-Stone-Liberties/shape-stone-liberties"))
 
 
 
@@ -58,6 +58,7 @@
   (lambda (elem) (string-equal str elem)))
 
 (defun dispatch-gtp-command (command-string)
+  (pdebug "dispatch-gtp-command ~a~%" 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)))
@@ -87,6 +88,7 @@
 				(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))) "")
+      (stones (string-trim #(#\newline) (analyze-stones)))
       (liberties (string-trim #(#\newline) (analyze-liberty)))
       (shapes (string-trim #(#\newline) (analyze-shapes)))
       (shape-liberties (string-trim #(#\newline) (analyze-shape-liberties)))

liberty-shape.lisp

@@ -1,87 +1,48 @@
 (in-package :liberty-shape-board)
 
-(defclass liberty-shape-board (liberty-board shape-board)
-  (
-    ; stores lists (shape-liberties shape-libertirs-score)
-   (shapes-liberties
-    :initform nil
-    :accessor shapes-liberties) 
-   ; stores lists of free stones adjacent to shape
-   (shapes-free-points
-    :initform nil
-    :accessor shapes-free-points)
-   (shapes-free-scores
-    :initform nil
-    :accessor shapes-free-scores)
-   (black-shape-stone-liberties
-    :initform 0
-    :accessor black-shape-stone-liberties)
-   (white-shape-stone-liberties
-    :initform 0
-    :accessor white-shape-stone-liberties)
-   (black-shape-liberties
-    :initform 0
-    :accessor black-shape-liberties)
-   (white-shape-liberties
-    :initform 0
-    :accessor white-shape-liberties)))
 
-(defmethod initialize-instance :after ((board liberty-shape-board) &key from-board)
+(defgeneric inc-score (board player delta))
-  (if (eql from-board nil)
-      (progn
-        (setf (shapes-liberties board) (make-array 1 :fill-pointer 0 :adjustable t))
-	(setf (shapes-free-points board) (make-array 1 :fill-pointer 0 :adjustable t))
-	(setf (shapes-free-scores board) (make-array 1 :fill-pointer 0 :adjustable t)))
-      
-      (progn
-	(setf (shapes-liberties board) (copy-array (shapes-liberties from-board)))
-	(setf (shapes-free-points board) (copy-2d-array (shapes-free-points from-board)))
-	(setf (shapes-free-scores board) (copy-array (shapes-free-scores from-board)))
-	(copy-slots (white-shape-liberties black-shape-liberties black-shape-stone-liberties white-shape-stone-liberties) board from-board))))
-    
-(defmacro inc-player-shape-stone-liberty (board player delta)
-  `(if (eql ,player #\B)
-       (incf (black-shape-stone-liberties ,board) ,delta)
-       (incf (white-shape-stone-liberties ,board) ,delta)))
 
-(defmacro inc-player-shape-liberty (board player delta)
+(defmacro def-counter-board (name (core-var def-core-type) (black-var white-var))
-  `(if (eql ,player #\B)
+  (with-gensyms ()
-       (incf (black-shape-liberties ,board) ,delta)
+    `(progn
-       (incf (white-shape-liberties ,board) ,delta)))
+       (defclass ,name (liberty-board shape-board)
-       
+	 ((,core-var :initform nil :accessor ,core-var)
-(defmethod convert-shape :before ((board liberty-shape-board)  shape-id to-id)
+	 (,black-var :initform 0 :accessor ,black-var)
-  (let ((player (get-stone board (aref (aref (shapes-points board) shape-id) 0))))
+	 (,white-var :initform 0 :accessor ,white-var)))
-    (inc-player-shape-stone-liberty board player (- (second (aref (shapes-liberties board) shape-id))))
+
-    (setf (aref (shapes-liberties board) shape-id) '(0 0))))
+       (defmethod initialize-instance :after ((board ,name) &key from-board)
+	 (if (eql from-board nil)
+	     (progn
+	       (setf (,core-var board) (make-array 1 :fill-pointer 0 :adjustable t)))
+	     (progn
+	       (setf (,core-var board) (copy-2d-array (,core-var from-board)))
+	       (copy-slots (,black-var ,white-var) board from-board))))
+
+       (defmethod inc-score ((board ,name)  player delta)
+	 (if (eql player #\B)
+	      (incf (,black-var board) delta)
+	      (incf (,white-var board) delta)))
 
 
+)))
 
-(defun calculate-shape-liberties (board coords player)
+
-  (let* ((liberties 0)
+(def-counter-board liberty-shape-board 
-	 (sid (shape-id board coords))
+    (shapes-free-points-list '(make-array 1 :fill-pointer 0 :adjustable t))
-	 (shape-liberties-score (aref (shapes-liberties board) sid))
+  (black-shape-liberties white-shape-liberties))
-	 (old-score (second shape-liberties-score)))
+
- ;   (pdebug "calculate-shape-liberties for sid:~a score:~a~%" sid shape-liberties-score)
+
-    (inc-player-shape-stone-liberty board player (- old-score))
+(defmacro shape-liberty (board sid)
-;    (pdebug "loop add liberties~%")
+  `(length (aref (shapes-free-points-list ,board) ,sid)))
-    (loop for index from 0 to (1- (length (aref (shapes-points board) sid))) do
+;  `(* (shape-size ,board ,sid) (length (aref (shapes-free-points-list ,board) ,sid))))
-;	 (pdebug "adding on ~a~%" index)
-	 (incf liberties (liberty board (aref (aref (shapes-points board) sid) index))))
-    (let ((score (* liberties (shape-size board sid))))
-;      (pdebug "sets shape-liberties for ~a (~a ~a)~%" sid liberties score)
-      (setf (aref (shapes-liberties board) sid) `(,liberties ,score))
-      (inc-player-shape-stone-liberty board player score))))
-	
-(defmacro coords-eql (a b)
-  `(and (eql (first ,a) (first ,b)) (eql (second ,a) (second ,b))))
 
 
 (defun add-free-point (board coord sid player)
-  ;(pdebug "1st (dec) inc score ~a by ~a " (if (eql player #\B) (black-shape-liberties board) (white-shape-liberties board))  (- (aref (shapes-free-scores board) sid)))
+  (pdebug "add-free-point at ~a to ~a for ~a~%" coord sid player)
-  (inc-player-shape-liberty board player (- (aref (shapes-free-scores board) sid)))
+  (inc-score board player (- (shape-liberty board sid)))
-  ;(pdebug " = ~a~%"  (if (eql player #\B) (black-shape-liberties board) (white-shape-liberties board)))
+   (let* ((found nil)
-  (let* ((found nil)
+	 (free-points (aref (shapes-free-points-list board) sid)))
-	 (free-points (aref (shapes-free-points board) sid)))
     (loop for i from 0 to (1- (length free-points)) do
 	 (if (coords-eql coord (aref free-points i))
 	     (progn 
@@ -90,97 +51,251 @@
     (if (eql found nil)
 	(progn
 	  (vector-push-extend coord free-points)))
-;	  (inc-player-shape-liberty board player 1)))
     (let ((newscore (* (shape-size board sid) (length free-points))))
-    ;  (format t "newscore ~a*~a = ~a~%" (shape-size board sid) (length free-points)  newscore)
+      (inc-score board player newscore))))
-;      (pdebug "2nd inc score ~a by ~a " (if (eql player #\B) (black-shape-liberties board) (white-shape-liberties board))  newscore)
-      (setf (aref (shapes-free-scores board) sid) newscore)
-      ;  (format t "set shape-free-scores~%")
-      (inc-player-shape-liberty board player newscore))))
- ;     (pdebug " = ~a~%" (if (eql player #\B) (black-shape-liberties board) (white-shape-liberties board))))))
 
 (defun add-free-points-around (board nexus player)
+  (pdebug "add-free-points-around ~a ~a~%" nexus player)
   (let ((sid (shape-id board nexus)))
     (do-over-adjacent (coords-var board nexus)
+      (pdebug "looking at ~a~%" coords-var)
       (if (eql (get-stone board coords-var) nil)
 	  (add-free-point board coords-var sid player)))))
-  
+
-(defun remove-shape (board sid)
-  (pdebug "remove-shape ~a~%" sid)
-  (let ((stones (aref (shapes-points board) sid)))
-    (loop for index from 0 to (1- (length stones)) do 
-	 (progn (pdebug "removing stone ~a~%" (aref stones index))
-	 (remove-stone board (aref stones index))))))
-	 
 
 (defun remove-free-point (board coord sid player)
-  (let ((free-points (aref (shapes-free-points board) sid)))
+;  (pdebug "remove-free-point ~a ~a ~a" coord sid player)
+  (let ((free-points (aref (shapes-free-points-list board) sid)))
     (if (> (length free-points) 0)
 	(let ((tmp (aref free-points (1- (length free-points)))))
-	 ; (pdebug "dec inc-player-shape-liberty~%")
-
-	  ;(pdebug "search for point~%")
 	  (loop for i from 0 to (1- (length free-points)) do
-	   ;    (pdebug "search ~a" i)
 	       (if (coords-eql coord (aref free-points i))
 		   (progn
-		;     (pdebug "found on ~a @ ~a" i  (aref free-points i))
+		     (inc-score board player (- (shape-liberty board sid)))
 		     (setf (aref free-points i) tmp)
-		 ;    (pdebug "do vector pop~%")
 		     (vector-pop free-points)
-		;   (pdebug "inc-player-shape-liberty~%")
+		     (inc-score board player (* (length free-points) (shape-size board sid)))
-		     (inc-player-shape-liberty board player (- (aref (shapes-free-scores board) sid)))
-		     (inc-player-shape-liberty board player (* (length free-points) (shape-size board sid)))
-		   ;  (pdebug "set shapes-free-scores new score for ~a~%" sid)
-		     (setf (aref (shapes-free-scores board) sid)  (* (length free-points) (shape-size board sid)))
 		     (return))))
 	  (if (= 0 (length free-points))
-	      (remove-shape board sid))))))
+	      (progn (pdebug "remve-shape ~a~%" sid)
-	 
+	      (remove-shape board sid)))))))
 
 
 (defmethod set-stone :after ((board liberty-shape-board) coords val)
-  (while (not (eql (length (shapes-liberties board)) (next-shape-id board)))
+  (pdebug "liberty-shape-board:set-stone ~a ~a~%" coords val)
-    (vector-push-extend '(0 0) (shapes-liberties board)) ; new shape
+  (while (not (eql (length (shapes-free-points-list board)) (next-shape-id board)))
-    (vector-push-extend 0 (shapes-free-scores board)) 
+    (vector-push-extend (make-array 1 :fill-pointer 0 :adjustable t) (shapes-free-points-list board)))
-    (vector-push-extend (make-array 1 :fill-pointer 0 :adjustable t) (shapes-free-points board)))
-  (calculate-shape-liberties board coords val)
- ; (pdebug "about to add-free-points~%")
   (add-free-points-around board coords val)
-  ;adjust neighebors
- ; (pdebug "about to adjust neighbors~%")
-  (let ((sid (shape-id board coords)))
-    (do-over-adjacent (coords-var board coords)
-      (let ((adj-sid (shape-id board coords-var))
-	    (adj-player (get-player board coords-var)))
-	(if (not (eql adj-sid nil))
-	    (progn
-	 ;     (pdebug "adjusting: from coord:~a removing free: ~a and sid:~a player ~a~%" coords coords-var adj-sid adj-player)
-	      (remove-free-point board coords adj-sid adj-player)
-	  ;    (pdebug "remove-free-point done~%")
-	      (if (not(eql adj-sid sid))
-		  (calculate-shape-liberties board coords-var (get-stone board coords-var)))))))))
 
-(defun liberty-shape-stone-to-analyze (board)
+     ;adjust neighebors, removing this free point
-  (let ((lsb (make-2d-board (boardsize board) 0)))
+  (pdebug "Searching for shapes around ~a to notify to remove free point~%" coords)
-    (do-over-board (coords board)
+  (do-over-adjacent (coords-var board coords)
-      (if (not (eql nil (shape-id board coords)))
+    (pdebug "looking at ~a~%" coords-var)
-	  (set-2d-stone lsb coords (second (aref (shapes-liberties board) (shape-id board coords))))))
+    (let ((adj-sid (shape-id board coords-var)))
-  (concatenate 'string (board-to-analyze lsb)
+      (if (not (eql adj-sid nil))
-	       '(#\newline) " TEXT black shape stone liberties: " (write-to-string (black-shape-stone-liberties board)) 
+	  (remove-free-point board coords adj-sid (get-player board coords-var))))))
-	       " white shape stone liberties: " (write-to-string (white-shape-stone-liberties board)))))
+
+
+(defmethod convert-shape :before ((board liberty-shape-board) shape-id to-id)
+  (pdebug "convert-shape ~a to ~a~%" shape-id to-id)
+  (pdebug "shape-points ~a~%"  (aref (shapes-points board) shape-id))
+  (pdebug "player: ~a~%" (get-stone board (aref (aref (shapes-points board) shape-id) 0)))
+  (if (> (length (aref (shapes-points board) shape-id)) 0)
+      (let ((player (get-stone board (aref (aref (shapes-points board) shape-id) 0))))
+	(inc-score board player (- (shape-liberty board shape-id)))
+	(let
+	    ((from-free (aref (shapes-free-points-list board) shape-id))
+	     (to-free (aref (shapes-free-points-list board) shape-id)))
+	  
+	  (loop for i from 0 to (1- (length from-free)) do
+	       (add-free-point board (aref from-free i) to-id player))
+	  (setf (aref (shapes-free-points-list board) shape-id) (make-array 1 :fill-pointer 0 :adjustable t))))))
+;    (inc-score board player (shape-liberty board to-id)))
+    ;(setf (aref (shapes-free-points-list board) shape-id) (make-array 1 :fill-pointer 0 :adjustable t))))
+
+;(defmethod convert-shape :after ((board liberty-shape-board) shape-id to-id)
+;  (let ((player (get-stone board (aref (aref (shapes-points board) shape-id) 0)))
+
+
+
+(defmethod score + ((board liberty-shape-board) player)
+  (if (eql player #\B)
+      (- (black-shape-liberties board) (white-shape-liberties board))
+      (- (white-shape-liberties board) (black-shape-liberties board))))
 
-(defun shape-liberties-score (board sid)
-  (* (shape-size board sid) (length (aref (shapes-free-points board) sid))))
 
 (defun liberty-shape-to-analyze (board)
   (let ((lsb (make-2d-board (boardsize board) 0)))
     (do-over-board (coords board)
       (if (not (eql nil (shape-id board coords)))
-	  (set-2d-stone lsb coords (shape-liberties-score board (shape-id board coords)))))
+          (set-2d-stone lsb coords (shape-liberty board (shape-id board coords)))))
-    (concatenate 'string (board-to-analyze lsb)
+  (concatenate 'string (board-to-analyze lsb)
-		 '(#\newline) " TEXT black shape liberties: " (write-to-string (black-shape-liberties board)) 
+               '(#\newline) " TEXT black shape liberties: " (write-to-string (black-shape-liberties board))
-		 " white shape liberties: " (write-to-string (white-shape-liberties board)))))
+               " white shape liberties: " (write-to-string (white-shape-liberties board)))))
+
+
+
+;(defmacro calc-shape-score (board var sid)
+;  `(* (shape-size ,board ,sid) (aref (,var ,board) ,sid)))		  
+	 
+
+;(defclass liberty-shape-board (liberty-board shape-board)
+;  (
+;    ; stores lists (shape-liberties shape-libertirs-score)
+;   (shapes-liberties
+;    :initform nil
+;    :accessor shapes-liberties) 
+;   ; stores lists of free stones adjacent to shape
+;   (shapes-free-points
+;    :initform nil
+;    :accessor shapes-free-points)
+;   (shapes-free-scores
+;    :initform nil
+;    :accessor shapes-free-scores)
+;   (black-shape-stone-liberties
+;    :initform 0
+;    :accessor black-shape-stone-liberties)
+;   (white-shape-stone-liberties
+;    :initform 0
+;    :accessor white-shape-stone-liberties)
+;   (black-shape-liberties
+;    :initform 0
+;    :accessor black-shape-liberties)
+;   (white-shape-liberties
+;    :initform 0
+;    :accessor white-shape-liberties)))
+
+;(defmethod initialize-instance :after ((board liberty-shape-board) &key from-board)
+;  (if (eql from-board nil)
+;      (progn
+;        (setf (shapes-liberties board) (make-array 1 :fill-pointer 0 :adjustable t))
+;	(setf (shapes-free-points board) (make-array 1 :fill-pointer 0 :adjustable t))
+;	(setf (shapes-free-scores board) (make-array 1 :fill-pointer 0 :adjustable t)))
+;      
+;      (progn
+;	(setf (shapes-liberties board) (copy-array (shapes-liberties from-board)))
+;	(setf (shapes-free-points board) (copy-2d-array (shapes-free-points from-board)))
+;	(setf (shapes-free-scores board) (copy-array (shapes-free-scores from-board)))
+;	(copy-slots (white-shape-liberties black-shape-liberties black-shape-stone-liberties white-shape-stone-liberties) board from-board))))
+
+;(defmacro shape-stone-liberties
+
+;(defmacro calc-shape-stones-liberties (board sid)
+
+    
+;(defmacro inc-player-shape-stone-liberty (board player delta)
+;  `(if (eql ,player #\B)
+;       (incf (black-shape-stone-liberties ,board) ,delta)
+;       (incf (white-shape-stone-liberties ,board) ,delta)))
+
+;(defmacro inc-player-shape-liberty (board player delta)
+;  `(if (eql ,player #\B)
+;       (incf (black-shape-liberties ,board) ,delta)
+;       (incf (white-shape-liberties ,board) ,delta)))
+       
+
+;(defmethod convert-shape :before ((board liberty-shape-board)  shape-id to-id)
+;  (let ((player (get-stone board (aref (aref (shapes-points board) shape-id) 0))))
+;    (inc-player-shape-stone-liberty board player (- (second (aref (shapes-liberties board) shape-id))))
+;    (setf (aref (shapes-liberties board) shape-id) '(0 0))))
+
+
+;(defun calculate-shape-liberties (board coords player)
+;  (let* ((liberties 0)
+;	 (sid (shape-id board coords))
+;	 (shape-liberties-score (aref (shapes-liberties board) sid))
+;	 (old-score (second shape-liberties-score)))
+; ;   (pdebug "calculate-shape-liberties for sid:~a score:~a~%" sid shape-liberties-score)
+;    (inc-player-shape-stone-liberty board player (- old-score))
+;;    (pdebug "loop add liberties~%")
+;    (loop for index from 0 to (1- (length (aref (shapes-points board) sid))) do
+;;	 (pdebug "adding on ~a~%" index)
+;	 (incf liberties (liberty board (aref (aref (shapes-points board) sid) index))))
+;    (let ((score (* liberties (shape-size board sid))))
+;;      (pdebug "sets shape-liberties for ~a (~a ~a)~%" sid liberties score)
+;      (setf (aref (shapes-liberties board) sid) `(,liberties ,score))
+;      (inc-player-shape-stone-liberty board player score))))
+	
+
+
+;(defun add-free-point (board coord sid player)
+;  (inc-player-shape-liberty board player (- (aref (shapes-free-scores board) sid)))
+;  (let* ((found nil)
+;	 (free-points (aref (shapes-free-points board) sid)))
+;    (loop for i from 0 to (1- (length free-points)) do
+;	 (if (coords-eql coord (aref free-points i))
+;	     (progn 
+;	       (setf found t)
+;	       (return))))
+;    (if (eql found nil)
+;	(progn
+;	  (vector-push-extend coord free-points)))
+;    (let ((newscore (* (shape-size board sid) (length free-points))))
+;      (setf (aref (shapes-free-scores board) sid) newscore)
+;      (inc-player-shape-liberty board player newscore))))
+
+;(defun add-free-points-around (board nexus player)
+;  (let ((sid (shape-id board nexus)))
+;    (do-over-adjacent (coords-var board nexus)
+;      (if (eql (get-stone board coords-var) nil)
+;	  (add-free-point board coords-var sid player)))))
+  
+;(defun remove-shape (board sid)
+;  (pdebug "remove-shape ~a~%" sid)
+;  (let ((stones (aref (shapes-points board) sid)))
+;    (loop for index from 0 to (1- (length stones)) do 
+;	 (progn (pdebug "removing stone ~a~%" (aref stones index))
+;	 (remove-stone board (aref stones index))))))
+	 
+
+;(defun remove-free-point (board coord sid player)
+;  (let ((free-points (aref (shapes-free-points board) sid)))
+;    (if (> (length free-points) 0)
+;	(let ((tmp (aref free-points (1- (length free-points)))))
+;	 ; (pdebug "dec inc-player-shape-liberty~%")
+;
+;	  ;(pdebug "search for point~%")
+;	  (loop for i from 0 to (1- (length free-points)) do
+;	   ;    (pdebug "search ~a" i)
+;	       (if (coords-eql coord (aref free-points i))
+;		   (progn
+;		;     (pdebug "found on ~a @ ~a" i  (aref free-points i))
+;		     (setf (aref free-points i) tmp)
+;		 ;    (pdebug "do vector pop~%")
+;		     (vector-pop free-points)
+;		;   (pdebug "inc-player-shape-liberty~%")
+;		     (inc-player-shape-liberty board player (- (aref (shapes-free-scores board) sid)))
+;		     (inc-player-shape-liberty board player (* (length free-points) (shape-size board sid)))
+;		   ;  (pdebug "set shapes-free-scores new score for ~a~%" sid)
+;		     (setf (aref (shapes-free-scores board) sid)  (* (length free-points) (shape-size board sid)))
+;		     (return))))
+;	  (if (= 0 (length free-points))
+;	      (remove-shape board sid))))))
+	 
+
+
+;(defmethod set-stone :after ((board liberty-shape-board) coords val)
+;  (while (not (eql (length (shapes-liberties board)) (next-shape-id board)))
+;    (vector-push-extend '(0 0) (shapes-liberties board)) ; new shape
+;    (vector-push-extend 0 (shapes-free-scores board)) 
+;    (vector-push-extend (make-array 1 :fill-pointer 0 :adjustable t) (shapes-free-points board)))
+;  (calculate-shape-liberties board coords val)
+; ; (pdebug "about to add-free-points~%")
+;  (add-free-points-around board coords val)
+;  ;adjust neighebors
+; ; (pdebug "about to adjust neighbors~%")
+;  (let ((sid (shape-id board coords)))
+;    (do-over-adjacent (coords-var board coords)
+;      (let ((adj-sid (shape-id board coords-var))
+;	    (adj-player (get-player board coords-var)))
+;	(if (not (eql adj-sid nil))
+;	    (progn
+;	      (pdebug "adjusting: from coord:~a removing free: ~a and sid:~a player ~a~%" coords coords-var adj-sid adj-player)
+;	      (remove-free-point board coords adj-sid adj-player)
+;	      (pdebug "remove-free-point done~%")
+;	      (if (not(eql adj-sid sid))
+;		  (calculate-shape-liberties board coords-var (get-stone board coords-var)))
+;	      (pdebug "done calculate-shape-liberties~%")))))))
 
 
 
@@ -190,7 +305,7 @@
 ;      (- (white-shape-liberties board) (black-shape-liberties board))))
 
 
-(defmethod score + ((board liberty-shape-board) player)
+;(defmethod score + ((board liberty-shape-board) player)
-  (if (eql player #\B)
+;  (if (eql player #\B)
-      (- (black-shape-stone-liberties board) (white-shape-stone-liberties board))
+;      (- (black-shape-stone-liberties board) (white-shape-stone-liberties board))
-      (- (white-shape-stone-liberties board) (black-shape-stone-liberties board))))
+;      (- (white-shape-stone-liberties board) (black-shape-stone-liberties board))))

liberty.lisp

@@ -65,6 +65,7 @@
     (dec-liberty board coords-var)))
 
 (defmethod remove-stone :after ((board liberty-board) coords)
+  (pdebug "liberty-board:remove-stone ~a~%" coords)
   (do-over-adjacent (coords-var board coords)
     (inc-liberty board coords-var)))
      

macro-utils.lisp

@@ -12,8 +12,11 @@
 ;      (format t "~a~%" i)
 ;      (incf i))))
 
+(defparameter *print-debug* t)
+
 (defmacro pdebug (&body body)
-  `(format *error-output* ,@body))
+  `(if macro-utils:*print-debug*
+       (format *error-output* ,@body)))
 
 (defmacro while (test-case &body body)
   `(do ()

packages.lisp

@@ -10,7 +10,8 @@
 	   :once-only
 	   :while
 	   :until
-	   :pdebug))
+	   :pdebug
+	   :*print-debug*))
 
 (defpackage netpipe
   (:use :common-lisp)
@@ -44,6 +45,7 @@
 	   :def-over-board
 	   :set-2d-stone
 	   :get-2d-stone
+	   :coords-eql
 	   :invert-player
 	   :prune
 	   :focus
@@ -52,7 +54,8 @@
 	   :analyze-board-score
 	   :board-to-analyze
 ;	   :do-over-2d-adjacent
-	   :do-over-adjacent))
+	   :do-over-adjacent
+	   :stones-to-analyze))
 
 (defpackage liberty-board
   (:use :common-lisp
@@ -73,7 +76,8 @@
 	   :shape-sizes
 	   :next-shape-id
 	   :convert-shape
-	   :shape-size))
+	   :shape-size
+	   :remove-shape))
 
 (defpackage liberty-shape-board
   (:use :common-lisp
@@ -82,8 +86,8 @@
 	:liberty-board
 	:shape-board)
   (:export :liberty-shape-board
-	   :liberty-shape-to-analyze
+	   :liberty-shape-to-analyze))
-	   :liberty-shape-stone-to-analyze))
+	   ;:liberty-shape-stone-to-analyze))
 
 
 (defpackage go-bot
@@ -104,6 +108,7 @@
 	    :do-play
 	    :do-genmove
 	    :composite-board
+	    :analyze-stones
 	    :analyze-score
 	    :analyze-liberty
 	    :analyze-shapes
@@ -114,7 +119,8 @@
 (defpackage gtp-handler
   (:use :common-lisp
 	:netpipe
-	:go-bot)
+	:go-bot
+	:macro-utils)
   (:export :gtp-client
 	   :gtp-net-client))
 

shape.lisp

@@ -80,6 +80,26 @@
 	    
 ;(defun shape-to-analyze ())
 
+(defmethod remove-stone :after ((board shape-board) coords)
+  (pdebug "shape-board:remove-stone ~a~%" coords)
+  (set-2d-stone (shape-board board) coords nil))
+
+(defgeneric remove-shape (board sid))
+
+(defmethod remove-shape ((board shape-board) sid)
+  (pdebug "shape-board:remove-shape ~a~%" sid)
+  (let ((stones (aref (shapes-points board) sid)))
+    (loop for index from 0 to (1- (length stones)) do 
+	 (progn (pdebug "removing stone ~a~%" (aref stones index))
+	 (remove-stone board (aref stones index)))))
+  (pdebug "shape-sizes to 0~%")
+  (setf (aref (shape-sizes board) sid) 0)
+  (pdebug "shape-points to nil~%")
+  (setf (aref (shapes-points board) sid) (make-array  1 :fill-pointer 0 :adjustable t))
+  (pdebug "remove-shape done~%"))
+
+
+
 (defun shapes-to-analyze (board)
   (concatenate 'string (board-to-analyze (shape-board board))
 	       '(#\newline) " TEXT next-shape-id: " (write-to-string (next-shape-id board)) " length(shapes-points): " (write-to-string (length (shapes-points board)))))

test-class.lisp

@@ -10,15 +10,30 @@
    :initarg b
    :accessor b)))
 
+
+(defclass class_c (class_a)
+  ((b
+    :initform (make-array 10 :initial-element 1)
+    :initarg b
+    :accessor b)))
+
+(defclass class_d (class_b class_c)
+  ((d
+    :initform 0
+    :accessor d)))
+
 (defgeneric dothing (class data)
   (:method-combination progn :most-specific-last))
   
 
 (defmethod dothing progn ((class class_a) data)
-  (loop for i from 0 to 9 do (setf (aref (a class) i) (+ (aref (a class) i) data))))
+  (loop for i from 0 to 9 do (setf (aref (a class) i) (+ (aref (a class) i) 1))));data))))
 
 (defmethod dothing progn ((class class_b) data)
-  (loop for i from 0 to 9 do (setf (aref (b class) i) (+ (aref (b class) i) (aref (a class) i) data))))
+  (loop for i from 0 to 9 do (progn (setf (aref (b class) i) (+ (aref (b class) i) 2)) (print (aref (b class) i)))));(aref (a class) i) data))))
+
+(defmethod dothing progn ((class class_c) data)
+  (loop for i from 0 to 9 do (progn (setf (aref (b class) i) (+ (aref (b class) i) 3)) (print (aref (b class) i)))))
 
 (defgeneric doother4 (class data)
   );(:method-combination progn :most-specific-last))