diff --git a/board.lisp b/board.lisp index 524a728..0d3c0e1 100644 --- a/board.lisp +++ b/board.lisp @@ -193,9 +193,9 @@ ) (defmacro invert-player (player) - (if (eql player #\w) - #\b - #\w)) + `(if (eql ,player #\W) + #\B + #\W)) ; multiplex the search here (defmethod search-space ((board basic-board) focus-board score-board player depth) @@ -231,6 +231,7 @@ `(make-instance ,class :boardsize (boardsize ,board) :board-def-type ,def-type)) (defmethod genmove ((board basic-board) player &key (depth 1)) +; (format t "genmove depth ~a player ~a~%" depth player) (if (= depth 0) `( ,(score board (invert-player player)) nil) (let ((score-board (make-instance 'ranked-board :boardsize (boardsize board) :board-def-type nil)) ;(gen-board board 0 'ranked-board)) diff --git a/gobot.lisp b/gobot.lisp index 0bfea27..7c97bac 100644 --- a/gobot.lisp +++ b/gobot.lisp @@ -55,12 +55,14 @@ (play *board* (str-to-coord coord-str) player)))) (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 (coord-to-str (second move)))) + ;(format t "score: ~a for player ~a ~%" board-score player) (if (< board-score 0) "pass" (progn diff --git a/liberty-shape.lisp b/liberty-shape.lisp index 380872e..db6079c 100644 --- a/liberty-shape.lisp +++ b/liberty-shape.lisp @@ -3,14 +3,22 @@ (defclass liberty-board (basic-board) ((liberty-board :initform nil - :accessor liberty-board))) + :accessor liberty-board) + (black-liberties + :initform 0 + :initarg black-liberties + :accessor black-liberties) + (white-liberties + :initform 0 + :initarg white-liberties + :accessor white-liberties))) (defun set-symetric-edge (board index stone max) (let ((coords `( (0 ,index) (,index 0) (,max ,index) (,index ,max)))) (loop for coord in coords do (set-2d-stone (liberty-board board) coord stone)))) (defun set-symetric-corner (board stone max) - (let ((coords `( (0 0) (,max 0) (,max 0) (,max ,max)))) + (let ((coords `( (0 0) (,max 0) (0 ,max) (,max ,max)))) (loop for coord in coords do (set-2d-stone (liberty-board board) coord stone)))) @@ -24,33 +32,85 @@ (set-symetric-edge board i 3 (1- (boardsize board)))) (set-symetric-corner board 2 (1- (boardsize board)))) (progn - (setf (liberty-board board) (copy-2d-board (liberty-board from-board)))))) + (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)))) +;(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) + `(progn + (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)) (up (1- x)) (down (1+ x)) (left (1- y)) (right (1+ y))) - (if (>= up 0) (dec-2d-stone (liberty-board board) `(,up ,y))) - (if (>= left 0) (dec-2d-stone (liberty-board board) `(,x ,left))) - (if (< down (boardsize board)) (dec-2d-stone (liberty-board board) `(,down ,y))) - (if (< right (boardsize board)) (dec-2d-stone (liberty-board board) `(,x ,right))))) + (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))))) (defmethod score + ((board liberty-board) player) - (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)) +; (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) - (board-to-analyze (liberty-board board))) + (concatenate 'string (board-to-analyze (liberty-board board)) + '(#\newline) + "TEXT Black Liberties: " (write-to-string (black-liberties board)) " and White Liberties: " (write-to-string (white-liberties board))))