2008-05-17 00:17:38 +02:00
|
|
|
(in-package :board)
|
|
|
|
|
|
|
|
(defun make-2d-board (size &optional (initial nil))
|
|
|
|
(let ((array (make-array size)))
|
|
|
|
(dotimes (i size)
|
|
|
|
(setf (aref array i) (make-array size :initial-element initial)))
|
|
|
|
array))
|
|
|
|
|
|
|
|
(defun copy-2d-board (board)
|
|
|
|
(let ((copy (make-array (length board))))
|
|
|
|
(dotimes (i (length board))
|
|
|
|
(setf (aref copy i) (copy-seq (aref board i))))
|
|
|
|
copy))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun filter-i-number (number)
|
|
|
|
(if (> number 8)
|
|
|
|
(1- number)
|
|
|
|
number))
|
|
|
|
|
|
|
|
(defun str-to-coord (str)
|
|
|
|
`( ,(filter-i-number (- (char-code (char (string-upcase str) 0)) 65)) ,(- (parse-integer (subseq str 1)) 1)))
|
|
|
|
|
|
|
|
(defun filter-i-char (number)
|
|
|
|
(if (>= number 8)
|
|
|
|
(1+ number)
|
|
|
|
number))
|
|
|
|
|
|
|
|
(defun coord-to-str (coord)
|
|
|
|
(concatenate 'string (string (code-char (+ 65 (filter-i-char (first coord)))))
|
|
|
|
(write-to-string (+ (second coord) 1))))
|
|
|
|
|
|
|
|
|
|
|
|
|
2008-05-21 20:46:32 +02:00
|
|
|
(defun get-2d-stone (board coord)
|
2008-05-17 00:17:38 +02:00
|
|
|
(aref (aref board (first coord)) (second coord)))
|
|
|
|
|
2008-05-21 20:46:32 +02:00
|
|
|
(defun set-2d-stone (board coord val)
|
2008-05-17 00:17:38 +02:00
|
|
|
(setf (aref (aref board (first coord)) (second coord)) val))
|
|
|
|
|
2008-05-21 20:46:32 +02:00
|
|
|
|
2008-05-17 00:17:38 +02:00
|
|
|
|
2008-05-19 06:00:04 +02:00
|
|
|
(defclass basic-board ()
|
2008-05-17 00:17:38 +02:00
|
|
|
((boardsize
|
2008-05-21 20:46:32 +02:00
|
|
|
:initarg :boardsize
|
|
|
|
:initform 19
|
2008-05-17 00:17:38 +02:00
|
|
|
:accessor boardsize)
|
|
|
|
(board-def-type
|
2008-05-21 20:46:32 +02:00
|
|
|
:initarg :board-def-type
|
2008-05-17 00:17:38 +02:00
|
|
|
:initform nil
|
|
|
|
:accessor board-def-type)
|
|
|
|
(board
|
2008-05-21 20:46:32 +02:00
|
|
|
:accessor board
|
|
|
|
:initform nil)))
|
|
|
|
|
|
|
|
|
|
|
|
(defgeneric set-stone (board coords val))
|
|
|
|
(defgeneric get-stone (board coords))
|
|
|
|
|
|
|
|
(defmethod set-stone ((board basic-board) coords val)
|
|
|
|
(set-2d-stone (board board) coords val))
|
|
|
|
|
|
|
|
(defmethod get-stone ((board basic-board) coords)
|
|
|
|
(get-2d-stone (board board) coords))
|
|
|
|
|
2008-05-17 00:17:38 +02:00
|
|
|
|
2008-05-21 20:46:32 +02:00
|
|
|
;(defgeneric (setf stone) (val coords
|
|
|
|
|
|
|
|
(defmethod initialize-instance :after ((board basic-board) &key from-board)
|
2008-05-17 00:17:38 +02:00
|
|
|
(if (eql from-board nil)
|
2008-05-21 20:46:32 +02:00
|
|
|
(setf (board board) (make-2d-board (boardsize board) (board-def-type board)))
|
2008-05-17 00:17:38 +02:00
|
|
|
(progn
|
|
|
|
(setf (boardsize board) (boardsize from-board))
|
|
|
|
(setf (board-def-type board) (board-def-type from-board))
|
2008-05-19 06:00:04 +02:00
|
|
|
(setf (board board) (copy-2d-board (board from-board))))))
|
|
|
|
|
|
|
|
|
2008-05-21 20:46:32 +02:00
|
|
|
|
|
|
|
(defmacro do-over-board ((coord board) &body body)
|
|
|
|
`(dotimes (x (boardsize ,board))
|
|
|
|
(dotimes (y (boardsize ,board))
|
|
|
|
(let ((,coord `(,x ,y)))
|
|
|
|
(progn ,@body)))))
|
|
|
|
|
|
|
|
|
|
|
|
(defmacro def-over-board (name (coord board &rest vars) &rest body)
|
|
|
|
`(defun ,name (,board ,@vars)
|
|
|
|
(do-over-board (,coord ,board)
|
|
|
|
(progn ,@body))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defgeneric prune (board prune-board)
|
|
|
|
(:documentation "board is the board we are working from, prune-board is an initially all t's board and each no go place is set to nil"))
|
|
|
|
|
|
|
|
|
|
|
|
(defmethod prune ((board basic-board) prune-board)
|
|
|
|
(prune-placed-stones board prune-board))
|
|
|
|
|
|
|
|
|
|
|
|
(def-over-board prune-placed-stones (coord board prune-board)
|
|
|
|
(if (not (eql (get-stone board coord) nil))
|
|
|
|
(set-stone prune-board coord nil)))
|
|
|
|
|
|
|
|
;(defun prune-placed-stones (board prune-board)
|
|
|
|
; (do-over-board (coord board)
|
|
|
|
; (if (not (eql (get-stone board coord) nil))
|
|
|
|
; (set-stone prune-board coord nil))))
|
|
|
|
|
|
|
|
;(defgeneric prune :after ((board liberty-board) prune-board)
|
|
|
|
; (prunce-suicide board prunce-board))
|
|
|
|
|
|
|
|
|
|
|
|
(defgeneric focus (board prune-board focus-board player)
|
|
|
|
(:documentation "prunce-board: t or nil, focus board: ranked board with scores"))
|
|
|
|
|
|
|
|
|
|
|
|
(defmethod focus ((board basic-board) prune-board focus-board player)
|
|
|
|
(do-over-board (coord prune-board)
|
|
|
|
(if (not (eql (get-stone prune-board coord) nil))
|
|
|
|
(set-stone focus-board coord 1))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
; generate a same sized board with a def type
|
|
|
|
(defmacro gen-board (board def-type)
|
|
|
|
`(make-instance 'basic-board :boardsize (boardsize ,board) :board-def-type ,def-type))
|
2008-05-19 06:00:04 +02:00
|
|
|
|
|
|
|
(defmethod genmove ((board basic-board) player)
|
2008-05-21 20:46:32 +02:00
|
|
|
(let ((prune-board (gen-board board t))
|
|
|
|
(focus-board (gen-board board nil))
|
|
|
|
(score-board (gen-board board nil)))
|
|
|
|
|
|
|
|
(prune board prune-board)))
|
|
|
|
(focus board prune-board focus-board player)
|
|
|
|
; (score board focus-board score-board player)
|
|
|
|
; (select-move score-board)))
|
2008-05-19 06:00:04 +02:00
|
|
|
|
|
|
|
|
|
|
|
|
2008-05-21 20:46:32 +02:00
|
|
|
|
|
|
|
|
|
|
|
|
2008-05-19 06:00:04 +02:00
|
|
|
;(defun make-move (board player)
|
|
|
|
; (select-move (score board player)))
|
|
|
|
|
|
|
|
;(defun score (board player)
|
|
|
|
; (let ((score-board (make-board (length board) 0)))
|
|
|
|
; (dolist (slist *score-functions*)
|
|
|
|
; (merge-score-board score-board (funcall (first slist) board player) (second slist)))
|
|
|
|
; score-board))
|
|
|
|
|
|
|
|
;(defun merge-score-board (score-board scores weight)
|
|
|
|
; (dotimes (x (length score-board))
|
|
|
|
; (dotimes (y (length score-board))
|
|
|
|
; (set-stone score-board `(,x ,y) (+ (get-stone score-board `(,x ,y)) (* weight (get-stone scores `(,x ,y))))))))
|
|
|
|
|
|
|
|
|
|
|
|
;(defun select-move (board)
|
|
|
|
; (let ((highest (get-stone board '(0 0)))
|
|
|
|
; (coords (make-array 10 :fill-pointer 0 :adjustable t)))
|
|
|
|
; (do ((x 0 (1+ x)))
|
|
|
|
; ((>= x (length board)) (aref coords (random (length coords))))
|
|
|
|
; (do ((y 0 (1+ y)))
|
|
|
|
; ((>= y (length board)))
|
|
|
|
; (let ((score (get-stone board `(,x ,y))))
|
|
|
|
; (if (> score highest)
|
|
|
|
; (progn
|
|
|
|
; (setf highest score)
|
|
|
|
; (setf coords (make-array 10 :fill-pointer 0 :adjustable t ))
|
|
|
|
; (vector-push-extend `(,x ,y) coords))
|
|
|
|
; (if (= score highest)
|
|
|
|
; (if (= (random 2) 1)
|
|
|
|
; (vector-push-extend `(,x ,y) coords)))))))))
|
|
|
|
|
|
|
|
|