From 7f02d755e14783f18aea249852d69f5df02cc469 Mon Sep 17 00:00:00 2001 From: Dan Date: Tue, 3 Jun 2008 09:08:30 -0700 Subject: [PATCH] refactoring of liberty and start of shape --- env.lisp | 11 ++--- fink.lisp | 14 +++---- liberty-shape.lisp => liberty.lisp | 67 +++++++----------------------- packages.lisp | 12 +++++- shape.lisp | 7 ++++ 5 files changed, 42 insertions(+), 69 deletions(-) rename liberty-shape.lisp => liberty.lisp (57%) create mode 100644 shape.lisp diff --git a/env.lisp b/env.lisp index 8816077..0b69861 100644 --- a/env.lisp +++ b/env.lisp @@ -11,15 +11,10 @@ (defparameter *src-root* "/home/dan/src/my/gobot/") + +(defparameter *src-files* '("packages" "macro-utils" "netpipe" "board" "liberty" "shape" "gobot" "gtp" "fink")) (defun recompile () - (compile-file (concatenate 'string *src-root* "packages.lisp")) - (compile-file (concatenate 'string *src-root* "macro-utils.lisp")) - (compile-file (concatenate 'string *src-root* "netpipe.lisp")) - (compile-file (concatenate 'string *src-root* "board.lisp")) - (compile-file (concatenate 'string *src-root* "liberty-shape.lisp")) - (compile-file (concatenate 'string *src-root* "gobot.lisp")) - (compile-file (concatenate 'string *src-root* "gtp.lisp")) - (compile-file (concatenate 'string *src-root* "fink.lisp"))) + (loop for file in *src-files* do (compile-file (concatenate 'string *src-root* file ".lisp")))) (recompile) diff --git a/fink.lisp b/fink.lisp index cb7be1e..0cea935 100644 --- a/fink.lisp +++ b/fink.lisp @@ -2,11 +2,11 @@ (defparameter *src-root* "/home/dan/src/my/gobot/") +(defparameter *src-files* '("packages" "macro-utils" "netpipe" "board" "liberty" "shape" "gobot" "gtp")) + +(defun load-files () + (loop for file in *src-files* do (load (concatenate 'string *src-root* file ".fasl")))) + + +(load-files) -(load (concatenate 'string *src-root* "packages.fasl")) -(load (concatenate 'string *src-root* "macro-utils.fasl")) -(load (concatenate 'string *src-root* "netpipe.fasl")) -(load (concatenate 'string *src-root* "board.fasl")) -(load (concatenate 'string *src-root* "liberty-shape.fasl")) -(load (concatenate 'string *src-root* "gobot.fasl")) -(load (concatenate 'string *src-root* "gtp.fasl")) diff --git a/liberty-shape.lisp b/liberty.lisp similarity index 57% rename from liberty-shape.lisp rename to liberty.lisp index db6079c..7456063 100644 --- a/liberty-shape.lisp +++ b/liberty.lisp @@ -1,4 +1,4 @@ -(in-package :liberty-shape) +(in-package :liberty-board) (defclass liberty-board (basic-board) ((liberty-board @@ -35,43 +35,13 @@ (setf (liberty-board board) (copy-2d-board (liberty-board from-board))) (copy-slots (black-liberties white-liberties) board from-board)))) -;(defmacro dec-2d-stone (board coords) -; `(set-2d-stone ,board ,coords (1- (get-2d-stone ,board ,coords)))) - - - -;(defmethod dec-liberty (board coords) -; (dec-2d-stone (liberty-board board) coords) -; (let ((player (get-stone board coords))) -; (if (not (eql (get-stone board coords) nil)) -; (set-liberties (board) (1- (liberties board player) player) - -;(defmethod liberties ((board liberty-board) player) -; (if (eql player #\b) -; 'black-liberties -; 'white-liberties)) - -;(defun (setf liberties) (liberty board player) -; (if (eql player #\b) -; (setf (black-liberties board) liberty) -; (setf (white-liberties board) liberty))) - -;(defmethod set-liberties ((board liberty-board) liberty player) -; (if (eql player #\b) -; (setf (black-liberties board) liberty) -; (setf (white-liberties board) liberty))) - - (defgeneric inc-liberties (board coords delta)) (defmethod inc-liberties ((board liberty-board) coords delta) (let ((player (get-stone board coords))) -; (format t "inc-liberties at ~a by ~a for ~a ~%" coords delta player) (if (eql player #\B) - ;(progn (format t "inc black~%") (incf (black-liberties board) delta) (if (eql player #\W) - ; (progn (format t "inc white ~%") (incf (white-liberties board) delta))))) (defmacro dec-liberty (board coords) @@ -79,36 +49,29 @@ (set-2d-stone (liberty-board ,board) ,coords (1- (get-2d-stone (liberty-board ,board) ,coords))) (inc-liberties ,board ,coords -1))) - +(defmacro do-over-adjacent ((coords-var board coords) &body body) + `(let* ((x (first ,coords)) + (y (second ,coords)) + (up (1- x)) + (down (1+ x)) + (left (1- y)) + (right (1+ y))) + (if (>= up 0) (let ((,coords-var `(,up ,y))) ,@body)) + (if (>= left 0) (let ((,coords-var `(,x ,left))) ,@body)) + (if (< down (boardsize ,board)) (let ((,coords-var `(,down ,y))) ,@body)) + (if (< right (boardsize ,board)) (let ((,coords-var `(,x ,right))) ,@body)))) + (defmethod set-stone :after ((board liberty-board) coords val) (inc-liberties board coords (get-2d-stone (liberty-board board) coords)) - (let* ((x (first coords)) - (y (second coords)) - (up (1- x)) - (down (1+ x)) - (left (1- y)) - (right (1+ y))) - (if (>= up 0) (dec-liberty board `(,up ,y))) - (if (>= left 0) (dec-liberty board `(,x ,left))) - (if (< down (boardsize board)) (dec-liberty board `(,down ,y))) - (if (< right (boardsize board)) (dec-liberty board `(,x ,right))))) + (do-over-adjacent (coords-var board coords) + (dec-liberty board coords-var))) (defmethod score + ((board liberty-board) player) -; (format t "player ~a~%" player) (if (eql player #\B) (- (black-liberties board) (white-liberties board)) (- (white-liberties board) (black-liberties board)))) -; (let ((liberty 0)) -; (do-over-board (coord board) -; (let ((stone (get-stone board coord))) -; (if (eql stone player) -; (incf liberty (get-2d-stone (liberty-board board) coord)) -; (if (eql stone (invert-player player)) -; (decf liberty (get-2d-stone (liberty-board board) coord)))))) -; liberty)) - (defun liberty-to-analyze (board) (concatenate 'string (board-to-analyze (liberty-board board)) '(#\newline) diff --git a/packages.lisp b/packages.lisp index 81fc23a..61a6ca2 100644 --- a/packages.lisp +++ b/packages.lisp @@ -44,18 +44,26 @@ :analyze-board-score :board-to-analyze)) -(defpackage liberty-shape +(defpackage liberty-board (:use :common-lisp :macro-utils :board) (:export :liberty-board :liberty-to-analyze)) +(defpackage shape-board + (:use :common-lisp + :macro-utils + :board) + (:export :shape-board + :shape-to-analyze)) + (defpackage go-bot (:use :common-lisp :board - :liberty-shape) + :liberty-board + :shape-board) (:export :*name* :*version* :*author* diff --git a/shape.lisp b/shape.lisp new file mode 100644 index 0000000..1f6074c --- /dev/null +++ b/shape.lisp @@ -0,0 +1,7 @@ +(in-package :shape-board) + +(defclass shape-board (basic-board) + ( + )) + +;(defun shape-to-analyze ()) \ No newline at end of file