60c18fdad2b8

More stat gathering
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Tue, 23 May 2017 17:44:34 +0000
parents b79af8708c02
children 50011302bb36
branches/tags (none)
files package.lisp src/players/random-zdd.lisp src/reasoners/zdd.lisp src/rule-trees.lisp src/zdd.lisp

Changes

--- 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
--- 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)
--- 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)
--- 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
-;   )
--- 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`."