# HG changeset patch # User Steve Losh # Date 1489498598 0 # Node ID 3777bd11794970c8048cf802721f899cc4b52a19 # Parent 016dd6d5f7645d0a6de7cb12c38cdf5e5ce13dbf Commit the last week of work, lol diff -r 016dd6d5f764 -r 3777bd117949 gdl/montyhall.gdl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/gdl/montyhall.gdl Tue Mar 14 13:36:38 2017 +0000 @@ -0,0 +1,78 @@ +;; GDL-II + +(role candidate) +(role random) + +(init (closed 1)) +(init (closed 2)) +(init (closed 3)) +(init (step 1)) + +(<= (legal random (hide_car ?d)) + (true (step 1)) + (true (closed ?d))) +(<= (legal random (open_door ?d)) + (true (step 2)) + (true (closed ?d)) + (not (true (car ?d))) + (not (true (chosen ?d)))) +(<= (legal random noop) + (true (step 3))) + +(<= (legal candidate (choose ?d)) + (true (step 1)) + (true (closed ?d))) +(<= (legal candidate noop) + (true (step 2))) +(<= (legal candidate switch) + (true (step 3))) +(<= (legal candidate noop) + (true (step 3))) + +(<= (sees candidate (does candidate ?m)) + (does candidate ?m)) +(<= (sees candidate (open_door ?d)) + (does random (open_door ?d))) + +(<= (next (car ?d)) + (does random (hide_car ?d))) +(<= (next (car ?d)) + (true (car ?d))) +(<= (next (closed ?d)) + (true (closed ?d)) + (not (does random (open_door ?d)))) +(<= (next (chosen ?d)) + (next_chosen ?d)) + +(<= (next_chosen ?d) + (does candidate (choose ?d))) +(<= (next_chosen ?d) + (true (chosen ?d)) + (not (does candidate switch))) +(<= (next_chosen ?d) + (does candidate switch) + (true (closed ?d)) + (not (true (chosen ?d)))) + +(<= (next (step 2)) + (true (step 1))) +(<= (next (step 3)) + (true (step 2))) +(<= (next (step 4)) + (true (step 3))) + +(<= (sees candidate (car ?d)) + (true (step 3)) + (true (car ?d)) + (next_chosen ?d)) + +(<= terminal + (true (step 4))) + +(goal random 100) +(<= (goal candidate 100) + (true (chosen ?d)) + (true (car ?d))) +(<= (goal candidate 0) + (true (chosen ?d)) + (not (true (car ?d)))) \ No newline at end of file diff -r 016dd6d5f764 -r 3777bd117949 package.lisp --- a/package.lisp Mon Mar 06 13:40:27 2017 +0000 +++ b/package.lisp Tue Mar 14 13:36:38 2017 +0000 @@ -54,7 +54,7 @@ :zdd-empty-p :zdd-unit-p :zdd-count - :zdd-size + :zdd-node-count :zdd-random-member :zdd-set :zdd-union @@ -138,6 +138,9 @@ :apply-happens :apply-possible :sprout + :dump-iset + :legal-moves-for + :goal-values-for ) ) @@ -190,6 +193,8 @@ :losh :iterate :scully.quickutils + :scully.gdl + :scully.grounders.fluxplayer :scully.reasoners.zdd) (:export )) diff -r 016dd6d5f764 -r 3777bd117949 scully.asd --- a/scully.asd Mon Mar 06 13:40:27 2017 +0000 +++ b/scully.asd Tue Mar 14 13:36:38 2017 +0000 @@ -43,5 +43,6 @@ :components ((:file "fluxplayer"))) (:module "players" :serial t :components ((:file "random") - (:file "random-ii"))))))) + (:file "random-ii") + (:file "random-zdd"))))))) diff -r 016dd6d5f764 -r 3777bd117949 src/grounders/fluxplayer.lisp --- a/src/grounders/fluxplayer.lisp Mon Mar 06 13:40:27 2017 +0000 +++ b/src/grounders/fluxplayer.lisp Tue Mar 14 13:36:38 2017 +0000 @@ -155,6 +155,6 @@ ; (dump-grounded "8puzzle") ; (dump-grounded "tictactoe") -(dump-grounded "pennies") +(dump-grounded "montyhall") ;; (dump-grounded "meier") diff -r 016dd6d5f764 -r 3777bd117949 src/players/random-zdd.lisp --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/players/random-zdd.lisp Tue Mar 14 13:36:38 2017 +0000 @@ -0,0 +1,71 @@ +(in-package :scully.players.random-zdd) + + +;;;; Random Incomplete-Information Player ------------------------------------- +(defclass random-zdd-player (ggp:ggp-player) + ((role :type symbol :accessor rp-role) + (reasoner :accessor rp-reasoner) + (information-set :accessor rp-iset))) + +(define-with-macro (random-zdd-player :conc-name rp) + role reasoner iset) + + +(defmethod ggp:player-start-game ((player random-zdd-player) rules role timeout) + (scully.zdd::with-zdd + (let* ((grounded-rules (-<> rules + (with-output-to-string (s) + (dump-gdl <> s)) + (ground-gdl-string <>))) + (reasoner (make-zdd-reasoner grounded-rules))) + (pr "GROUNDED:") + (pr grounded-rules) + (pr '------------------------------------) + (setf (rp-role player) role + (rp-reasoner player) reasoner) + t))) + +(defmethod ggp:player-stop-game ((player random-zdd-player)) + (scully.zdd::with-zdd + (with-random-zdd-player (player) + (setf role nil + reasoner nil + iset nil)))) + +(defmethod ggp:player-update-game-ii ((player random-zdd-player) move percepts) + (scully.zdd::with-zdd + (with-random-zdd-player (player) + (setf iset + (if move + (-<> iset + (sprout reasoner <>) + (apply-happens reasoner <>) + (filter-iset-for-move reasoner <> role move) + (filter-iset-for-percepts reasoner <> role percepts) + (compute-next-iset reasoner <>) + (apply-possible reasoner <>)) + (apply-possible reasoner (initial-iset reasoner))))))) + +(defmethod ggp:player-select-move ((player random-zdd-player) timeout) + (scully.zdd::with-zdd + (format t "Selecting move...~%") + (with-random-zdd-player (player) + (format t "CURRENT ISET:~%") + (dump-iset reasoner iset) + (format t "Information set size: ~D states, ~D ZDD nodes~%" + (scully.zdd:zdd-count iset) + (scully.zdd:zdd-node-count iset)) + (format t "LEGAL MOVES:~%") + (pr (legal-moves-for reasoner iset role)) + (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)) + +;; (ggp:start-player *player* :server :hunchentoot :use-thread t) +;; (ggp:kill-player *player*) diff -r 016dd6d5f764 -r 3777bd117949 src/players/random.lisp --- a/src/players/random.lisp Mon Mar 06 13:40:27 2017 +0000 +++ b/src/players/random.lisp Tue Mar 14 13:36:38 2017 +0000 @@ -13,7 +13,7 @@ (defmethod ggp:player-start-game ((player random-player) rules role timeout) (let ((reasoner (make-prolog-reasoner))) - (load-rules reasoner (-> rules + (load-rules reasoner (-<> rules scully.gdl:dump-gdl scully.grounders.fluxplayer:ground-gdl-string)) (setf (rp-role player) role @@ -42,5 +42,5 @@ :name "Scully-Random" :port 5001)) -; (ggp:start-player *random-player* :server :hunchentoot) -; (ggp:kill-player *random-player*) +;; (ggp:start-player *random-player* :server :hunchentoot) +;; (ggp:kill-player *random-player*) diff -r 016dd6d5f764 -r 3777bd117949 src/reasoners/zdd.lisp --- a/src/reasoners/zdd.lisp Mon Mar 06 13:40:27 2017 +0000 +++ b/src/reasoners/zdd.lisp Tue Mar 14 13:36:38 2017 +0000 @@ -271,7 +271,7 @@ (map-tree (curry #'number-to-term reasoner) contents)))) (defun dump-iset (reasoner iset) - (iterate (for i :from 0) + (iterate (for i :from 1) (for state :in (iset-to-list reasoner iset)) (let ((*package* (find-package :ggp-rules))) (format t "STATE ~D:~%~{ ~S~%~}~2%" i state))) @@ -316,8 +316,10 @@ (defun filter-iset-for-percepts (reasoner iset role percepts) - (let ((universe (gethash role (zr-percept-universes reasoner))) - (percepts (mapcar (curry #'term-to-number reasoner) percepts))) + (let* ((universe (gethash role (zr-percept-universes reasoner))) + (full-percepts (iterate (for p :in percepts) + (collect `(ggp-rules::sees ,role ,p)))) + (percepts (mapcar (curry #'term-to-number reasoner) full-percepts))) (zdd-match iset percepts universe))) (defun filter-iset-for-move (reasoner iset role move) @@ -565,18 +567,7 @@ ;;;; Scratch ------------------------------------------------------------------ (defparameter *rules* (scully.gdl::read-gdl "gdl/meier-grounded.gdl")) (defparameter *rules* (scully.gdl::read-gdl "gdl/pennies-grounded.gdl")) - -; (-<> *rules* -; (scully.gdl::normalize-rules <>) -; (scully.terms::integerize-rules <>) -; ; (nth 2 <>) -; ; (make-rule-forest <>) -; ; (scully.terms::print-strata <>) -; ; (no <>) -; ; (rest <>) -; ; (map nil #'print-hash-table <>) -; ) - +(defparameter *rules* (scully.gdl::read-gdl "gdl/montyhall-grounded.gdl")) (defparameter *r* nil) (defparameter *r* (make-zdd-reasoner *rules*)) @@ -590,34 +581,17 @@ (apply-possible *r* <>) (sprout *r* <>) (apply-happens *r* <>) + (filter-iset-for-move + *r* <> + 'ggp-rules::candidate + '(ggp-rules::choose 3)) (filter-iset-for-percepts *r* <> - 'ggp-rules::alice - '((ggp-rules::sees ggp-rules::alice (ggp-rules::coins ggp-rules::unset)))) - (filter-iset-for-move - *r* <> - 'ggp-rules::alice - 'ggp-rules::noop) + 'ggp-rules::candidate + '((ggp-rules::does ggp-rules::candidate (ggp-rules::choose 3)))) (compute-next-iset *r* <>) - (apply-possible *r* <>) - (sprout *r* <>) - (apply-happens *r* <>) - (filter-iset-for-move - *r* <> - 'ggp-rules::alice - '(ggp-rules::play ggp-rules::tails)) - (filter-iset-for-percepts - *r* <> - 'ggp-rules::alice - '((ggp-rules::sees ggp-rules::alice (ggp-rules::coins ggp-rules::heads)))) - (compute-next-iset *r* <>) - - (apply-possible *r* <>) - - (pr (goal-values-for *r* <> 'ggp-rules::alice)) - - ;; (dump-iset *r* <>) + (dump-iset *r* <>) (no <>) ; (draw-zdd *r* <>) ))) diff -r 016dd6d5f764 -r 3777bd117949 src/zdd.lisp --- a/src/zdd.lisp Mon Mar 06 13:40:27 2017 +0000 +++ b/src/zdd.lisp Tue Mar 14 13:36:38 2017 +0000 @@ -57,7 +57,7 @@ ((node _ hi lo) (+ (zdd-count hi) (zdd-count lo))))) -(defun zdd-size (zdd) +(defun zdd-node-count (zdd) "Return the number of unique nodes in `zdd`." (let ((seen (make-hash-table :test 'eq))) (recursively ((zdd zdd))