diff --git a/board.lisp b/board.lisp index 200a4f3..d6a2375 100644 --- a/board.lisp +++ b/board.lisp @@ -56,7 +56,10 @@ (defun get-2d-stone (board coord) - (aref (aref board (first coord)) (second coord))) + (if (not (listp coord)) + (progn + (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)) diff --git a/env.lisp b/env.lisp index 0b69861..6466e15 100644 --- a/env.lisp +++ b/env.lisp @@ -12,7 +12,7 @@ (defparameter *src-root* "/home/dan/src/my/gobot/") -(defparameter *src-files* '("packages" "macro-utils" "netpipe" "board" "liberty" "shape" "gobot" "gtp" "fink")) +(defparameter *src-files* '("packages" "macro-utils" "netpipe" "board" "liberty" "shape" "liberty-shape" "gobot" "gtp" "fink")) (defun recompile () (loop for file in *src-files* do (compile-file (concatenate 'string *src-root* file ".lisp")))) diff --git a/fink.lisp b/fink.lisp index 0cea935..1228c08 100644 --- a/fink.lisp +++ b/fink.lisp @@ -2,7 +2,7 @@ (defparameter *src-root* "/home/dan/src/my/gobot/") -(defparameter *src-files* '("packages" "macro-utils" "netpipe" "board" "liberty" "shape" "gobot" "gtp")) +(defparameter *src-files* '("packages" "macro-utils" "netpipe" "board" "liberty" "shape" "liberty-shape" "gobot" "gtp")) (defun load-files () (loop for file in *src-files* do (load (concatenate 'string *src-root* file ".fasl")))) diff --git a/gobot.lisp b/gobot.lisp index 01e1c74..9610510 100644 --- a/gobot.lisp +++ b/gobot.lisp @@ -16,7 +16,7 @@ (defparameter *player* nil) (defparameter *last-player* nil) -(defclass composite-board (shape-board) +(defclass composite-board (liberty-shape-board) ((final :initform 0))) @@ -78,3 +78,6 @@ (defun analyze-shapes () (shapes-to-analyze *board*)) + +(defun analyze-shape-liberties () + (liberty-shape-to-analyze *board*)) diff --git a/gtp.lisp b/gtp.lisp index 7442b1e..d7539fa 100644 --- a/gtp.lisp +++ b/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/Scores/scores")) +(defparameter *analyze_commands* '("gfx/Liberties/liberties" "gfx/Shapes/shapes" "gfx/Shape-Liberties/shape-liberties")) @@ -89,7 +89,8 @@ (game_score (format t "Score for ~c: ~s~%" go-bot:*player* (string-trim (string #\newline) (second commands))) "") (liberties (string-trim #(#\newline) (analyze-liberty))) (shapes (string-trim #(#\newline) (analyze-shapes))) - (scores (string-trim #(#\newline)(analyze-score))) + (shape-liberties (string-trim #(#\newline) (analyze-shape-liberties))) + ;(scores (string-trim #(#\newline)(analyze-score))) (quit (setf *quit?* t) "") (otherwise (concatenate 'string "? unknown command: " (string-downcase (first commands))))))) \ No newline at end of file diff --git a/liberty-shape.lisp b/liberty-shape.lisp index 4373309..5464444 100644 --- a/liberty-shape.lisp +++ b/liberty-shape.lisp @@ -2,7 +2,10 @@ (defclass liberty-shape-board (liberty-board shape-board) ((shapes-liberties - :accessor shapes-liberties) + :initform nil + :accessor shapes-liberties) + ; stores lists (shape-liberties shape-libertirs-score + (black-shape-liberties :initform 0 :accessor black-shape-liberties) @@ -13,17 +16,59 @@ (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-liberties board) (make-array 1 :fill-pointer 0 :adjustable t))) (progn (setf (shapes-liberties board) (copy-array (shapes-liberties from-board))) (copy-slots (white-shape-liberties black-shape-liberties) 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-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))) +; (format t "sid @ ~a = ~a~%" sid coords) + (inc-player-shape-liberty board player (- old-score)) + (loop for index from 0 to (1- (length (aref (shapes-points board) sid))) do + (incf liberties (liberty board (aref (aref (shapes-points board) sid) index)))) + (let ((score (* liberties (size-of-shape board sid)))) + (setf (aref (shapes-liberties board) sid) `(,liberties ,score)) + (inc-player-shape-liberty board player score)))) + + (defmethod set-stone :after ((board liberty-shape-board) coords val) - (if (eql (shape-id board coords) (next-shape-id board)) - ; new shape - (vector-push-extend (liberties-of-shape board (next-shape-id board)) (shapes-liberties board)) - ;old shape - ()) - ;adjust neighebors \ No newline at end of file + (while (not (eql (length (shapes-liberties board)) (next-shape-id board))) + (vector-push-extend '(0 0) (shapes-liberties board))) ; new shape + (calculate-shape-liberties board coords val) + ;adjust neighebors + (let ((sid (shape-id board coords))) + (do-over-adjacent (coords-var board coords) + (let ((adj-sid (shape-id board coords-var))) + (if (not (or (eql adj-sid sid) (eql adj-sid nil))) + (calculate-shape-liberties board coords-var (get-stone board coords-var))))))) + +(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 (second (aref (shapes-liberties board) (shape-id board coords)))))) + (concatenate 'string (board-to-analyze lsb) + '(#\newline) " TEXT blakc shape liberties: " (write-to-string (black-shape-liberties board)) + " white shape liberties: " (write-to-string (white-shape-liberties board))))) + +(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)))) \ No newline at end of file diff --git a/liberty.lisp b/liberty.lisp index a279367..4e2007b 100644 --- a/liberty.lisp +++ b/liberty.lisp @@ -13,6 +13,9 @@ :initarg white-liberties :accessor white-liberties))) +(defmacro liberty (board coords) + `(get-2d-stone (liberty-board ,board) ,coords)) + (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)))) diff --git a/macro-utils.lisp b/macro-utils.lisp index f09a69b..180dbbf 100644 --- a/macro-utils.lisp +++ b/macro-utils.lisp @@ -1,5 +1,27 @@ (in-package macro-utils) +(defun test-while (n) + (let ((i 0)) + (while (< i n) + (format t "~a~%" i) + (incf i)))) + +(defun test-until (n) + (let ((i 0)) + (until (= i n) + (format t "~a~%" i) + (incf i)))) + +(defmacro while (test-case &body body) + `(do () + ((not ,test-case) t) + ,@body)) + +(defmacro until (test-case &body body) + `(do () + (,test-case t) + ,@body)) + (defmacro with-gensyms ((&rest names) &body body) `(let ,(loop for n in names collect `(,n (gensym))) ,@body)) diff --git a/packages.lisp b/packages.lisp index b8eaa04..779ac34 100644 --- a/packages.lisp +++ b/packages.lisp @@ -7,7 +7,9 @@ (defpackage macro-utils (:use :common-lisp) (:export :with-gensyms - :once-only)) + :once-only + :while + :until)) (defpackage netpipe (:use :common-lisp) @@ -54,7 +56,8 @@ :macro-utils :board) (:export :liberty-board - :liberty-to-analyze)) + :liberty-to-analyze + :liberty)) (defpackage shape-board (:use :common-lisp @@ -62,7 +65,12 @@ :board) (:export :shape-board :shapes-to-analyze - :shape-id)) + :shape-id + :shapes-points + :shape-sizes + :next-shape-id + :convert-shape + :size-of-shape)) (defpackage liberty-shape-board (:use :common-lisp @@ -78,7 +86,8 @@ (:use :common-lisp :board :liberty-board - :shape-board) + :shape-board + :liberty-shape-board) (:export :*name* :*version* :*author* @@ -94,6 +103,7 @@ :analyze-score :analyze-liberty :analyze-shapes + :analyze-shape-liberties )) (defpackage gtp-handler diff --git a/shape.lisp b/shape.lisp index c4be337..fa53287 100644 --- a/shape.lisp +++ b/shape.lisp @@ -44,15 +44,18 @@ (defmacro size-of-shape (board shape-id) `(aref (shape-sizes ,board) ,shape-id)) -(defun convert-shape (board shape-id to-id) +(defgeneric convert-shape (board shape-id to-id)) + +(defmethod convert-shape ((board shape-board) shape-id to-id) ; (format t "convert-shape ~a to ~a~%" shape-id to-id) (loop for index from 0 to (1- (length (aref (shapes-points board) shape-id))) do (add-to-shape board (aref (aref (shapes-points board) shape-id) index ) to-id)) (setf (aref (shapes-points board) shape-id) (make-array 1 :fill-pointer 0 :adjustable t)) (setf (aref (shape-sizes board) shape-id) 0)) +(defgeneric join-shapes (board nexus shapes-list)) -(defun join-shapes (board nexus shapes-list) +(defmethod join-shapes ((board shape-board) nexus shapes-list) (let ((biggest-shape (first shapes-list))) (loop for shape-id in shapes-list do (if (> (size-of-shape board shape-id) (size-of-shape board biggest-shape))