liberty shape works

board.lisp

@@ -56,7 +56,10 @@
 
 
 (defun get-2d-stone (board coord)
-  (aref (aref board (first coord)) (second coord)))
+  (if (not (listp coord))
+      (progn
+	(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))

env.lisp

@@ -12,7 +12,7 @@
 (defparameter *src-root* "/home/dan/src/my/gobot/")
 
 
-(defparameter *src-files* '("packages" "macro-utils" "netpipe" "board" "liberty" "shape" "gobot" "gtp"  "fink"))
+(defparameter *src-files* '("packages" "macro-utils" "netpipe" "board" "liberty" "shape" "liberty-shape" "gobot" "gtp"  "fink"))
 (defun recompile ()
   (loop for file in *src-files* do (compile-file (concatenate 'string *src-root* file ".lisp"))))
 

fink.lisp

@@ -2,7 +2,7 @@
 
 (defparameter *src-root* "/home/dan/src/my/gobot/")
 
-(defparameter *src-files* '("packages" "macro-utils" "netpipe" "board" "liberty" "shape" "gobot" "gtp"))
+(defparameter *src-files* '("packages" "macro-utils" "netpipe" "board" "liberty" "shape" "liberty-shape" "gobot" "gtp"))
 
 (defun load-files ()
   (loop for file in *src-files* do (load (concatenate 'string *src-root* file ".fasl"))))

gobot.lisp

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

liberty-shape.lisp

@@ -2,7 +2,10 @@
 
 (defclass liberty-shape-board (liberty-board shape-board)
   ((shapes-liberties
+    :initform nil
     :accessor shapes-liberties) 
+    ; stores lists (shape-liberties shape-libertirs-score
+   
    (black-shape-liberties
     :initform 0
     :accessor black-shape-liberties)
@@ -13,17 +16,59 @@
 (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-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))))
     
+(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-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)))
+;    (format t "sid @ ~a = ~a~%" sid coords)
+    (inc-player-shape-liberty board player (- old-score))
+    (loop for index from 0 to (1- (length (aref (shapes-points board) sid))) do
+	 (incf liberties (liberty board (aref (aref (shapes-points board) sid) index))))
+     (let ((score (* liberties (size-of-shape board sid))))
+      (setf (aref (shapes-liberties board) sid) `(,liberties ,score))
+      (inc-player-shape-liberty board player score))))
+	
+
 
 (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
-      ())
+  (while (not (eql (length (shapes-liberties board)) (next-shape-id board)))
+	 (vector-push-extend '(0 0) (shapes-liberties board))) ; new shape
+  (calculate-shape-liberties board coords val)
   ;adjust neighebors
+  (let ((sid (shape-id board coords)))
+    (do-over-adjacent (coords-var board coords)
+      (let ((adj-sid (shape-id board coords-var)))
+	(if (not (or (eql adj-sid sid) (eql adj-sid nil)))
+	    (calculate-shape-liberties board coords-var (get-stone board coords-var)))))))
+
+(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 (second (aref (shapes-liberties board) (shape-id board coords))))))
+  (concatenate 'string (board-to-analyze lsb)
+	       '(#\newline) " TEXT blakc shape liberties: " (write-to-string (black-shape-liberties board)) 
+	       " white shape liberties: " (write-to-string (white-shape-liberties board)))))
+
+(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))))

liberty.lisp

@@ -13,6 +13,9 @@
     :initarg white-liberties
     :accessor white-liberties)))
 
+(defmacro liberty (board coords)
+  `(get-2d-stone (liberty-board ,board) ,coords))
+
 (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))))

macro-utils.lisp

@@ -1,5 +1,27 @@
 (in-package macro-utils)
 
+(defun test-while (n)
+  (let ((i 0))
+    (while (< i n)
+      (format t "~a~%" i)
+      (incf i))))
+
+(defun test-until (n)
+  (let ((i 0))
+    (until (= i n)
+      (format t "~a~%" i)
+      (incf i))))
+
+(defmacro while (test-case &body body)
+  `(do ()
+       ((not ,test-case) t)
+     ,@body))
+      
+(defmacro until (test-case &body body)
+  `(do ()
+       (,test-case t)
+     ,@body))
+
 (defmacro with-gensyms ((&rest names) &body body)
   `(let ,(loop for n in names collect `(,n (gensym)))
     ,@body))

packages.lisp

@@ -7,7 +7,9 @@
 (defpackage macro-utils
   (:use :common-lisp)
   (:export :with-gensyms
-	   :once-only))
+	   :once-only
+	   :while
+	   :until))
 
 (defpackage netpipe
   (:use :common-lisp)
@@ -54,7 +56,8 @@
 	:macro-utils
 	:board)
   (:export :liberty-board
-	   :liberty-to-analyze))
+	   :liberty-to-analyze
+	   :liberty))
    
 (defpackage shape-board
   (:use :common-lisp
@@ -62,7 +65,12 @@
 	:board)
   (:export :shape-board
 	   :shapes-to-analyze
-	   :shape-id))
+	   :shape-id
+	   :shapes-points
+	   :shape-sizes
+	   :next-shape-id
+	   :convert-shape
+	   :size-of-shape))
 
 (defpackage liberty-shape-board
   (:use :common-lisp
@@ -78,7 +86,8 @@
   (:use :common-lisp
 	:board
 	:liberty-board
-	:shape-board)
+	:shape-board
+	:liberty-shape-board)
   (:export :*name*
 	    :*version*
 	    :*author*
@@ -94,6 +103,7 @@
 	    :analyze-score
 	    :analyze-liberty
 	    :analyze-shapes
+	    :analyze-shape-liberties
 	    ))
 
 (defpackage gtp-handler

shape.lisp

@@ -44,15 +44,18 @@
 (defmacro size-of-shape (board shape-id)
   `(aref (shape-sizes ,board) ,shape-id))
 
-(defun convert-shape (board shape-id to-id)
+(defgeneric convert-shape (board shape-id to-id))
+
+(defmethod convert-shape ((board 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))
 
+(defgeneric join-shapes (board nexus shapes-list))
 
-(defun join-shapes (board nexus shapes-list)
+(defmethod join-shapes ((board shape-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))