From 1e6525045f477a1d168e40f53c81ab31307478fc Mon Sep 17 00:00:00 2001 From: Dan Date: Sat, 23 Aug 2008 10:19:41 -0700 Subject: [PATCH] reorganizing, fixes of intermitent bugs --- board.lisp | 13 +- gobot.lisp | 28 ++-- gtp.lisp | 4 +- liberty-shape.lisp | 395 +++++++++++++++++++++++++++++---------------- liberty.lisp | 1 + macro-utils.lisp | 5 +- packages.lisp | 18 ++- shape.lisp | 20 +++ test-class.lisp | 19 ++- 9 files changed, 340 insertions(+), 163 deletions(-) diff --git a/board.lisp b/board.lisp index 76f9926..2ffdde6 100644 --- a/board.lisp +++ b/board.lisp @@ -57,12 +57,15 @@ (defun get-2d-stone (board coord) (if (not (listp coord)) - (format t "MASSIVE ERROR!~%trying to access coord:~a on board" coord)) + (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)) +(defmacro coords-eql (a b) + `(and (eql (first ,a) (first ,b)) (eql (second ,a) (second ,b)))) + (defclass basic-board () @@ -92,8 +95,10 @@ `(get-stone ,board ,coords)) (defgeneric remove-stone (board coords)) +; (:method-combination progn :most-specific-last)) (defmethod remove-stone ((board basic-board) coords) + (pdebug "basic-board:remove stone ~a~%" coords) (set-2d-stone (board board) coords nil)) ;(defgeneric (setf stone) (val coords @@ -316,3 +321,9 @@ (set-stone score-board coord (first (score newboard player)))))) (board-to-analyze (board score-board))))) + +(defun stones-to-analyze (board) + (concatenate 'string (board-to-analyze (board board)) + '(#\newline))) + + diff --git a/gobot.lisp b/gobot.lisp index 73f2264..810bde0 100644 --- a/gobot.lisp +++ b/gobot.lisp @@ -56,18 +56,19 @@ (defun do-genmove (player) ; (format t "do-genmove ~a~%" player) - (setf *player* player) - (if (or (eql *passed* t) (eql *last-player* player)) - "pass" - (let* ((move (genmove *board* player)) -; (board-score (first move)) - (coord (second move))) + (let ((macro-utils:*print-debug* nil)) + (setf *player* player) + (if (or (eql *passed* t) (eql *last-player* player)) + "pass" + (let* ((move (genmove *board* player)) + ;(board-score (first move)) + (coord (second move))) ;(format t "score: ~a for player ~a ~%" board-score player) - (if (listp coord) ; string= coord "pass")) - (let ((coord-str (coord-to-str coord))) - (do-play player coord-str) - coord-str) - coord)))) + (if (listp coord) ; string= coord "pass")) + (let ((coord-str (coord-to-str coord))) + (do-play player coord-str) + coord-str) + coord))))) ;(if (< board-score 0) ; "pass" @@ -79,6 +80,9 @@ (defun analyze-score () (analyze-board-score *board* *player*)) +(defun analyze-stones () + (stones-to-analyze *board*)) + (defun analyze-liberty () (liberty-to-analyze *board*)) @@ -89,4 +93,4 @@ (liberty-shape-to-analyze *board*)) (defun analyze-shape-stone-liberties () - (liberty-shape-stone-to-analyze *board*)) +nil); (liberty-shape-stone-to-analyze *board*)) diff --git a/gtp.lisp b/gtp.lisp index a6569c0..917a953 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/Shapes/shapes" "gfx/Shape-Liberties/shape-liberties" "gfx/Shape-Stone-Liberties/shape-stone-liberties")) +(defparameter *analyze_commands* '("gfx/Stones/stones" "gfx/Liberties/liberties" "gfx/Shapes/shapes" "gfx/Shape-Liberties/shape-liberties" "gfx/Shape-Stone-Liberties/shape-stone-liberties")) @@ -58,6 +58,7 @@ (lambda (elem) (string-equal str elem))) (defun dispatch-gtp-command (command-string) + (pdebug "dispatch-gtp-command ~a~%" command-string) (let* ((commands (split-string (string-trim #(#\newline #\space) (string-upcase command-string)) " ")) ;(cl-ppcre:split "[\\s\\n]+" (string-upcase command-string))) (command (intern (first commands) :gtp-handler))) @@ -87,6 +88,7 @@ (loop for command in *analyze_commands* do (setf str (concatenate 'string str command (string #\newline)))) (string-trim #(#\newline) str))) (game_score (format t "Score for ~c: ~s~%" go-bot:*player* (string-trim (string #\newline) (second commands))) "") + (stones (string-trim #(#\newline) (analyze-stones))) (liberties (string-trim #(#\newline) (analyze-liberty))) (shapes (string-trim #(#\newline) (analyze-shapes))) (shape-liberties (string-trim #(#\newline) (analyze-shape-liberties))) diff --git a/liberty-shape.lisp b/liberty-shape.lisp index 794e1c9..0540973 100644 --- a/liberty-shape.lisp +++ b/liberty-shape.lisp @@ -1,87 +1,48 @@ (in-package :liberty-shape-board) -(defclass liberty-shape-board (liberty-board shape-board) - ( - ; stores lists (shape-liberties shape-libertirs-score) - (shapes-liberties - :initform nil - :accessor shapes-liberties) - ; stores lists of free stones adjacent to shape - (shapes-free-points - :initform nil - :accessor shapes-free-points) - (shapes-free-scores - :initform nil - :accessor shapes-free-scores) - (black-shape-stone-liberties - :initform 0 - :accessor black-shape-stone-liberties) - (white-shape-stone-liberties - :initform 0 - :accessor white-shape-stone-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)) - (setf (shapes-free-points board) (make-array 1 :fill-pointer 0 :adjustable t)) - (setf (shapes-free-scores board) (make-array 1 :fill-pointer 0 :adjustable t))) - - (progn - (setf (shapes-liberties board) (copy-array (shapes-liberties from-board))) - (setf (shapes-free-points board) (copy-2d-array (shapes-free-points from-board))) - (setf (shapes-free-scores board) (copy-array (shapes-free-scores from-board))) - (copy-slots (white-shape-liberties black-shape-liberties black-shape-stone-liberties white-shape-stone-liberties) board from-board)))) - -(defmacro inc-player-shape-stone-liberty (board player delta) - `(if (eql ,player #\B) - (incf (black-shape-stone-liberties ,board) ,delta) - (incf (white-shape-stone-liberties ,board) ,delta))) +(defgeneric inc-score (board player delta)) -(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-stone-liberty board player (- (second (aref (shapes-liberties board) shape-id)))) - (setf (aref (shapes-liberties board) shape-id) '(0 0)))) +(defmacro def-counter-board (name (core-var def-core-type) (black-var white-var)) + (with-gensyms () + `(progn + (defclass ,name (liberty-board shape-board) + ((,core-var :initform nil :accessor ,core-var) + (,black-var :initform 0 :accessor ,black-var) + (,white-var :initform 0 :accessor ,white-var))) + + (defmethod initialize-instance :after ((board ,name) &key from-board) + (if (eql from-board nil) + (progn + (setf (,core-var board) (make-array 1 :fill-pointer 0 :adjustable t))) + (progn + (setf (,core-var board) (copy-2d-array (,core-var from-board))) + (copy-slots (,black-var ,white-var) board from-board)))) + + (defmethod inc-score ((board ,name) player delta) + (if (eql player #\B) + (incf (,black-var board) delta) + (incf (,white-var board) delta))) +))) -(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))) - ; (pdebug "calculate-shape-liberties for sid:~a score:~a~%" sid shape-liberties-score) - (inc-player-shape-stone-liberty board player (- old-score)) -; (pdebug "loop add liberties~%") - (loop for index from 0 to (1- (length (aref (shapes-points board) sid))) do -; (pdebug "adding on ~a~%" index) - (incf liberties (liberty board (aref (aref (shapes-points board) sid) index)))) - (let ((score (* liberties (shape-size board sid)))) -; (pdebug "sets shape-liberties for ~a (~a ~a)~%" sid liberties score) - (setf (aref (shapes-liberties board) sid) `(,liberties ,score)) - (inc-player-shape-stone-liberty board player score)))) - -(defmacro coords-eql (a b) - `(and (eql (first ,a) (first ,b)) (eql (second ,a) (second ,b)))) + +(def-counter-board liberty-shape-board + (shapes-free-points-list '(make-array 1 :fill-pointer 0 :adjustable t)) + (black-shape-liberties white-shape-liberties)) + + +(defmacro shape-liberty (board sid) + `(length (aref (shapes-free-points-list ,board) ,sid))) +; `(* (shape-size ,board ,sid) (length (aref (shapes-free-points-list ,board) ,sid)))) (defun add-free-point (board coord sid player) - ;(pdebug "1st (dec) inc score ~a by ~a " (if (eql player #\B) (black-shape-liberties board) (white-shape-liberties board)) (- (aref (shapes-free-scores board) sid))) - (inc-player-shape-liberty board player (- (aref (shapes-free-scores board) sid))) - ;(pdebug " = ~a~%" (if (eql player #\B) (black-shape-liberties board) (white-shape-liberties board))) - (let* ((found nil) - (free-points (aref (shapes-free-points board) sid))) + (pdebug "add-free-point at ~a to ~a for ~a~%" coord sid player) + (inc-score board player (- (shape-liberty board sid))) + (let* ((found nil) + (free-points (aref (shapes-free-points-list board) sid))) (loop for i from 0 to (1- (length free-points)) do (if (coords-eql coord (aref free-points i)) (progn @@ -90,97 +51,251 @@ (if (eql found nil) (progn (vector-push-extend coord free-points))) -; (inc-player-shape-liberty board player 1))) (let ((newscore (* (shape-size board sid) (length free-points)))) - ; (format t "newscore ~a*~a = ~a~%" (shape-size board sid) (length free-points) newscore) -; (pdebug "2nd inc score ~a by ~a " (if (eql player #\B) (black-shape-liberties board) (white-shape-liberties board)) newscore) - (setf (aref (shapes-free-scores board) sid) newscore) - ; (format t "set shape-free-scores~%") - (inc-player-shape-liberty board player newscore)))) - ; (pdebug " = ~a~%" (if (eql player #\B) (black-shape-liberties board) (white-shape-liberties board)))))) + (inc-score board player newscore)))) (defun add-free-points-around (board nexus player) + (pdebug "add-free-points-around ~a ~a~%" nexus player) (let ((sid (shape-id board nexus))) (do-over-adjacent (coords-var board nexus) + (pdebug "looking at ~a~%" coords-var) (if (eql (get-stone board coords-var) nil) (add-free-point board coords-var sid player))))) - -(defun remove-shape (board sid) - (pdebug "remove-shape ~a~%" sid) - (let ((stones (aref (shapes-points board) sid))) - (loop for index from 0 to (1- (length stones)) do - (progn (pdebug "removing stone ~a~%" (aref stones index)) - (remove-stone board (aref stones index)))))) - + (defun remove-free-point (board coord sid player) - (let ((free-points (aref (shapes-free-points board) sid))) +; (pdebug "remove-free-point ~a ~a ~a" coord sid player) + (let ((free-points (aref (shapes-free-points-list board) sid))) (if (> (length free-points) 0) (let ((tmp (aref free-points (1- (length free-points))))) - ; (pdebug "dec inc-player-shape-liberty~%") - - ;(pdebug "search for point~%") (loop for i from 0 to (1- (length free-points)) do - ; (pdebug "search ~a" i) (if (coords-eql coord (aref free-points i)) (progn - ; (pdebug "found on ~a @ ~a" i (aref free-points i)) + (inc-score board player (- (shape-liberty board sid))) (setf (aref free-points i) tmp) - ; (pdebug "do vector pop~%") (vector-pop free-points) - ; (pdebug "inc-player-shape-liberty~%") - (inc-player-shape-liberty board player (- (aref (shapes-free-scores board) sid))) - (inc-player-shape-liberty board player (* (length free-points) (shape-size board sid))) - ; (pdebug "set shapes-free-scores new score for ~a~%" sid) - (setf (aref (shapes-free-scores board) sid) (* (length free-points) (shape-size board sid))) + (inc-score board player (* (length free-points) (shape-size board sid))) (return)))) (if (= 0 (length free-points)) - (remove-shape board sid)))))) - + (progn (pdebug "remve-shape ~a~%" sid) + (remove-shape board sid))))))) (defmethod set-stone :after ((board liberty-shape-board) coords val) - (while (not (eql (length (shapes-liberties board)) (next-shape-id board))) - (vector-push-extend '(0 0) (shapes-liberties board)) ; new shape - (vector-push-extend 0 (shapes-free-scores board)) - (vector-push-extend (make-array 1 :fill-pointer 0 :adjustable t) (shapes-free-points board))) - (calculate-shape-liberties board coords val) - ; (pdebug "about to add-free-points~%") + (pdebug "liberty-shape-board:set-stone ~a ~a~%" coords val) + (while (not (eql (length (shapes-free-points-list board)) (next-shape-id board))) + (vector-push-extend (make-array 1 :fill-pointer 0 :adjustable t) (shapes-free-points-list board))) (add-free-points-around board coords val) - ;adjust neighebors - ; (pdebug "about to adjust neighbors~%") - (let ((sid (shape-id board coords))) - (do-over-adjacent (coords-var board coords) - (let ((adj-sid (shape-id board coords-var)) - (adj-player (get-player board coords-var))) - (if (not (eql adj-sid nil)) - (progn - ; (pdebug "adjusting: from coord:~a removing free: ~a and sid:~a player ~a~%" coords coords-var adj-sid adj-player) - (remove-free-point board coords adj-sid adj-player) - ; (pdebug "remove-free-point done~%") - (if (not(eql adj-sid sid)) - (calculate-shape-liberties board coords-var (get-stone board coords-var))))))))) -(defun liberty-shape-stone-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 black shape stone liberties: " (write-to-string (black-shape-stone-liberties board)) - " white shape stone liberties: " (write-to-string (white-shape-stone-liberties board))))) + ;adjust neighebors, removing this free point + (pdebug "Searching for shapes around ~a to notify to remove free point~%" coords) + (do-over-adjacent (coords-var board coords) + (pdebug "looking at ~a~%" coords-var) + (let ((adj-sid (shape-id board coords-var))) + (if (not (eql adj-sid nil)) + (remove-free-point board coords adj-sid (get-player board coords-var)))))) + + +(defmethod convert-shape :before ((board liberty-shape-board) shape-id to-id) + (pdebug "convert-shape ~a to ~a~%" shape-id to-id) + (pdebug "shape-points ~a~%" (aref (shapes-points board) shape-id)) + (pdebug "player: ~a~%" (get-stone board (aref (aref (shapes-points board) shape-id) 0))) + (if (> (length (aref (shapes-points board) shape-id)) 0) + (let ((player (get-stone board (aref (aref (shapes-points board) shape-id) 0)))) + (inc-score board player (- (shape-liberty board shape-id))) + (let + ((from-free (aref (shapes-free-points-list board) shape-id)) + (to-free (aref (shapes-free-points-list board) shape-id))) + + (loop for i from 0 to (1- (length from-free)) do + (add-free-point board (aref from-free i) to-id player)) + (setf (aref (shapes-free-points-list board) shape-id) (make-array 1 :fill-pointer 0 :adjustable t)))))) +; (inc-score board player (shape-liberty board to-id))) + ;(setf (aref (shapes-free-points-list board) shape-id) (make-array 1 :fill-pointer 0 :adjustable t)))) + +;(defmethod convert-shape :after ((board liberty-shape-board) shape-id to-id) +; (let ((player (get-stone board (aref (aref (shapes-points board) shape-id) 0))) + + + +(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)))) -(defun shape-liberties-score (board sid) - (* (shape-size board sid) (length (aref (shapes-free-points board) sid)))) (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 (shape-liberties-score board (shape-id board coords))))) - (concatenate 'string (board-to-analyze lsb) - '(#\newline) " TEXT black shape liberties: " (write-to-string (black-shape-liberties board)) - " white shape liberties: " (write-to-string (white-shape-liberties board))))) + (set-2d-stone lsb coords (shape-liberty board (shape-id board coords))))) + (concatenate 'string (board-to-analyze lsb) + '(#\newline) " TEXT black shape liberties: " (write-to-string (black-shape-liberties board)) + " white shape liberties: " (write-to-string (white-shape-liberties board))))) + + + +;(defmacro calc-shape-score (board var sid) +; `(* (shape-size ,board ,sid) (aref (,var ,board) ,sid))) + + +;(defclass liberty-shape-board (liberty-board shape-board) +; ( +; ; stores lists (shape-liberties shape-libertirs-score) +; (shapes-liberties +; :initform nil +; :accessor shapes-liberties) +; ; stores lists of free stones adjacent to shape +; (shapes-free-points +; :initform nil +; :accessor shapes-free-points) +; (shapes-free-scores +; :initform nil +; :accessor shapes-free-scores) +; (black-shape-stone-liberties +; :initform 0 +; :accessor black-shape-stone-liberties) +; (white-shape-stone-liberties +; :initform 0 +; :accessor white-shape-stone-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)) +; (setf (shapes-free-points board) (make-array 1 :fill-pointer 0 :adjustable t)) +; (setf (shapes-free-scores board) (make-array 1 :fill-pointer 0 :adjustable t))) +; +; (progn +; (setf (shapes-liberties board) (copy-array (shapes-liberties from-board))) +; (setf (shapes-free-points board) (copy-2d-array (shapes-free-points from-board))) +; (setf (shapes-free-scores board) (copy-array (shapes-free-scores from-board))) +; (copy-slots (white-shape-liberties black-shape-liberties black-shape-stone-liberties white-shape-stone-liberties) board from-board)))) + +;(defmacro shape-stone-liberties + +;(defmacro calc-shape-stones-liberties (board sid) + + +;(defmacro inc-player-shape-stone-liberty (board player delta) +; `(if (eql ,player #\B) +; (incf (black-shape-stone-liberties ,board) ,delta) +; (incf (white-shape-stone-liberties ,board) ,delta))) + +;(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-stone-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))) +; ; (pdebug "calculate-shape-liberties for sid:~a score:~a~%" sid shape-liberties-score) +; (inc-player-shape-stone-liberty board player (- old-score)) +;; (pdebug "loop add liberties~%") +; (loop for index from 0 to (1- (length (aref (shapes-points board) sid))) do +;; (pdebug "adding on ~a~%" index) +; (incf liberties (liberty board (aref (aref (shapes-points board) sid) index)))) +; (let ((score (* liberties (shape-size board sid)))) +;; (pdebug "sets shape-liberties for ~a (~a ~a)~%" sid liberties score) +; (setf (aref (shapes-liberties board) sid) `(,liberties ,score)) +; (inc-player-shape-stone-liberty board player score)))) + + + +;(defun add-free-point (board coord sid player) +; (inc-player-shape-liberty board player (- (aref (shapes-free-scores board) sid))) +; (let* ((found nil) +; (free-points (aref (shapes-free-points board) sid))) +; (loop for i from 0 to (1- (length free-points)) do +; (if (coords-eql coord (aref free-points i)) +; (progn +; (setf found t) +; (return)))) +; (if (eql found nil) +; (progn +; (vector-push-extend coord free-points))) +; (let ((newscore (* (shape-size board sid) (length free-points)))) +; (setf (aref (shapes-free-scores board) sid) newscore) +; (inc-player-shape-liberty board player newscore)))) + +;(defun add-free-points-around (board nexus player) +; (let ((sid (shape-id board nexus))) +; (do-over-adjacent (coords-var board nexus) +; (if (eql (get-stone board coords-var) nil) +; (add-free-point board coords-var sid player))))) + +;(defun remove-shape (board sid) +; (pdebug "remove-shape ~a~%" sid) +; (let ((stones (aref (shapes-points board) sid))) +; (loop for index from 0 to (1- (length stones)) do +; (progn (pdebug "removing stone ~a~%" (aref stones index)) +; (remove-stone board (aref stones index)))))) + + +;(defun remove-free-point (board coord sid player) +; (let ((free-points (aref (shapes-free-points board) sid))) +; (if (> (length free-points) 0) +; (let ((tmp (aref free-points (1- (length free-points))))) +; ; (pdebug "dec inc-player-shape-liberty~%") +; +; ;(pdebug "search for point~%") +; (loop for i from 0 to (1- (length free-points)) do +; ; (pdebug "search ~a" i) +; (if (coords-eql coord (aref free-points i)) +; (progn +; ; (pdebug "found on ~a @ ~a" i (aref free-points i)) +; (setf (aref free-points i) tmp) +; ; (pdebug "do vector pop~%") +; (vector-pop free-points) +; ; (pdebug "inc-player-shape-liberty~%") +; (inc-player-shape-liberty board player (- (aref (shapes-free-scores board) sid))) +; (inc-player-shape-liberty board player (* (length free-points) (shape-size board sid))) +; ; (pdebug "set shapes-free-scores new score for ~a~%" sid) +; (setf (aref (shapes-free-scores board) sid) (* (length free-points) (shape-size board sid))) +; (return)))) +; (if (= 0 (length free-points)) +; (remove-shape board sid)))))) + + + +;(defmethod set-stone :after ((board liberty-shape-board) coords val) +; (while (not (eql (length (shapes-liberties board)) (next-shape-id board))) +; (vector-push-extend '(0 0) (shapes-liberties board)) ; new shape +; (vector-push-extend 0 (shapes-free-scores board)) +; (vector-push-extend (make-array 1 :fill-pointer 0 :adjustable t) (shapes-free-points board))) +; (calculate-shape-liberties board coords val) +; ; (pdebug "about to add-free-points~%") +; (add-free-points-around board coords val) +; ;adjust neighebors +; ; (pdebug "about to adjust neighbors~%") +; (let ((sid (shape-id board coords))) +; (do-over-adjacent (coords-var board coords) +; (let ((adj-sid (shape-id board coords-var)) +; (adj-player (get-player board coords-var))) +; (if (not (eql adj-sid nil)) +; (progn +; (pdebug "adjusting: from coord:~a removing free: ~a and sid:~a player ~a~%" coords coords-var adj-sid adj-player) +; (remove-free-point board coords adj-sid adj-player) +; (pdebug "remove-free-point done~%") +; (if (not(eql adj-sid sid)) +; (calculate-shape-liberties board coords-var (get-stone board coords-var))) +; (pdebug "done calculate-shape-liberties~%"))))))) @@ -190,7 +305,7 @@ ; (- (white-shape-liberties board) (black-shape-liberties board)))) -(defmethod score + ((board liberty-shape-board) player) - (if (eql player #\B) - (- (black-shape-stone-liberties board) (white-shape-stone-liberties board)) - (- (white-shape-stone-liberties board) (black-shape-stone-liberties board)))) \ No newline at end of file +;(defmethod score + ((board liberty-shape-board) player) +; (if (eql player #\B) +; (- (black-shape-stone-liberties board) (white-shape-stone-liberties board)) +; (- (white-shape-stone-liberties board) (black-shape-stone-liberties board)))) \ No newline at end of file diff --git a/liberty.lisp b/liberty.lisp index e4d6244..bdde659 100644 --- a/liberty.lisp +++ b/liberty.lisp @@ -65,6 +65,7 @@ (dec-liberty board coords-var))) (defmethod remove-stone :after ((board liberty-board) coords) + (pdebug "liberty-board:remove-stone ~a~%" coords) (do-over-adjacent (coords-var board coords) (inc-liberty board coords-var))) diff --git a/macro-utils.lisp b/macro-utils.lisp index d49f31a..16fcec0 100644 --- a/macro-utils.lisp +++ b/macro-utils.lisp @@ -12,8 +12,11 @@ ; (format t "~a~%" i) ; (incf i)))) +(defparameter *print-debug* t) + (defmacro pdebug (&body body) - `(format *error-output* ,@body)) + `(if macro-utils:*print-debug* + (format *error-output* ,@body))) (defmacro while (test-case &body body) `(do () diff --git a/packages.lisp b/packages.lisp index 64a1bd0..0bc9d43 100644 --- a/packages.lisp +++ b/packages.lisp @@ -10,7 +10,8 @@ :once-only :while :until - :pdebug)) + :pdebug + :*print-debug*)) (defpackage netpipe (:use :common-lisp) @@ -44,6 +45,7 @@ :def-over-board :set-2d-stone :get-2d-stone + :coords-eql :invert-player :prune :focus @@ -52,7 +54,8 @@ :analyze-board-score :board-to-analyze ; :do-over-2d-adjacent - :do-over-adjacent)) + :do-over-adjacent + :stones-to-analyze)) (defpackage liberty-board (:use :common-lisp @@ -73,7 +76,8 @@ :shape-sizes :next-shape-id :convert-shape - :shape-size)) + :shape-size + :remove-shape)) (defpackage liberty-shape-board (:use :common-lisp @@ -82,8 +86,8 @@ :liberty-board :shape-board) (:export :liberty-shape-board - :liberty-shape-to-analyze - :liberty-shape-stone-to-analyze)) + :liberty-shape-to-analyze)) + ;:liberty-shape-stone-to-analyze)) (defpackage go-bot @@ -104,6 +108,7 @@ :do-play :do-genmove :composite-board + :analyze-stones :analyze-score :analyze-liberty :analyze-shapes @@ -114,7 +119,8 @@ (defpackage gtp-handler (:use :common-lisp :netpipe - :go-bot) + :go-bot + :macro-utils) (:export :gtp-client :gtp-net-client)) diff --git a/shape.lisp b/shape.lisp index 2538705..6895751 100644 --- a/shape.lisp +++ b/shape.lisp @@ -80,6 +80,26 @@ ;(defun shape-to-analyze ()) +(defmethod remove-stone :after ((board shape-board) coords) + (pdebug "shape-board:remove-stone ~a~%" coords) + (set-2d-stone (shape-board board) coords nil)) + +(defgeneric remove-shape (board sid)) + +(defmethod remove-shape ((board shape-board) sid) + (pdebug "shape-board:remove-shape ~a~%" sid) + (let ((stones (aref (shapes-points board) sid))) + (loop for index from 0 to (1- (length stones)) do + (progn (pdebug "removing stone ~a~%" (aref stones index)) + (remove-stone board (aref stones index))))) + (pdebug "shape-sizes to 0~%") + (setf (aref (shape-sizes board) sid) 0) + (pdebug "shape-points to nil~%") + (setf (aref (shapes-points board) sid) (make-array 1 :fill-pointer 0 :adjustable t)) + (pdebug "remove-shape done~%")) + + + (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))))) diff --git a/test-class.lisp b/test-class.lisp index 7297401..8c26b31 100644 --- a/test-class.lisp +++ b/test-class.lisp @@ -10,15 +10,30 @@ :initarg b :accessor b))) + +(defclass class_c (class_a) + ((b + :initform (make-array 10 :initial-element 1) + :initarg b + :accessor b))) + +(defclass class_d (class_b class_c) + ((d + :initform 0 + :accessor d))) + (defgeneric dothing (class data) (:method-combination progn :most-specific-last)) (defmethod dothing progn ((class class_a) data) - (loop for i from 0 to 9 do (setf (aref (a class) i) (+ (aref (a class) i) data)))) + (loop for i from 0 to 9 do (setf (aref (a class) i) (+ (aref (a class) i) 1))));data)))) (defmethod dothing progn ((class class_b) data) - (loop for i from 0 to 9 do (setf (aref (b class) i) (+ (aref (b class) i) (aref (a class) i) data)))) + (loop for i from 0 to 9 do (progn (setf (aref (b class) i) (+ (aref (b class) i) 2)) (print (aref (b class) i)))));(aref (a class) i) data)))) + +(defmethod dothing progn ((class class_c) data) + (loop for i from 0 to 9 do (progn (setf (aref (b class) i) (+ (aref (b class) i) 3)) (print (aref (b class) i))))) (defgeneric doother4 (class data) );(:method-combination progn :most-specific-last))