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