4c2306e08ed1

A few more tweaks
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Mon, 15 May 2017 12:22:50 +0000
parents a3e8fc8cad53
children 374014ff34a9
branches/tags (none)
files src/graphviz.lisp src/players/random-ii.lisp src/players/random-zdd.lisp src/reasoners/zdd.lisp

Changes

--- a/src/graphviz.lisp	Tue May 09 12:37:41 2017 +0000
+++ b/src/graphviz.lisp	Mon May 15 12:22:50 2017 +0000
@@ -42,7 +42,8 @@
                        (label-fn #'identity))
   (let ((*rt-label-fn* label-fn))
     (cl-dot:dot-graph
-      (cl-dot:generate-graph-from-roots 'rule-tree (list rule-tree))
+      (cl-dot:generate-graph-from-roots 'rule-tree (list rule-tree)
+                                        '(:dpi 300))
       filename
       :format :png))
   rule-tree)
--- a/src/players/random-ii.lisp	Tue May 09 12:37:41 2017 +0000
+++ b/src/players/random-ii.lisp	Mon May 15 12:22:50 2017 +0000
@@ -56,17 +56,28 @@
         (rp-information-set player) nil))
 
 (defmethod ggp:player-update-game-ii ((player random-ii-player) move percepts)
+  (format t "~2%=====================================~%")
   (when move
     (setf (rp-information-set player)
           (get-next-information-set player move percepts))))
 
+(defun information-set-objects (iset)
+  (let ((seen (make-hash-table)))
+    (recursively ((iset iset))
+      (etypecase iset
+        ((or integer symbol) (if (nth-value 1 (ensure-gethash iset seen))
+                               0
+                               1))
+        (cons (+ 1
+                 (recur (car iset))
+                 (recur (cdr iset))))))))
+
 (defmethod ggp:player-select-move ((player random-ii-player) timeout)
+  (format t "Selecting move...~%")
   (with-random-ii-player (player)
     (format t "Information set size: ~D~%" (length information-set))
-    ; (let ((*package* (find-package :ggp-rules)))
-    ;   (iterate (for state :in information-set)
-    ;            (format t "    ~S~%" state)))
-    (format t "Selecting move...~%")
+    (format t "Information set object count ~D~%"
+            (information-set-objects information-set))
     (random-elt (legal-moves-for reasoner role (first information-set)))))
 
 
@@ -77,5 +88,5 @@
                                 :name "Scully-Random-II"
                                 :port 5002))
 
-; (ggp:start-player *player* :server :hunchentoot :use-thread t)
-; (ggp:kill-player *player*)
+;; (ggp:start-player *player* :server :hunchentoot :use-thread t)
+;; (ggp:kill-player *player*)
--- a/src/players/random-zdd.lisp	Tue May 09 12:37:41 2017 +0000
+++ b/src/players/random-zdd.lisp	Mon May 15 12:22:50 2017 +0000
@@ -30,14 +30,22 @@
             iset nil))))
 
 (defmethod ggp:player-update-game-ii ((player random-zdd-player) move percepts)
+  (format t "~2%=====================================~%")
   (scully.zdd::with-zdd
     (with-random-zdd-player (player)
       (setf iset
             (if move
               (-<> iset
-                (sprout reasoner <>)
+                (progn (format t "Information set size: ~D states, ~D ZDD nodes~%"
+                               (scully.zdd:zdd-count <>)
+                               (scully.zdd:zdd-node-count <>))
+                       <>)
+                (sprout reasoner <> (rp-role player) move)
                 (apply-happens reasoner <>)
-                (filter-iset-for-move reasoner <> role move)
+                (progn
+                  (format t "        Max size: ~D ZDD nodes~%"
+                          (scully.zdd:zdd-node-count <>))
+                  <>)
                 (filter-iset-for-percepts reasoner <> role percepts)
                 (compute-next-iset reasoner <>)
                 (apply-possible reasoner <>))
@@ -47,13 +55,10 @@
   (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))
+      ;; (format t "CURRENT ISET:~%")
+      ;; (dump-iset reasoner iset)
+      ;; (format t "LEGAL MOVES:~%")
+      ;; (pr (legal-moves-for reasoner iset role))
       (random-elt (legal-moves-for reasoner iset role)))))
 
 
@@ -64,5 +69,6 @@
                                 :name "Scully-Random-ZDD"
                                 :port 5003))
 
