finished off shape, started liberty-shape

board.lisp

@@ -1,5 +1,23 @@
 (in-package :board)
 
+(defmacro do-with-copy-of-array ((itr-name copy-name array) &body body)
+    `(let ((,copy-name (make-array (length ,array) :fill-pointer (fill-pointer ,array)  :adjustable t)))
+       (dotimes (,itr-name (length ,array))
+	 ,@body)
+       ,copy-name))
+
+(defun copy-array (array)
+  (do-with-copy-of-array (i copy array)
+    (setf (aref copy i) (aref array i))))
+
+(defun copy-2d-array (array)
+  (do-with-copy-of-array (i copy array)
+    (setf (aref copy i) 
+	  (if (eql (aref array i) nil)
+	      nil
+	      (copy-array (aref array i))))))
+
+
 (defun make-2d-board (size &optional (initial nil))
   (let ((array (make-array size)))
     (dotimes (i size)
@@ -12,6 +30,7 @@
       (setf (aref copy i) (copy-seq (aref board i))))
     copy))
 
+
 (defun filter-i-number (number)
   (if (> number 8) 
       (1- number)

gobot.lisp

@@ -16,7 +16,7 @@
 (defparameter *player* nil)
 (defparameter *last-player* nil)
 
-(defclass composite-board (liberty-board)
+(defclass composite-board (shape-board)
   ((final
    :initform 0)))
 
@@ -75,3 +75,6 @@
 
 (defun analyze-liberty ()
   (liberty-to-analyze *board*))
+
+(defun analyze-shapes ()
+  (shapes-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/Scores/scores"))
+(defparameter *analyze_commands* '("gfx/Liberties/liberties" "gfx/Shapes/shapes" "gfx/Scores/scores"))
 
 
 
@@ -88,6 +88,7 @@
 				(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)))
+      (shapes (string-trim #(#\newline) (analyze-shapes)))
       (scores  (string-trim #(#\newline)(analyze-score)))
       (quit (setf *quit?* t) "")
       (otherwise (concatenate 'string "? unknown command: " (string-downcase (first commands)))))))

liberty-shape.lisp

@@ -0,0 +1,29 @@
+(in-package :liberty-shape-board)
+
+(defclass liberty-shape-board (liberty-board shape-board)
+  ((shapes-liberties
+    :accessor shapes-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)))
+      (progn
+	(setf (shapes-liberties board) (copy-array (shapes-liberties from-board)))
+	(copy-slots (white-shape-liberties black-shape-liberties) board from-board))))
+    
+
+(defmethod set-stone :after ((board liberty-shape-board) coords val)
+  (if (eql (shape-id board coords) (next-shape-id board))
+      ; new shape
+      (vector-push-extend (liberties-of-shape board (next-shape-id board)) (shapes-liberties board))
+      ;old shape
+      ())
+  ;adjust neighebors

packages.lisp

@@ -30,6 +30,9 @@
 	   :coord-to-str
 	   :str-to-coord
 	   :genmove
+	   :do-with-copy-of-array
+	   :copy-array
+	   :copy-2d-array
 	   :copy-2d-board
 	   :make-2d-board
 	   :do-over-board
@@ -58,7 +61,17 @@
 	:macro-utils
 	:board)
   (:export :shape-board
-	   :shape-to-analyze))
+	   :shapes-to-analyze
+	   :shape-id))
+
+(defpackage liberty-shape-board
+  (:use :common-lisp
+	:macro-utils
+	:board
+	:liberty-board
+	:shape-board)
+  (:export :liberty-shape-board
+	   :liberty-shape-to-analyze))
 
 
 (defpackage go-bot
@@ -80,6 +93,7 @@
 	    :composite-board
 	    :analyze-score
 	    :analyze-liberty
+	    :analyze-shapes
 	    ))
 
 (defpackage gtp-handler

shape.lisp

@@ -14,42 +14,51 @@
     :initform 0
     :accessor next-shape-id)))
 
-(defun copy-array (array &optional)
-    (let ((copy (make-array (1+ (length array)) :adjustable t)))
-      (dotimes (i (length array))
-	(setf (aref copy i) (aref array i)))))
-
-
 (defmethod initialize-instance :after ((board shape-board) &key from-board)
   (if (eql from-board nil)
       (progn 
 	(setf (shape-board board) (make-2d-board (boardsize board) nil))
-	(setf (shape-sizes board) (make-array 2 :fill-pointer 0 :adjustable t))
+	(setf (shape-sizes board) (make-array 1 :fill-pointer 0 :adjustable t))
-      
+	(setf (shapes-points board) (make-array 1 :fill-pointer 0 :adjustable t)))
       (progn
 	(setf (shape-board board) (copy-2d-board (shape-board from-board)))
 	(setf (shape-sizes board) (copy-array (shape-sizes from-board)))
-	(copy-slots (next-shape-id) board from-board)))))
+	(setf (shapes-points board) (copy-2d-array (shapes-points from-board)))
+	(copy-slots (next-shape-id) board from-board))))
 
-(defmethod add-shape ((board shape-board) coords)
+(defmacro shape-id (board coords)
+  `(get-2d-stone (shape-board ,board) ,coords))
+
+(defun add-shape (board coords)
   (set-2d-stone (shape-board board) coords (next-shape-id board))
   (vector-push-extend 1 (shape-sizes board))
+  (vector-push-extend (make-array  1 :fill-pointer 0 :adjustable t) (shapes-points board))
+  (vector-push-extend coords (aref (shapes-points board) (next-shape-id board)))
   (incf (next-shape-id board)))
 		      
