dan
/
fink
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

refactoring of liberty and start of shape

This commit is contained in:
Dan 2008-06-03 09:08:30 -07:00
parent 5eee0677f1
commit 7f02d755e1
5 changed files with 42 additions and 69 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
env.lisp
View File

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

14
fink.lisp
View File

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

63
liberty-shape.lisp → liberty.lisp
View File

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

12
packages.lisp
View File

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

7
shape.lisp Normal file
View File

@ -0,0 +1,7 @@
(in-package :shape-board)
(defclass shape-board (basic-board)
(
))
;(defun shape-to-analyze ())