Browse Source

liberty shape works

master
Dan 14 years ago
parent
commit
da28f67955
  1. 5
      board.lisp
  2. 2
      env.lisp
  3. 2
      fink.lisp
  4. 5
      gobot.lisp
  5. 5
      gtp.lisp
  6. 63
      liberty-shape.lisp
  7. 3
      liberty.lisp
  8. 22
      macro-utils.lisp
  9. 18
      packages.lisp
  10. 7
      shape.lisp

5
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))

2
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"))))

2
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"))))

5
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*))

5
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)))))))

63
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
(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))))

3
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))))

22
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))

18
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

7
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))

Loading…
Cancel
Save