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