reorganizing, fixes of intermitent bugs
This commit is contained in:
Dan
parent
7ce213be7a
commit
1e6525045f
13
board.lisp
13
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)))
|
||||
|
||||
|
||||
|
|
|
|||
28
gobot.lisp
28
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*))
|
||||
|
|
|
|||
4
gtp.lisp
4
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)))
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
(defgeneric inc-score (board player delta))
|
||||
|
||||
(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 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)))
|
||||
|
||||
(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)))
|
||||
(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))))
|
||||
|
||||
(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))))
|
||||
(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))))
|
||||
;(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))))
|
||||
|
|
@ -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)))
|
||||
|
||||
|
|
|
|||
|
|
@ -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 ()
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
||||
|
|
|
|||
20
shape.lisp
20
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)))))
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
Loading…
Reference in New Issue