-;; (ggp:start-player *player* :server :hunchentoot :use-thread t)
+(ggp:start-player *player* :server :hunchentoot :use-thread t)
 ;; (ggp:kill-player *player*)
+(slot-value *player* 'ggp::request-lock)
--- a/src/reasoners/zdd.lisp	Tue May 09 12:37:41 2017 +0000
+++ b/src/reasoners/zdd.lisp	Mon May 15 12:22:50 2017 +0000
@@ -220,12 +220,15 @@
 (defun sprout-extend% (legal-moves-by-role)
   (reduce #'build-role-move-zdd legal-moves-by-role :initial-value (sink t)))
 
-(defun sprout-extend (reasoner legal-moves)
+(defun sprout-extend (reasoner legal-moves role chosen-move)
   (sprout-extend%
     (-<> legal-moves
       (group-by #'second <>) ; go role by role
+      (progn (setf (gethash role <>)
+                   (list `(ggp-rules::does ,role ,chosen-move)))
+             <>)
       hash-table-values
-      (sort <> #'scully.terms::symbol< ; sort by role 
+      (sort <> #'scully.terms::symbol< ; sort by role
             :key (lambda (moves)
                    (second (first moves))))
       nreverse ; go bottom up
@@ -234,14 +237,14 @@
               <>))))
 
 
-(defun sprout-traverse (reasoner iset)
+(defun sprout-traverse (reasoner iset role chosen-move)
   (recursively ((z iset)
                 (legal-moves '()))
     (ematch z
       ;; If we hit the empty sink, just bail, there's nothing to add on to.
       ((sink nil) (sink nil))
       ;; If we hit the unit sink we're ready to sprout off the `does`es.
-      ((sink t) (sprout-extend reasoner legal-moves))
+      ((sink t) (sprout-extend reasoner legal-moves role chosen-move))
       ;; Otherwise we're at a node.
       ((node n hi lo)
        (match (number-to-term reasoner n)
@@ -254,7 +257,7 @@
          ;; Otherwise we just recur down both.
          (_ (zdd-node n (recur hi legal-moves) (recur lo legal-moves))))))))
 
-(defun sprout (reasoner iset)
+(defun sprout (reasoner iset role chosen-move)
   "Sprout off child states for each state in `iset` for all legal moves."
   ;; Given an information set, we want to compute a new information set with all
   ;; possible combinations of `does` added, which we'll narrow down later once
@@ -266,7 +269,7 @@
   ;; To do this we'll traverse the ZDD recursively, accumulating a list of all
   ;; legal moves for each player as we go.  Once we hit a sink we'll tack on
   ;; a child ZDD of all the possible combos.
-  (sprout-traverse reasoner iset))
+  (sprout-traverse reasoner iset role chosen-move))
 
 
 ;;;; Basic API ----------------------------------------------------------------
@@ -362,7 +365,8 @@
                         *reasoner*
                         reasoner)
                       <>)
-      (format nil "~D ~S" n <>))))
+      ;; (format nil "~D ~S" n <>)
+      (format nil "~S" <>))))
 
 (defun draw-zdd (reasoner zdd)
   (scully.graphviz::draw-zdd zdd :label-fn (curry #'label reasoner)))
@@ -583,6 +587,7 @@
 (defparameter *rules* (scully.gdl::read-gdl "gdl/pennies-grounded.gdl"))
 (defparameter *rules* (scully.gdl::read-gdl "gdl/mastermind-grounded.gdl"))
 (defparameter *rules* (scully.gdl::read-gdl "gdl/montyhall-grounded.gdl"))
+(defparameter *rules* (scully.gdl::read-gdl "gdl/tictactoe-grounded.gdl"))
 
 (defparameter *i* nil)
 ;; (defparameter *r* nil)