# HG changeset patch # User Steve Losh # Date 1495214911 0 # Node ID 47c967fea4c735c35dffe174a98f759a6f43c578 # Parent fd5861c11c5f8b7b4f90dd7692c5ab103639892e Explicitly error on grounding problems, clean up stat dumps diff -r fd5861c11c5f -r 47c967fea4c7 src/grounders/fluxplayer.lisp --- a/src/grounders/fluxplayer.lisp Wed May 17 13:36:59 2017 +0000 +++ b/src/grounders/fluxplayer.lisp Fri May 19 17:28:31 2017 +0000 @@ -146,6 +146,7 @@ ;; (dump-grounded "buttons") +;; (dump-grounded "pennies") ;; (dump-grounded "8puzzle") ;; (dump-grounded "tictactoe") ;; (dump-grounded "stratego") diff -r fd5861c11c5f -r 47c967fea4c7 src/players/random-zdd.lisp --- a/src/players/random-zdd.lisp Wed May 17 13:36:59 2017 +0000 +++ b/src/players/random-zdd.lisp Fri May 19 17:28:31 2017 +0000 @@ -1,6 +1,7 @@ (in-package :scully.players.random-zdd) (defvar *data-file* nil) +(defparameter *current-game* 'pennies) ;;;; Random Incomplete-Information Player ------------------------------------- @@ -23,6 +24,8 @@ (dump-gdl <> s)) (ground-gdl-string <>))) (reasoner (make-zdd-reasoner grounded-rules))) + (when (null grounded-rules) + (error "Could not ground rules. Are they valid GDL?")) (setf (rp-role player) role (rp-turn player) 0 (rp-reasoner player) reasoner) @@ -46,43 +49,57 @@ (format t "~2%=====================================~%") (pr percepts) - (let ((max-size 0)) + (let ((state-count 0) + (node-count 0) + (max-node-count 0) + (object-size 0)) (scully.zdd::with-zdd (with-random-zdd-player (player) (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~%" - (scully.zdd:zdd-count <>) - (scully.zdd:zdd-node-count <>)) - (format t " Iset cons size: ~D things~%" - (information-set-objects (scully.zdd::zdd-enumerate <>))) + state-count node-count) + (format t " Iset cons size: ~D things~%" object-size) <>) + ;; (progn (dump-iset reasoner <>) + ;; (finish-output) + ;; <>) (sprout reasoner <> (rp-role player) move) - (progn (format t "After sprouting size: ~D states~%" - (scully.zdd:zdd-count <>)) - <>) + ;; (progn (format t "After sprouting size: ~D states~%" + ;; (scully.zdd:zdd-count <>)) + ;; <>) (apply-happens reasoner <>) (progn - (setf max-size (scully.zdd:zdd-node-count <>)) - (format t " Max size: ~D ZDD nodes~%" max-size) + (setf max-node-count (scully.zdd:zdd-node-count <>)) + (format t " Max size: ~D ZDD nodes~%" max-node-count) <>) (filter-iset-for-percepts reasoner <> role percepts) - (progn (format t "After filtering size: ~D states~%" - (scully.zdd:zdd-count <>)) - <>) + ;; (progn (format t "After filtering size: ~D states~%" + ;; (scully.zdd:zdd-count <>)) + ;; <>) (compute-next-iset reasoner <>) ;; (progn (dump-iset reasoner <>) ;; <>) (apply-possible reasoner <>)) - (apply-possible reasoner (initial-iset reasoner)))) - (let ((object-size (information-set-objects (scully.zdd::zdd-enumerate iset)))) - (format *data-file* "~D,~D,~D,~D,~D~%" turn - (scully.zdd:zdd-count iset) - (scully.zdd:zdd-node-count iset) - max-size - object-size)))))) + (-<> (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 <>)))) + (format *data-file* "~A,~D,~D,~D,~D,~D~%" + *current-game* + turn + state-count + node-count + max-node-count + object-size))))) (defmethod ggp:player-select-move ((player random-zdd-player) timeout) (scully.zdd::with-zdd @@ -92,15 +109,15 @@ ;; (dump-iset reasoner iset) ;; (format t "LEGAL MOVES:~%") ;; (pr (legal-moves-for reasoner iset role)) - (random-elt (legal-moves-for reasoner iset role))))) + (pr (random-elt (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)) ;; (ggp:start-player *player* :server :hunchentoot :use-thread t) ;; (ggp:kill-player *player*) diff -r fd5861c11c5f -r 47c967fea4c7 src/zdd.lisp --- a/src/zdd.lisp Wed May 17 13:36:59 2017 +0000 +++ b/src/zdd.lisp Fri May 19 17:28:31 2017 +0000 @@ -270,55 +270,6 @@ ((sink nil) (sink nil)) ;; If Z = {∅}, the only set ∅ can match is the empty set. - ((sink t) (if set - (sink nil) - (sink t))) - - ;; Otherwise Z is a real node. - ((node var hi lo) - (cond - ;; If we're below the lower bound of the universe, just recur down. - ((< var lower-bound) (zdd-node var - (recur hi set) - (recur lo set))) - - ;; If we're above the upper bound of the universe, we're never gonna - ;; see anything more we might need to match. - ;; - ;; If our target set is empty, that's perfect. But if it's NOT empty, - ;; we're never gonna satisfy it. - ((> var upper-bound) (if set - (sink nil) - zdd)) - - ;; Otherwise Z's var is within the universe. - (t (ematch set - ;; If our target is empty, only the lo branch of Z can possibly - ;; match. - (nil (recur lo set)) - - ;; Otherwise we've got a target element. Almost there! - ((list* element remaining) - (cond - ;; If we're below the target element, we recur down the lo - ;; branch because the hi branch contains something unwanted. - ((< var element) (recur lo set)) - ;; If we're above the target element, we can never match. - ((> var element) (sink nil)) - ;; Otherwise, we recur down the hi branch with the rest of our - ;; target (the lo branch is always missing this element). - ((= var element) (zdd-node var - (recur hi remaining) - ; jeeeeeeeesus - (sink nil)))))))))))) - -(defun zdd-match% (zdd set universe) - (recursively ((zdd zdd) (set set)) - (ematch zdd - ;; If Z = ∅, there are no candidates for matching. - ((sink nil) (sink nil)) - - ;; If Z = {∅}, the only set ∅ can match is the empty set. ((sink t) (if (null set) (sink t) (sink nil))) @@ -368,8 +319,3 @@ ;;;; Scratch ------------------------------------------------------------------ -(defun test () - (with-zdd - (let ((z (zdd-set '(2 3 4 5 8)))) - (zdd-enumerate z) - )))