From 4ddde36e3e34a4cdea08b9e9defe15d7bffbfa1f Mon Sep 17 00:00:00 2001
From: Dan <dan@umbriel.(none)>
Date: Wed, 18 Jun 2008 23:16:51 -0700
Subject: [PATCH] finished off shape, started liberty-shape

---
 board.lisp         | 19 ++++++++++++++
 gobot.lisp         |  5 +++-
 gtp.lisp           |  3 ++-
 liberty-shape.lisp | 29 +++++++++++++++++++++
 packages.lisp      | 16 +++++++++++-
 shape.lisp         | 65 +++++++++++++++++++++++++++-------------------
 6 files changed, 107 insertions(+), 30 deletions(-)
 create mode 100644 liberty-shape.lisp

diff --git a/board.lisp b/board.lisp
index cb5caed..200a4f3 100644
--- a/board.lisp
+++ b/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)
diff --git a/gobot.lisp b/gobot.lisp
index 7c97bac..01e1c74 100644
--- a/gobot.lisp
+++ b/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*))
diff --git a/gtp.lisp b/gtp.lisp
index 067f225..7442b1e 100644
--- a/gtp.lisp
+++ b/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)))))))
diff --git a/liberty-shape.lisp b/liberty-shape.lisp
new file mode 100644
index 0000000..4373309
--- /dev/null
+++ b/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
\ No newline at end of file
diff --git a/packages.lisp b/packages.lisp
index 73475de..b8eaa04 100644
--- a/packages.lisp
+++ b/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
diff --git a/shape.lisp b/shape.lisp
index 2ba05ef..c4be337 100644
--- a/shape.lisp
+++ b/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)
-  (aref (shape-sizes board) shape-id))
+(defmacro size-of-shape (board shape-id)
+  `(aref (shape-sizes ,board) ,shape-id))
 
-(defmethod join-shapes ((board shape-board) nexus shapes-list)
-  (let ((biggest-shape (first (shapes-list))))
-    (loop for shape-id in shape-list do 
+(defun convert-shape (board shape-id to-id)
+;  (format t "convert-shape ~a to ~a~%" shape-id to-id)
+  (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)))
-	  (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)))
-	      (join-shapes board coords alist))))
+      (if (eql val (get-stone board coords-var))
+	  (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 alist))
+	    (join-shapes board coords alist)))))
 	    
-  
+;(defun shape-to-analyze ())
 
-      
-;(defun shape-to-analyze ())
\ No newline at end of file
+(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)))))
+	       
\ No newline at end of file