finished off shape, started liberty-shape

This commit is contained in:
Dan 2008-06-18 23:16:51 -07:00
parent d0cc434248
commit 4ddde36e3e
6 changed files with 107 additions and 30 deletions

View File

@ -1,5 +1,23 @@
(in-package :board) (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)) (defun make-2d-board (size &optional (initial nil))
(let ((array (make-array size))) (let ((array (make-array size)))
(dotimes (i size) (dotimes (i size)
@ -12,6 +30,7 @@
(setf (aref copy i) (copy-seq (aref board i)))) (setf (aref copy i) (copy-seq (aref board i))))
copy)) copy))
(defun filter-i-number (number) (defun filter-i-number (number)
(if (> number 8) (if (> number 8)
(1- number) (1- number)

View File

@ -16,7 +16,7 @@
(defparameter *player* nil) (defparameter *player* nil)
(defparameter *last-player* nil) (defparameter *last-player* nil)
(defclass composite-board (liberty-board) (defclass composite-board (shape-board)
((final ((final
:initform 0))) :initform 0)))
@ -75,3 +75,6 @@
(defun analyze-liberty () (defun analyze-liberty ()
(liberty-to-analyze *board*)) (liberty-to-analyze *board*))
(defun analyze-shapes ()
(shapes-to-analyze *board*))

View File

@ -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 *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))) (string-trim #(#\newline) str)))
(game_score (format t "Score for ~c: ~s~%" go-bot:*player* (string-trim (string #\newline) (second commands))) "") (game_score (format t "Score for ~c: ~s~%" go-bot:*player* (string-trim (string #\newline) (second commands))) "")
(liberties (string-trim #(#\newline) (analyze-liberty))) (liberties (string-trim #(#\newline) (analyze-liberty)))
(shapes (string-trim #(#\newline) (analyze-shapes)))
(scores (string-trim #(#\newline)(analyze-score))) (scores (string-trim #(#\newline)(analyze-score)))
(quit (setf *quit?* t) "") (quit (setf *quit?* t) "")
(otherwise (concatenate 'string "? unknown command: " (string-downcase (first commands))))))) (otherwise (concatenate 'string "? unknown command: " (string-downcase (first commands)))))))

29
liberty-shape.lisp Normal file
View File

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

View File

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

View File

@ -14,42 +14,51 @@
:initform 0 :initform 0
:accessor next-shape-id))) :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) (defmethod initialize-instance :after ((board shape-board) &key from-board)
(if (eql from-board nil) (if (eql from-board nil)
(progn (progn
(setf (shape-board board) (make-2d-board (boardsize board) nil)) (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 (progn
(setf (shape-board board) (copy-2d-board (shape-board from-board))) (setf (shape-board board) (copy-2d-board (shape-board from-board)))
(setf (shape-sizes board) (copy-array (shape-sizes 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)) (set-2d-stone (shape-board board) coords (next-shape-id board))
(vector-push-extend 1 (shape-sizes 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))) (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) (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))) (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)) (if (> (size-of-shape board shape-id) (size-of-shape board biggest-shape))
(setf biggest-shape shape-id))) (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)) (if (not (= shape-id biggest-shape))
(convert-shape board shape-id biggest-shape))) (convert-shape board shape-id biggest-shape)))
(add-to-shape board nexus biggest-shape))) (add-to-shape board nexus biggest-shape)))
@ -58,15 +67,17 @@
(defmethod set-stone :after ((board shape-board) coords val) (defmethod set-stone :after ((board shape-board) coords val)
(let ((alist nil)) (let ((alist nil))
(do-over-adjacent (coords-var board coords) (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) (if (eql alist nil)
(add-shape board coords) (add-shape board coords)
(if (eql (cdr alist) nil) ; one item (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 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)))))