# HG changeset patch # User Steve Losh # Date 1495561474 0 # Node ID 60c18fdad2b848629e34f29e9c2626e164acbe1b # Parent b79af8708c020c92b7535d623577c784d348d169 More stat gathering diff -r b79af8708c02 -r 60c18fdad2b8 package.lisp --- a/package.lisp Sat May 20 11:24:54 2017 +0000 +++ b/package.lisp Tue May 23 17:44:34 2017 +0000 @@ -56,6 +56,7 @@ :zdd-count :zdd-node-count :zdd-random-member + :zdd-arbitrary-member :zdd-set :zdd-union :zdd-intersection diff -r b79af8708c02 -r 60c18fdad2b8 src/players/random-zdd.lisp --- a/src/players/random-zdd.lisp Sat May 20 11:24:54 2017 +0000 +++ b/src/players/random-zdd.lisp Tue May 23 17:44:34 2017 +0000 @@ -1,10 +1,17 @@ (in-package :scully.players.random-zdd) (defvar *data-file* nil) -(defparameter *current-game* 'mastermind448) +(defparameter *current-game* 'stratego) ;;;; Random Incomplete-Information Player ------------------------------------- +(defun move< (a b) + (string< (structural-string a) + (structural-string b))) + +(defun sort-moves (moves) + (sort (copy-seq moves) #'move<)) + (defclass random-zdd-player (ggp:ggp-player) ((role :type symbol :accessor rp-role) (reasoner :accessor rp-reasoner) @@ -46,6 +53,12 @@ (defun information-set-objects (iset) (apply #'+ (mapcar #'length iset))) +(defun debug-log (obj &rest args) + (apply #'format t args) + (fresh-line) + (finish-output) + obj) + (defmethod ggp:player-update-game-ii ((player random-zdd-player) move percepts) (incf (rp-turn player)) (format t "~2%=====================================~%") @@ -57,44 +70,39 @@ (object-size 0)) (scully.zdd::with-zdd (with-random-zdd-player (player) + (format t "Computing next information set...~%") (setf iset (if move (-<> iset - (progn - (setf state-count (scully.zdd:zdd-count <>) - node-count (scully.zdd:zdd-node-count <>) - object-size (information-set-objects (scully.zdd::zdd-enumerate <>))) - (format t "Information set size: ~D states, ~D ZDD nodes~%" - state-count node-count) - (format t " Iset cons size: ~D things~%" object-size) - <>) - ;; (progn (dump-iset reasoner <>) - ;; (finish-output) - ;; <>) + (debug-log <> " Sprouting...") (sprout reasoner <> (rp-role player) move) ;; (progn (format t "After sprouting size: ~D states~%" ;; (scully.zdd:zdd-count <>)) ;; <>) - (apply-happens reasoner <>) - (progn - (setf max-node-count (scully.zdd:zdd-node-count <>)) - (format t " Max size: ~D ZDD nodes~%" max-node-count) - <>) + (debug-log <> " Happens...") + ;; (let ((*trace-output* *standard-output*)) + ;; (start-profiling :mode :alloc) + ;; (prog1 (time (apply-happens reasoner <>)) + ;; (stop-profiling) + ;; (break))) + (let ((*trace-output* *standard-output*)) + (time (apply-happens reasoner <>))) + (progn (setf max-node-count (scully.zdd:zdd-node-count <>)) + <>) + (debug-log <> " Filtering percepts...") (filter-iset-for-percepts reasoner <> role percepts) - ;; (progn (format t "After filtering size: ~D states~%" - ;; (scully.zdd:zdd-count <>)) - ;; <>) + (debug-log <> " Computing next...") (compute-next-iset reasoner <>) - ;; (progn (dump-iset reasoner <>) - ;; <>) - (apply-possible reasoner <>)) - (-<> (initial-iset reasoner) - (progn (setf state-count 1 - node-count (scully.zdd:zdd-node-count <>) - max-node-count 0 - object-size (information-set-objects (scully.zdd::zdd-enumerate <>))) - <>) - (apply-possible reasoner <>)))) + ;; (progn (dump-iset reasoner <>) <>) + ) + (initial-iset reasoner))) + (debug-log iset " Counting nodes...") + (setf state-count (scully.zdd:zdd-count iset) + node-count (scully.zdd:zdd-node-count iset) + object-size (information-set-objects (scully.zdd::zdd-enumerate iset))) + (format t "Information set size: ~D states, ~D ZDD nodes~%" state-count node-count) + (format t " Iset cons size: ~D conses~%" object-size) + (format t " Max iset size: ~D ZDD nodes~%" max-node-count) (format *data-file* "~A,~D,~D,~D,~D,~D,~D~%" *current-game* game @@ -108,19 +116,26 @@ (scully.zdd::with-zdd (format t "Selecting move...~%") (with-random-zdd-player (player) + (debug-log iset " Applying possible...") + (setf iset (apply-possible reasoner iset)) + (debug-log iset " Calculating moves...") ;; (format t "CURRENT ISET:~%") ;; (dump-iset reasoner iset) ;; (format t "LEGAL MOVES:~%") ;; (pr (legal-moves-for reasoner iset role)) - (pr (random-elt (legal-moves-for reasoner iset role)))))) + (pr (first (sort-moves (legal-moves-for reasoner iset role))))))) ;;;; Run ---------------------------------------------------------------------- (setf hunchentoot:*default-connection-timeout* nil) ; its_fine (defvar *player* (make-instance 'random-zdd-player - :name "Scully-Random-ZDD" - :port 5003)) + :name "Scully-Random-ZDD" + :port 5003)) + +(setf *current-game* 'mastermind448) +(setf scully.terms::*shuffle-variables* t) ;; (ggp:start-player *player* :server :hunchentoot :use-thread t) ;; (ggp:kill-player *player*) +;; (sb-ext:gc :full t) diff -r b79af8708c02 -r 60c18fdad2b8 src/reasoners/zdd.lisp --- a/src/reasoners/zdd.lisp Sat May 20 11:24:54 2017 +0000 +++ b/src/reasoners/zdd.lisp Tue May 23 17:44:34 2017 +0000 @@ -314,10 +314,6 @@ "Return the initial information set of the game." (zr-initial-zdd reasoner)) -(defun rand-state (reasoner iset) - "Select a random member of the given information set." - (mapcar (curry #'number-to-term reasoner) - (zdd-random-member iset))) (defun terminalp (reasoner iset) "Return whether the given information set is a terminal state." @@ -329,7 +325,7 @@ (defun legal-moves-for (reasoner iset role) (-<> iset (zdd-meet <> (gethash role (zr-legal-zdds reasoner))) - zdd-random-member + zdd-arbitrary-member (mapcar (curry #'number-to-term reasoner) <>) (mapcar #'third <>))) @@ -635,7 +631,7 @@ (end (get-internal-real-time)) (elapsed (/ (- end start) internal-time-units-per-second)) (sizes (reasoner-rule-tree-sizes r))) - (format t "~A,~D,~A,~D,~D,~,2F~%" + (format t "~A ~D ~A ~D ~D ~,2F~%" game-name scully.gdl::*max-rule-size* scully.terms::*shuffle-variables* @@ -644,8 +640,13 @@ elapsed) (values))) +(defun test-all () + (iterate (for game :in '(montyhall meier mastermind448 transit vis_pacman3p latenttictactoe stratego)) + (run-test game 8 nil) + (iterate (repeat 10) + (run-test game 8 t)))) -;; (run-test 'pennies 8 nil) +;; (test-all) ;; (iterate ;; (repeat 10) diff -r b79af8708c02 -r 60c18fdad2b8 src/rule-trees.lisp --- a/src/rule-trees.lisp Sat May 20 11:24:54 2017 +0000 +++ b/src/rule-trees.lisp Tue May 23 17:44:34 2017 +0000 @@ -105,18 +105,3 @@ ;;;; Scratch ------------------------------------------------------------------ -(defparameter *rule* '( - (500 1 2 (ggp-rules::not 3)) - (500 4 2 3 15) - (500 (ggp-rules::not 19) 18) - (500 19 17) - )) - -; (-<> *rule* -; make-rule-tree -; (rule-tree-hi <>) -; (rule-tree-hi <>) -; ; (advance-tree <> 6) -; scully.graphviz::draw-rule-tree -; ; scully.graphviz::draw-rule-tree -; ) diff -r b79af8708c02 -r 60c18fdad2b8 src/zdd.lisp --- a/src/zdd.lisp Sat May 20 11:24:54 2017 +0000 +++ b/src/zdd.lisp Tue May 23 17:44:34 2017 +0000 @@ -20,6 +20,9 @@ (defparameter *cache* (tg:make-weak-hash-table :weakness :value :test #'equalp)) +(defparameter *count-cache* + (tg:make-weak-hash-table :weakness :key :test #'eq)) + (defmacro with-zdd (&body body) "Execute `body` with the ZDD settings properly initialized." `(with-odd-context (:operation #'zdd-apply :node-cache *cache*) @@ -50,11 +53,13 @@ (defun zdd-count (zdd) "Return the number of members of `zdd`." - (ematch zdd - ((sink nil) 0) - ((sink t) 1) - ((node _ hi lo) (+ (zdd-count hi) - (zdd-count lo))))) + (ensure-gethash + zdd *count-cache* + (ematch zdd + ((sink nil) 0) + ((sink t) 1) + ((node _ hi lo) (+ (zdd-count hi) + (zdd-count lo)))))) (defun zdd-node-count (zdd) "Return the number of unique nodes in `zdd`." @@ -89,6 +94,14 @@ (zdd-random-member lo) (cons var (zdd-random-member hi))))))) +(defun zdd-arbitrary-member (zdd) + "Select an arbitraty member of `zdd`." + (ematch zdd + ((sink nil) (error "No elements to choose from!")) + ((sink t) '()) + ((node var hi _) + (cons var (zdd-arbitrary-member hi))))) + (defun unit-patch (zdd) "Ensure the empty set is a member of `zdd`."