-(defmethod add-to-shape ((board shape-board) coords shape-id)
+(defun add-to-shape (board coords shape-id)
   (set-2d-stone (shape-board board) coords shape-id)
+  (vector-push-extend coords (aref (shapes-points board) shape-id))
   (incf (aref (shape-sizes board) shape-id)))
 
-(defmacro size-of-shape ((board shape-board) shape-id)
+(defmacro size-of-shape (board shape-id)
-  (aref (shape-sizes board) shape-id))
+  `(aref (shape-sizes ,board) ,shape-id))
 
-(defmethod join-shapes ((board shape-board) nexus shapes-list)
+(defun convert-shape (board shape-id to-id)
-  (let ((biggest-shape (first (shapes-list))))
+;  (format t "convert-shape ~a to ~a~%" shape-id to-id)
-    (loop for shape-id in shape-list do 
+  (loop for index from 0 to (1- (length (aref (shapes-points board) shape-id))) do
+       (add-to-shape board (aref (aref (shapes-points board) shape-id) index ) to-id))
+  (setf (aref (shapes-points board) shape-id) (make-array 1 :fill-pointer 0 :adjustable t))
+  (setf (aref (shape-sizes board) shape-id) 0))
+
+
+(defun join-shapes (board nexus shapes-list)
+  (let ((biggest-shape (first shapes-list)))
+    (loop for shape-id in shapes-list do 
 	 (if (>  (size-of-shape board shape-id) (size-of-shape board biggest-shape))
 	     (setf biggest-shape shape-id)))
     
-    (loop for shape-id in shape-list do
+    (loop for shape-id in shapes-list do
 	 (if (not (= shape-id biggest-shape))
 	       (convert-shape board shape-id biggest-shape)))
     (add-to-shape board nexus biggest-shape)))
@@ -58,15 +67,17 @@
 (defmethod set-stone :after ((board shape-board) coords val)
   (let ((alist nil))
     (do-over-adjacent (coords-var board coords)
-      (if (not (eql nil (get-2d-stone (shape-board board) coords-var)))
+      (if (eql val (get-stone board coords-var))
-	  (push (get-2d-stone (shape-board board) coords-var) alist))
+	  (push (get-2d-stone (shape-board board) coords-var) alist)))
     (if (eql alist nil)
 	(add-shape board coords)
 	(if (eql (cdr alist) nil) ; one item
-	      (add-to-shape board coords (car (first alist)))
+	    (add-to-shape board coords (car alist))
-	      (join-shapes board coords alist))))
+	    (join-shapes board coords alist)))))
-	    
-  
-
 	    
 ;(defun shape-to-analyze ())
+
+(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)))))
+