# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1495279494 0
# Node ID b79af8708c020c92b7535d623577c784d348d169
# Parent  47c967fea4c735c35dffe174a98f759a6f43c578
Add rule size test infrastructure

diff -r 47c967fea4c7 -r b79af8708c02 .hgignore
--- a/.hgignore	Fri May 19 17:28:31 2017 +0000
+++ b/.hgignore	Sat May 20 11:24:54 2017 +0000
@@ -6,4 +6,4 @@
 build
 *.png
 lisp.prof
-data-zdd
+data-*
diff -r 47c967fea4c7 -r b79af8708c02 gdl/mastermind448.gdl
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gdl/mastermind448.gdl	Sat May 20 11:24:54 2017 +0000
@@ -0,0 +1,203 @@
+;; GDL-II
+;;;;;;;;;;;;;;;;;;;;;; Mastermind 4 4 8 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(role random)
+(role player)
+
+(color red)
+(color blue)
+(color green)
+(color pink)
+
+(number 1)
+(number 2)
+(number 3)
+(number 4)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(init (guess 1))
+(init setup)
+(succ 2  1)
+(succ 3  2)
+(succ 4  3)
+(succ 5  4)
+(succ 6  5)
+(succ 7  6)
+(succ 8  7)
+(succ 9  8)
+(succ 10 9)
+(succ 11 10)
+(succ 12 11)
+(succ 13 12)
+
+(<= (next (guess ?g))
+  (true (guess ?gp))
+  (succ ?g ?gp))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(<= (sees ?r (does ?r ?m))
+  (does ?r ?m))
+
+(<= (legal random (set ?n ?c))
+  (true (guess ?n))
+  (color ?c)
+  (true setup)
+  (not (true (set ?n ?c2)))
+  (color ?c2))
+
+(<= (next (set ?n ?c))
+  (or
+    (true (set ?n ?c))
+    (does random (set ?n ?c))))
+
+(<= (legal random noop)
+  (not (true setup)))
+
+(<= (next setup)
+  (or
+    (true (guess 1))
+    (true (guess 2))
+    (true (guess 3))))
+
+(<= (legal player noop)
+  (true setup))
+
+(<= (legal player (guessColors ?c1 ?c2 ?c3 ?c4))
+  (not (true setup))
+  (color ?c1)
+  (color ?c2)
+  (color ?c3)
+  (color ?c4))
+
+(<= (sees player (set 1 ?c1))
+  (does player (guessColors ?c1 ?c2 ?c3 ?c4))
+  (true (set 1 ?c1)))
+
+(<= (sees player (set 2 ?c2))
+  (does player (guessColors ?c1 ?c2 ?c3 ?c4))
+  (true (set 2 ?c2)))
+
+(<= (sees player (set 3 ?c3))
+  (does player (guessColors ?c1 ?c2 ?c3 ?c4))
+  (true (set 3 ?c3)))
+
+(<= (sees player (set 4 ?c4))
+  (does player (guessColors ?c1 ?c2 ?c3 ?c4))
+  (true (set 4 ?c4)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(<= terminal
+  (true (guess 13)))
+
+(<= (sees player won)
+  (true won))
+
+(<= (next won)
+  (does player (guessColors ?c1 ?c2 ?c3 ?c4))
+  (true (set 1 ?c1))
+  (true (set 2 ?c2))
+  (true (set 3 ?c3))
+  (true (set 4 ?c4)))
+
+(<= (next (playerset ?c1 ?c2 ?c3 ?c4))
+  (does player (guessColors ?c1 ?c2 ?c3 ?c4)))
+
+(<= terminal
+  (true won))
+
+(goal random 100)
+
+(<= (goal player 100)
+  (true won))
+
+(<= (same ?x ?x)
+  (color ?x))
+
+(<= (goal player 75)
+  (true (guess 13))
+  (true (playerset ?c1 ?c2 ?c3 ?c4))
+  (true (set 1 ?s1))
+  (true (set 2 ?s2))
+  (true (set 3 ?s3))
+  (true (set 4 ?s4))
+  (or
+    (and (same ?c1 ?s1) (same ?c2 ?s2) (same ?c3 ?s3) (distinct ?c4 ?s4))
+    (and (same ?c1 ?s1) (same ?c2 ?s2) (same ?c4 ?s4) (distinct ?c3 ?s3))
+    (and (same ?c1 ?s1) (same ?c3 ?s3) (same ?c4 ?s4) (distinct ?c2 ?s2))
+    (and (same ?c2 ?s2) (same ?c3 ?s3) (same ?c4 ?s4) (distinct ?c1 ?s1))))
+
+(<= (goal player 50)
+  (true (guess 13))
+  (true (playerset ?c1 ?c2 ?c3 ?c4))
+  (true (set 1 ?s1))
+  (true (set 2 ?s2))
+  (true (set 3 ?s3))
+  (true (set 4 ?s4))
+  (or
+    (and (same ?c1 ?s1) (same ?c2 ?s2) (distinct ?c3 ?s3) (distinct ?c4 ?s4))
+    (and (same ?c1 ?s1) (same ?c3 ?s3) (distinct ?c2 ?s2) (distinct ?c4 ?s4))
+    (and (same ?c1 ?s1) (same ?c4 ?s4) (distinct ?c2 ?s2) (distinct ?c3 ?s3))
+    (and (same ?c2 ?s2) (same ?c3 ?s3) (distinct ?c1 ?s1) (distinct ?c4 ?s4))
+    (and (same ?c2 ?s2) (same ?c4 ?s4) (distinct ?c1 ?s1) (distinct ?c3 ?s3))
+    (and (same ?c3 ?s3) (same ?c4 ?s4) (distinct ?c1 ?s1) (distinct ?c2 ?s2))))
+
+(<= (goal player 25)
+  (true (guess 13))
+  (true (playerset ?c1 ?c2 ?c3 ?c4))
+  (true (set 1 ?c1))
+  (true (set 2 ?s2))
+  (true (set 3 ?s3))
+  (true (set 4 ?s4))
+  (distinct ?c2 ?s2)
+  (distinct ?c3 ?s3)
+  (distinct ?c4 ?s4))
+
+(<= (goal player 25)
+  (true (guess 13))
+  (true (playerset ?c1 ?c2 ?c3 ?c4))
+  (true (set 1 ?s1))
+  (true (set 2 ?c2))
+  (true (set 3 ?s3))
+  (true (set 4 ?s4))
+  (distinct ?c1 ?s1)
+  (distinct ?c3 ?s3)
+  (distinct ?c4 ?s4))
+
+(<= (goal player 25)
+  (true (guess 13))
+  (true (playerset ?c1 ?c2 ?c3 ?c4))
+  (true (set 1 ?s1))
+  (true (set 2 ?s2))
+  (true (set 3 ?c3))
+  (true (set 4 ?s4))
+  (distinct ?c2 ?s2)
+  (distinct ?c1 ?s1)
+  (distinct ?c4 ?s4))
+
+(<= (goal player 25)
+  (true (guess 13))
+  (true (playerset ?c1 ?c2 ?c3 ?c4))
+  (true (set 1 ?s1))
+  (true (set 2 ?s2))
+  (true (set 3 ?s3))
+  (true (set 4 ?c4))
+  (distinct ?c2 ?s2)
+  (distinct ?c3 ?s3)
+  (distinct ?c1 ?s1))
+
+(<= (goal player 0)
+  (true (guess 13))
+  (true (playerset ?c1 ?c2 ?c3 ?c4))
+  (true (set 1 ?s1))
+  (true (set 2 ?s2))
+  (true (set 3 ?s3))
+  (true (set 4 ?s4))
+  (distinct ?c1 ?s1)
+  (distinct ?c2 ?s2)
+  (distinct ?c3 ?s3)
+  (distinct ?c4 ?s4))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
diff -r 47c967fea4c7 -r b79af8708c02 src/gdl.lisp
--- a/src/gdl.lisp	Fri May 19 17:28:31 2017 +0000
+++ b/src/gdl.lisp	Sat May 20 11:24:54 2017 +0000
@@ -97,13 +97,13 @@
 ;;; Rules with many terms in their bodies are difficult to make rule trees for,
 ;;; because the size of the tree grows exponentially.  We can fix this problem
 ;;; by splitting large disjunctions into separate rules.
-(defconstant +max-rule-size+ 8)
+(defparameter *max-rule-size* 8)
 
 (defun split-rule (head bodies)
-  (if (<= (length bodies) +max-rule-size+)
+  (if (<= (length bodies) *max-rule-size*)
     (values (mapcar (curry #'cons head) bodies) nil)
     (iterate
-      (for chunk :in (subdivide bodies +max-rule-size+))
+      (for chunk :in (subdivide bodies *max-rule-size*))
       (for new-head = (list (gensym-ggp)))
       (collecting new-head :into new-heads)
       (appending (mapcar (curry #'cons new-head) chunk)
diff -r 47c967fea4c7 -r b79af8708c02 src/grounders/fluxplayer.lisp
--- a/src/grounders/fluxplayer.lisp	Fri May 19 17:28:31 2017 +0000
+++ b/src/grounders/fluxplayer.lisp	Sat May 20 11:24:54 2017 +0000
@@ -148,6 +148,8 @@
 ;; (dump-grounded "buttons")
 ;; (dump-grounded "pennies")
 ;; (dump-grounded "8puzzle")
+;; (dump-grounded "mastermind448")
+;; (dump-grounded "vis_pacman3p.gdl")
 ;; (dump-grounded "tictactoe")
 ;; (dump-grounded "stratego")
 ;; (dump-grounded "small_dominion")
diff -r 47c967fea4c7 -r b79af8708c02 src/players/random-zdd.lisp
--- a/src/players/random-zdd.lisp	Fri May 19 17:28:31 2017 +0000
+++ b/src/players/random-zdd.lisp	Sat May 20 11:24:54 2017 +0000
@@ -1,7 +1,7 @@
 (in-package :scully.players.random-zdd)
 
 (defvar *data-file* nil)
-(defparameter *current-game* 'pennies)
+(defparameter *current-game* 'mastermind448)
 
 
 ;;;; Random Incomplete-Information Player -------------------------------------
@@ -9,13 +9,15 @@
   ((role :type symbol :accessor rp-role)
    (reasoner :accessor rp-reasoner)
    (information-set :accessor rp-iset)
-   (turn :initform 0 :accessor rp-turn)))
+   (turn :initform 0 :accessor rp-turn)
+   (game :initform 0 :accessor rp-game)))
 
 (define-with-macro (random-zdd-player :conc-name rp)
-  role reasoner iset turn)
+  role reasoner iset turn game)
 
 
 (defmethod ggp:player-start-game ((player random-zdd-player) rules role timeout)
+  (incf (rp-game player))
   (setf *data-file* (open "data-zdd" :direction :output :if-exists :append))
   ;; (format *data-file* "turn,information set size,zdd node count,max node count~%")
   (scully.zdd::with-zdd
@@ -93,8 +95,9 @@
                                object-size (information-set-objects (scully.zdd::zdd-enumerate <>)))
                          <>)
                   (apply-possible reasoner <>))))
-        (format *data-file* "~A,~D,~D,~D,~D,~D~%"
+        (format *data-file* "~A,~D,~D,~D,~D,~D,~D~%"
                 *current-game*
+                game
                 turn
                 state-count
                 node-count
diff -r 47c967fea4c7 -r b79af8708c02 src/reasoners/zdd.lisp
--- a/src/reasoners/zdd.lisp	Fri May 19 17:28:31 2017 +0000
+++ b/src/reasoners/zdd.lisp	Sat May 20 11:24:54 2017 +0000
@@ -610,16 +610,44 @@
 
 
 ;;;; Scratch ------------------------------------------------------------------
-(defparameter *rules* (scully.gdl::read-gdl "gdl/meier-grounded.gdl"))
-(defparameter *rules* (scully.gdl::read-gdl "gdl/kriegTTT_5x5-grounded.gdl"))
-(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 *rules* (scully.gdl::read-gdl "gdl/stratego-grounded.gdl"))
-
 (defparameter *i* nil)
 (defparameter *r* nil)
+
+;; (defparameter *rules* (scully.gdl::read-gdl "gdl/meier-grounded.gdl"))
+;; (defparameter *rules* (scully.gdl::read-gdl "gdl/kriegTTT_5x5-grounded.gdl"))
+;; (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/mastermind448-grounded.gdl"))
+;; (defparameter *rules* (scully.gdl::read-gdl "gdl/montyhall-grounded.gdl"))
+;; (defparameter *rules* (scully.gdl::read-gdl "gdl/tictactoe-grounded.gdl"))
+;; (defparameter *rules* (scully.gdl::read-gdl "gdl/stratego-grounded.gdl"))
+;; (defparameter *rules* (scully.gdl::read-gdl "gdl/transit-grounded.gdl"))
+;; (defparameter *rules* (scully.gdl::read-gdl "gdl/vis_pacman3p-grounded.gdl"))
+
 ;; (defparameter *r* (make-zdd-reasoner *rules*))
-;; (reasoner-rule-tree-sizes *r*)
 
+(defun run-test (game-name max-rule-size shuffle?)
+  (let* ((scully.terms::*shuffle-variables* shuffle?)
+         (scully.gdl::*max-rule-size* max-rule-size)
+         (gdl (scully.gdl::read-gdl (format nil "gdl/~(~A~)-grounded.gdl" game-name)))
+         (start (get-internal-real-time))
+         (r (make-zdd-reasoner gdl))
+         (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~%"
+            game-name
+            scully.gdl::*max-rule-size*
+            scully.terms::*shuffle-variables*
+            (length sizes)
+            (apply #'+ sizes)
+            elapsed)
+    (values)))
+
+
+;; (run-test 'pennies 8 nil)
+
+;; (iterate
+;;   (repeat 10)
+;;   (run-test 'transit 12 nil))
+