--- /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
--- 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
))
--- 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")))))))
--- 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")
--- /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*)
--- 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*)
--- 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* <>)
)))
--- 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))