reorganizing, fixes of intermitent bugs

This commit is contained in:
Dan 2008-08-23 10:19:41 -07:00
parent 7ce213be7a
commit 1e6525045f
9 changed files with 340 additions and 163 deletions

View File

@ -57,12 +57,15 @@
(defun get-2d-stone (board coord) (defun get-2d-stone (board coord)
(if (not (listp 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))) (aref (aref board (first coord)) (second coord)))
(defun set-2d-stone (board coord val) (defun set-2d-stone (board coord val)
(setf (aref (aref board (first coord)) (second 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 () (defclass basic-board ()
@ -92,8 +95,10 @@
`(get-stone ,board ,coords)) `(get-stone ,board ,coords))
(defgeneric remove-stone (board coords)) (defgeneric remove-stone (board coords))
; (:method-combination progn :most-specific-last))
(defmethod remove-stone ((board basic-board) coords) (defmethod remove-stone ((board basic-board) coords)
(pdebug "basic-board:remove stone ~a~%" coords)
(set-2d-stone (board board) coords nil)) (set-2d-stone (board board) coords nil))
;(defgeneric (setf stone) (val coords ;(defgeneric (setf stone) (val coords
@ -316,3 +321,9 @@
(set-stone score-board coord (first (score newboard player)))))) (set-stone score-board coord (first (score newboard player))))))
(board-to-analyze (board score-board))))) (board-to-analyze (board score-board)))))
(defun stones-to-analyze (board)
(concatenate 'string (board-to-analyze (board board))
'(#\newline)))

View File

@ -56,18 +56,19 @@
(defun do-genmove (player) (defun do-genmove (player)
; (format t "do-genmove ~a~%" player) ; (format t "do-genmove ~a~%" player)
(setf *player* player) (let ((macro-utils:*print-debug* nil))
(if (or (eql *passed* t) (eql *last-player* player)) (setf *player* player)
"pass" (if (or (eql *passed* t) (eql *last-player* player))
(let* ((move (genmove *board* player)) "pass"
; (board-score (first move)) (let* ((move (genmove *board* player))
(coord (second move))) ;(board-score (first move))
(coord (second move)))
;(format t "score: ~a for player ~a ~%" board-score player) ;(format t "score: ~a for player ~a ~%" board-score player)
(if (listp coord) ; string= coord "pass")) (if (listp coord) ; string= coord "pass"))
(let ((coord-str (coord-to-str coord))) (let ((coord-str (coord-to-str coord)))
(do-play player coord-str) (do-play player coord-str)
coord-str) coord-str)
coord)))) coord)))))
;(if (< board-score 0) ;(if (< board-score 0)
; "pass" ; "pass"
@ -79,6 +80,9 @@
(defun analyze-score () (defun analyze-score ()
(analyze-board-score *board* *player*)) (analyze-board-score *board* *player*))
(defun analyze-stones ()
(stones-to-analyze *board*))
(defun analyze-liberty () (defun analyze-liberty ()
(liberty-to-analyze *board*)) (liberty-to-analyze *board*))
@ -89,4 +93,4 @@
(liberty-shape-to-analyze *board*)) (liberty-shape-to-analyze *board*))
(defun analyze-shape-stone-liberties () (defun analyze-shape-stone-liberties ()
(liberty-shape-stone-to-analyze *board*)) nil); (liberty-shape-stone-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/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))) (lambda (elem) (string-equal str elem)))
(defun dispatch-gtp-command (command-string) (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)) " ")) (let* ((commands (split-string (string-trim #(#\newline #\space) (string-upcase command-string)) " "))
;(cl-ppcre:split "[\\s\\n]+" (string-upcase command-string))) ;(cl-ppcre:split "[\\s\\n]+" (string-upcase command-string)))
(command (intern (first commands) :gtp-handler))) (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)))) (loop for command in *analyze_commands* do (setf str (concatenate 'string str command (string #\newline))))
(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))) "")
(stones (string-trim #(#\newline) (analyze-stones)))
(liberties (string-trim #(#\newline) (analyze-liberty))) (liberties (string-trim #(#\newline) (analyze-liberty)))
(shapes (string-trim #(#\newline) (analyze-shapes))) (shapes (string-trim #(#\newline) (analyze-shapes)))
(shape-liberties (string-trim #(#\newline) (analyze-shape-liberties))) (shape-liberties (string-trim #(#\newline) (analyze-shape-liberties)))

View File

@ -1,87 +1,48 @@
(in-package :liberty-shape-board) (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) (defgeneric inc-score (board player delta))
(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)))
(defmacro inc-player-shape-liberty (board player delta) (defmacro def-counter-board (name (core-var def-core-type) (black-var white-var))
`(if (eql ,player #\B) (with-gensyms ()
(incf (black-shape-liberties ,board) ,delta) `(progn
(incf (white-shape-liberties ,board) ,delta))) (defclass ,name (liberty-board shape-board)
((,core-var :initform nil :accessor ,core-var)
(defmethod convert-shape :before ((board liberty-shape-board) shape-id to-id) (,black-var :initform 0 :accessor ,black-var)
(let ((player (get-stone board (aref (aref (shapes-points board) shape-id) 0)))) (,white-var :initform 0 :accessor ,white-var)))
(inc-player-shape-stone-liberty board player (- (second (aref (shapes-liberties board) shape-id))))
(setf (aref (shapes-liberties board) shape-id) '(0 0)))) (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) (def-counter-board liberty-shape-board
(sid (shape-id board coords)) (shapes-free-points-list '(make-array 1 :fill-pointer 0 :adjustable t))
(shape-liberties-score (aref (shapes-liberties board) sid)) (black-shape-liberties white-shape-liberties))
(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)) (defmacro shape-liberty (board sid)
; (pdebug "loop add liberties~%") `(length (aref (shapes-free-points-list ,board) ,sid)))
(loop for index from 0 to (1- (length (aref (shapes-points board) sid))) do ; `(* (shape-size ,board ,sid) (length (aref (shapes-free-points-list ,board) ,sid))))
; (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))))
(defun add-free-point (board coord sid player) (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))) (pdebug "add-free-point at ~a to ~a for ~a~%" coord sid player)
(inc-player-shape-liberty board player (- (aref (shapes-free-scores board) sid))) (inc-score board player (- (shape-liberty board sid)))
;(pdebug " = ~a~%" (if (eql player #\B) (black-shape-liberties board) (white-shape-liberties board))) (let* ((found nil)
(let* ((found nil) (free-points (aref (shapes-free-points-list board) sid)))
(free-points (aref (shapes-free-points board) sid)))
(loop for i from 0 to (1- (length free-points)) do (loop for i from 0 to (1- (length free-points)) do
(if (coords-eql coord (aref free-points i)) (if (coords-eql coord (aref free-points i))
(progn (progn
@ -90,97 +51,251 @@
(if (eql found nil) (if (eql found nil)
(progn (progn
(vector-push-extend coord free-points))) (vector-push-extend coord free-points)))
; (inc-player-shape-liberty board player 1)))
(let ((newscore (* (shape-size board sid) (length free-points)))) (let ((newscore (* (shape-size board sid) (length free-points))))
; (format t "newscore ~a*~a = ~a~%" (shape-size board sid) (length free-points) newscore) (inc-score board player 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))))))
(defun add-free-points-around (board nexus player) (defun add-free-points-around (board nexus player)
(pdebug "add-free-points-around ~a ~a~%" nexus player)
(let ((sid (shape-id board nexus))) (let ((sid (shape-id board nexus)))
(do-over-adjacent (coords-var board nexus) (do-over-adjacent (coords-var board nexus)
(pdebug "looking at ~a~%" coords-var)
(if (eql (get-stone board coords-var) nil) (if (eql (get-stone board coords-var) nil)
(add-free-point board coords-var sid player))))) (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) (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) (if (> (length free-points) 0)
(let ((tmp (aref free-points (1- (length free-points))))) (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 (loop for i from 0 to (1- (length free-points)) do
; (pdebug "search ~a" i)
(if (coords-eql coord (aref free-points i)) (if (coords-eql coord (aref free-points i))
(progn (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) (setf (aref free-points i) tmp)
; (pdebug "do vector pop~%")
(vector-pop free-points) (vector-pop free-points)
; (pdebug "inc-player-shape-liberty~%") (inc-score board player (* (length free-points) (shape-size board sid)))
(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)))) (return))))
(if (= 0 (length free-points)) (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) (defmethod set-stone :after ((board liberty-shape-board) coords val)
(while (not (eql (length (shapes-liberties board)) (next-shape-id board))) (pdebug "liberty-shape-board:set-stone ~a ~a~%" coords val)
(vector-push-extend '(0 0) (shapes-liberties board)) ; new shape (while (not (eql (length (shapes-free-points-list board)) (next-shape-id board)))
(vector-push-extend 0 (shapes-free-scores board)) (vector-push-extend (make-array 1 :fill-pointer 0 :adjustable t) (shapes-free-points-list 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) (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) ;adjust neighebors, removing this free point
(let ((lsb (make-2d-board (boardsize board) 0))) (pdebug "Searching for shapes around ~a to notify to remove free point~%" coords)
(do-over-board (coords board) (do-over-adjacent (coords-var board coords)
(if (not (eql nil (shape-id board coords))) (pdebug "looking at ~a~%" coords-var)
(set-2d-stone lsb coords (second (aref (shapes-liberties board) (shape-id board coords)))))) (let ((adj-sid (shape-id board coords-var)))
(concatenate 'string (board-to-analyze lsb) (if (not (eql adj-sid nil))
'(#\newline) " TEXT black shape stone liberties: " (write-to-string (black-shape-stone-liberties board)) (remove-free-point board coords adj-sid (get-player board coords-var))))))
" white shape stone liberties: " (write-to-string (white-shape-stone-liberties board)))))
(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) (defun liberty-shape-to-analyze (board)
(let ((lsb (make-2d-board (boardsize board) 0))) (let ((lsb (make-2d-board (boardsize board) 0)))
(do-over-board (coords board) (do-over-board (coords board)
(if (not (eql nil (shape-id board coords))) (if (not (eql nil (shape-id board coords)))
(set-2d-stone lsb coords (shape-liberties-score board (shape-id board coords))))) (set-2d-stone lsb coords (shape-liberty board (shape-id board coords)))))
(concatenate 'string (board-to-analyze lsb) (concatenate 'string (board-to-analyze lsb)
'(#\newline) " TEXT black shape liberties: " (write-to-string (black-shape-liberties board)) '(#\newline) " TEXT black shape liberties: " (write-to-string (black-shape-liberties board))
" white shape liberties: " (write-to-string (white-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)))) ; (- (white-shape-liberties board) (black-shape-liberties board))))
(defmethod score + ((board liberty-shape-board) player) ;(defmethod score + ((board liberty-shape-board) player)
(if (eql player #\B) ; (if (eql player #\B)
(- (black-shape-stone-liberties board) (white-shape-stone-liberties board)) ; (- (black-shape-stone-liberties board) (white-shape-stone-liberties board))
(- (white-shape-stone-liberties board) (black-shape-stone-liberties board)))) ; (- (white-shape-stone-liberties board) (black-shape-stone-liberties board))))

View File

@ -65,6 +65,7 @@
(dec-liberty board coords-var))) (dec-liberty board coords-var)))
(defmethod remove-stone :after ((board liberty-board) coords) (defmethod remove-stone :after ((board liberty-board) coords)
(pdebug "liberty-board:remove-stone ~a~%" coords)
(do-over-adjacent (coords-var board coords) (do-over-adjacent (coords-var board coords)
(inc-liberty board coords-var))) (inc-liberty board coords-var)))

View File

@ -12,8 +12,11 @@
; (format t "~a~%" i) ; (format t "~a~%" i)
; (incf i)))) ; (incf i))))
(defparameter *print-debug* t)
(defmacro pdebug (&body body) (defmacro pdebug (&body body)
`(format *error-output* ,@body)) `(if macro-utils:*print-debug*
(format *error-output* ,@body)))
(defmacro while (test-case &body body) (defmacro while (test-case &body body)
`(do () `(do ()

View File

@ -10,7 +10,8 @@
:once-only :once-only
:while :while
:until :until
:pdebug)) :pdebug
:*print-debug*))
(defpackage netpipe (defpackage netpipe
(:use :common-lisp) (:use :common-lisp)
@ -44,6 +45,7 @@
:def-over-board :def-over-board
:set-2d-stone :set-2d-stone
:get-2d-stone :get-2d-stone
:coords-eql
:invert-player :invert-player
:prune :prune
:focus :focus
@ -52,7 +54,8 @@
:analyze-board-score :analyze-board-score
:board-to-analyze :board-to-analyze
; :do-over-2d-adjacent ; :do-over-2d-adjacent
:do-over-adjacent)) :do-over-adjacent
:stones-to-analyze))
(defpackage liberty-board (defpackage liberty-board
(:use :common-lisp (:use :common-lisp
@ -73,7 +76,8 @@
:shape-sizes :shape-sizes
:next-shape-id :next-shape-id
:convert-shape :convert-shape
:shape-size)) :shape-size
:remove-shape))
(defpackage liberty-shape-board (defpackage liberty-shape-board
(:use :common-lisp (:use :common-lisp
@ -82,8 +86,8 @@
:liberty-board :liberty-board
:shape-board) :shape-board)
(:export :liberty-shape-board (:export :liberty-shape-board
:liberty-shape-to-analyze :liberty-shape-to-analyze))
:liberty-shape-stone-to-analyze)) ;:liberty-shape-stone-to-analyze))
(defpackage go-bot (defpackage go-bot
@ -104,6 +108,7 @@
:do-play :do-play
:do-genmove :do-genmove
:composite-board :composite-board
:analyze-stones
:analyze-score :analyze-score
:analyze-liberty :analyze-liberty
:analyze-shapes :analyze-shapes
@ -114,7 +119,8 @@
(defpackage gtp-handler (defpackage gtp-handler
(:use :common-lisp (:use :common-lisp
:netpipe :netpipe
:go-bot) :go-bot
:macro-utils)
(:export :gtp-client (:export :gtp-client
:gtp-net-client)) :gtp-net-client))

View File

@ -80,6 +80,26 @@
;(defun shape-to-analyze ()) ;(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) (defun shapes-to-analyze (board)
(concatenate 'string (board-to-analyze (shape-board 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))))) '(#\newline) " TEXT next-shape-id: " (write-to-string (next-shape-id board)) " length(shapes-points): " (write-to-string (length (shapes-points board)))))

View File

@ -10,15 +10,30 @@
:initarg b :initarg b
:accessor 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) (defgeneric dothing (class data)
(:method-combination progn :most-specific-last)) (:method-combination progn :most-specific-last))
(defmethod dothing progn ((class class_a) data) (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) (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) (defgeneric doother4 (class data)
);(:method-combination progn :most-specific-last)) );(:method-combination progn :most-specific-last))