liberty finally works
This commit is contained in:
parent
94b95cbcdb
commit
5eee0677f1
|
@ -193,9 +193,9 @@
|
||||||
)
|
)
|
||||||
|
|
||||||
(defmacro invert-player (player)
|
(defmacro invert-player (player)
|
||||||
(if (eql player #\w)
|
`(if (eql ,player #\W)
|
||||||
#\b
|
#\B
|
||||||
#\w))
|
#\W))
|
||||||
|
|
||||||
; multiplex the search here
|
; multiplex the search here
|
||||||
(defmethod search-space ((board basic-board) focus-board score-board player depth)
|
(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))
|
`(make-instance ,class :boardsize (boardsize ,board) :board-def-type ,def-type))
|
||||||
|
|
||||||
(defmethod genmove ((board basic-board) player &key (depth 1))
|
(defmethod genmove ((board basic-board) player &key (depth 1))
|
||||||
|
; (format t "genmove depth ~a player ~a~%" depth player)
|
||||||
(if (= depth 0)
|
(if (= depth 0)
|
||||||
`( ,(score board (invert-player player)) nil)
|
`( ,(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))
|
(let ((score-board (make-instance 'ranked-board :boardsize (boardsize board) :board-def-type nil)) ;(gen-board board 0 'ranked-board))
|
||||||
|
|
|
@ -55,12 +55,14 @@
|
||||||
(play *board* (str-to-coord coord-str) player))))
|
(play *board* (str-to-coord coord-str) player))))
|
||||||
|
|
||||||
(defun do-genmove (player)
|
(defun do-genmove (player)
|
||||||
|
; (format t "do-genmove ~a~%" player)
|
||||||
(setf *player* player)
|
(setf *player* player)
|
||||||
(if (or (eql *passed* t) (eql *last-player* player))
|
(if (or (eql *passed* t) (eql *last-player* player))
|
||||||
"pass"
|
"pass"
|
||||||
(let* ((move (genmove *board* player))
|
(let* ((move (genmove *board* player))
|
||||||
(board-score (first move))
|
(board-score (first move))
|
||||||
(coord (coord-to-str (second move))))
|
(coord (coord-to-str (second move))))
|
||||||
|
;(format t "score: ~a for player ~a ~%" board-score player)
|
||||||
(if (< board-score 0)
|
(if (< board-score 0)
|
||||||
"pass"
|
"pass"
|
||||||
(progn
|
(progn
|
||||||
|
|
|
@ -3,14 +3,22 @@
|
||||||
(defclass liberty-board (basic-board)
|
(defclass liberty-board (basic-board)
|
||||||
((liberty-board
|
((liberty-board
|
||||||
:initform nil
|
: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)
|
(defun set-symetric-edge (board index stone max)
|
||||||
(let ((coords `( (0 ,index) (,index 0) (,max ,index) (,index ,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))))
|
(loop for coord in coords do (set-2d-stone (liberty-board board) coord stone))))
|
||||||
|
|
||||||
(defun set-symetric-corner (board stone max)
|
(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))))
|
(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-edge board i 3 (1- (boardsize board))))
|
||||||
(set-symetric-corner board 2 (1- (boardsize board))))
|
(set-symetric-corner board 2 (1- (boardsize board))))
|
||||||
(progn
|
(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))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
;(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)))
|
||||||
|
|
||||||
(defmacro dec-2d-stone (board coords)
|
|
||||||
`(set-2d-stone ,board ,coords (1- (get-2d-stone ,board ,coords))))
|
|
||||||
|
|
||||||
(defmethod set-stone :after ((board liberty-board) coords val)
|
(defmethod set-stone :after ((board liberty-board) coords val)
|
||||||
|
(inc-liberties board coords (get-2d-stone (liberty-board board) coords))
|
||||||
(let* ((x (first coords))
|
(let* ((x (first coords))
|
||||||
(y (second coords))
|
(y (second coords))
|
||||||
(up (1- x))
|
(up (1- x))
|
||||||
(down (1+ x))
|
(down (1+ x))
|
||||||
(left (1- y))
|
(left (1- y))
|
||||||
(right (1+ y)))
|
(right (1+ y)))
|
||||||
(if (>= up 0) (dec-2d-stone (liberty-board board) `(,up ,y)))
|
(if (>= up 0) (dec-liberty board `(,up ,y)))
|
||||||
(if (>= left 0) (dec-2d-stone (liberty-board board) `(,x ,left)))
|
(if (>= left 0) (dec-liberty board `(,x ,left)))
|
||||||
(if (< down (boardsize board)) (dec-2d-stone (liberty-board board) `(,down ,y)))
|
(if (< down (boardsize board)) (dec-liberty board `(,down ,y)))
|
||||||
(if (< right (boardsize board)) (dec-2d-stone (liberty-board board) `(,x ,right)))))
|
(if (< right (boardsize board)) (dec-liberty board `(,x ,right)))))
|
||||||
|
|
||||||
(defmethod score + ((board liberty-board) player)
|
(defmethod score + ((board liberty-board) player)
|
||||||
(let ((liberty 0))
|
; (format t "player ~a~%" player)
|
||||||
(do-over-board (coord board)
|
(if (eql player #\B)
|
||||||
(let ((stone (get-stone board coord)))
|
(- (black-liberties board) (white-liberties board))
|
||||||
(if (eql stone player)
|
(- (white-liberties board) (black-liberties board))))
|
||||||
(incf liberty (get-2d-stone (liberty-board board) coord))
|
|
||||||
(if (eql stone (invert-player player))
|
|
||||||
(decf liberty (get-2d-stone (liberty-board board) coord))))))
|
; (let ((liberty 0))
|
||||||
liberty))
|
; (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)
|
(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))))
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue