# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1475585000 0
# Node ID 90dd275f6e8165729a41fe93c425ceabecfe8cbd
# Parent  d21ec254ff4e90a8964caad9a3d39e4f58106bce
Add grounded GDL dumping util

diff -r d21ec254ff4e -r 90dd275f6e81 .hgignore
--- a/.hgignore	Thu Sep 29 16:33:29 2016 +0000
+++ b/.hgignore	Tue Oct 04 12:43:20 2016 +0000
@@ -1,3 +1,4 @@
 syntax: glob
 
 scratch.lisp
+*-grounded.gdl
diff -r d21ec254ff4e -r 90dd275f6e81 gdl/8puzzle.gdl
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gdl/8puzzle.gdl	Tue Oct 04 12:43:20 2016 +0000
@@ -0,0 +1,152 @@
+;;;; 8-puzzle
+
+(role player)
+
+;;;; initial state
+
+(init (cell 1 1 8))
+(init (cell 1 2 7))
+(init (cell 1 3 6))
+(init (cell 2 1 5))
+(init (cell 2 2 4))
+(init (cell 2 3 3))
+(init (cell 3 1 2))
+(init (cell 3 2 1))
+(init (cell 3 3 b))
+(init (step 0))
+
+;;;; adjacency
+
+(succ 1 2)
+(succ 2 3)
+(pred 2 1)
+(pred 3 2)
+
+;;;; legal moves: e.g.: move(2,2) means move the blank square to 2,2 from whereever it is.
+;;;; this will only be legal if it was in a square adjacent to the square picked
+
+(<= (legal player (move ?x ?y))
+    (true (cell ?u ?y b))
+    (or (succ ?x ?u) (pred ?x ?u)))
+
+(<= (legal player (move ?x ?y))
+    (true (cell ?x ?v b)) 
+    (or (succ ?y ?v) (pred ?y ?v)))
+
+;;;; next states
+
+(<= (next (step ?x))
+    (true (step ?y))
+    (successor ?y ?x))
+(<= (next (cell ?x ?y b))
+    (does player (move ?x ?y))) 
+
+(<= (next (cell ?u ?y ?z))
+    (does player (move ?x ?y)) 
+    (true (cell ?u ?y b))
+    (true (cell ?x ?y ?z))
+    (distinct ?z b))
+
+(<= (next (cell ?x ?v ?z))
+    (does player (move ?x ?y)) 
+    (true (cell ?x ?v b)) 
+    (true (cell ?x ?y ?z))
+    (distinct ?z b))
+
+(<= (next (cell ?u ?v ?z))
+    (true (cell ?u ?v ?z))
+    (does player (move ?x ?y))
+    (or (distinct ?x ?u) (distinct ?y ?v))
+    (true (cell ?x1 ?y1 b))
+    (or (distinct ?x1 ?u) (distinct ?y1 ?v)))
+
+;;;; goal and terminal
+
+(<= (goal player 100)
+    inorder
+    (true (step 30)))
+
+(<= (goal player 99) 
+    inorder
+    (true (step ?x))
+    (distinct ?x 30))
+
+(<= (goal player 0) 
+    (not inorder))
+
+(<= terminal inorder)
+(<= terminal
+    (true (step 60)))
+
+(<= inorder
+    (true (cell 1 1 1)) 
+    (true (cell 1 2 2)) 
+    (true (cell 1 3 3)) 
+    (true (cell 2 1 4)) 
+    (true (cell 2 2 5)) 
+    (true (cell 2 3 6)) 
+    (true (cell 3 1 7)) 
+    (true (cell 3 2 8)) 
+    (true (cell 3 3 b)))
+
+;;; Step counting
+  (successor 0 1)
+  (successor 1 2)
+  (successor 2 3)
+  (successor 3 4)
+  (successor 4 5)
+  (successor 5 6)
+  (successor 6 7)
+  (successor 7 8)
+  (successor 8 9)
+  (successor 9 10)
+  (successor 10 11)
+  (successor 11 12)
+  (successor 12 13)
+  (successor 13 14)
+  (successor 14 15)
+  (successor 15 16)
+  (successor 16 17)
+  (successor 17 18)
+  (successor 18 19)
+  (successor 19 20)
+  (successor 20 21)
+  (successor 21 22)
+  (successor 22 23)
+  (successor 23 24)
+  (successor 24 25)
+  (successor 25 26)
+  (successor 26 27)
+  (successor 27 28)
+  (successor 28 29)
+  (successor 29 30)
+  (successor 30 31)
+  (successor 31 32)
+  (successor 32 33)
+  (successor 33 34)
+  (successor 34 35)
+  (successor 35 36)
+  (successor 36 37)
+  (successor 37 38)
+  (successor 38 39)
+  (successor 39 40)
+  (successor 40 41)
+  (successor 41 42)
+  (successor 42 43)
+  (successor 43 44)
+  (successor 44 45)
+  (successor 45 46)
+  (successor 46 47)
+  (successor 47 48)
+  (successor 48 49)
+  (successor 49 50)
+  (successor 50 51)
+  (successor 51 52)
+  (successor 52 53)
+  (successor 53 54)
+  (successor 54 55)
+  (successor 55 56)
+  (successor 56 57)
+  (successor 57 58)
+  (successor 58 59)
+  (successor 59 60)
diff -r d21ec254ff4e -r 90dd275f6e81 gdl/roshambo2.gdl
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gdl/roshambo2.gdl	Tue Oct 04 12:43:20 2016 +0000
@@ -0,0 +1,66 @@
+(role white)
+(role black)
+(init (step s1))
+(init (beaten white s0))
+(init (beaten black s0))
+(<= (next (beaten ?player ?n1))
+    (does ?player ?throw)
+    (does ?player2 ?throw2)
+    (distinct ?player2 ?player)
+    (beats ?throw ?throw2)
+    (true (beaten ?player ?n))
+    (succ ?n ?n1))
+(<= (next (beaten ?player ?n))
+    (does ?player ?throw)
+    (does ?player2 ?throw2)
+    (distinct ?player2 ?player)
+    (not (beats ?throw ?throw2))
+    (true (beaten ?player ?n)))
+(<= (next (step ?y))
+    (true (step ?x))
+    (succ ?x ?y))
+(succ s0 s1)
+(succ s1 s2)
+(succ s2 s3)
+(succ s3 s4)
+(succ s4 s5)
+(succ s5 s6)
+(succ s6 s7)
+(succ s7 s8)
+(succ s8 s9)
+(succ s9 s10)
+(<= (gt ?x ?y)
+    (succ ?y ?x))
+(<= (gt ?x ?y)
+    (succ ?z ?x)
+    (gt ?z ?y))
+(<= (legal ?role rock)
+    (role ?role))
+(<= (legal ?role paper)
+    (role ?role))
+(<= (legal ?role scissors)
+    (role ?role))
+(<= (legal ?role well)
+    (role ?role))
+(beats rock scissors)
+(beats paper rock)
+(beats paper well)
+(beats scissors paper)
+(beats well scissors)
+(beats well rock)
+(<= (goal ?r1 100)
+    (true (beaten ?r1 ?n1))
+    (true (beaten ?r2 ?n2))
+    (gt ?n1 ?n2))
+(<= (goal ?r2 0)
+    (true (beaten ?r1 ?n1))
+    (true (beaten ?r2 ?n2))
+    (gt ?n1 ?n2))
+(<= (goal ?r 50)
+    (true (beaten white ?n))
+    (true (beaten black ?n))
+    (role ?r))
+(<= terminal
+    (true (beaten ?r s5)))
+(<= terminal
+    (true (step s10)))
diff -r d21ec254ff4e -r 90dd275f6e81 src/grounders/fluxplayer.lisp
--- a/src/grounders/fluxplayer.lisp	Thu Sep 29 16:33:29 2016 +0000
+++ b/src/grounders/fluxplayer.lisp	Tue Oct 04 12:43:20 2016 +0000
@@ -111,7 +111,9 @@
         (for pos = (mapcar #'get-rule (rule-positive entry)))
         (for neg = (mapcar #'get-rule (rule-negative entry)))
         (collect (if (or pos neg)
-                   `(ggp-rules::<= ,rule ,@pos ,@neg)
+                   `(ggp-rules::<= ,rule
+                     ,@pos
+                     ,@(mapcar (curry #'list 'ggp-rules::not) neg))
                    (ensure-list rule)))))))
 
 
@@ -136,5 +138,17 @@
     (apply #'rebuild-rules)))
 
 
-; (ground-gdl "gdl/buttons.gdl")
-; (ground-gdl-file "gdl/tictactoe.gdl")
+(defun dump-grounded (filename)
+  (with-output-to-file (*standard-output*
+                         (mkstr "gdl/" filename "-grounded.gdl")
+                         :if-exists :supersede)
+    (let ((*package* (find-package :ggp-rules)))
+      (map nil #'print (ground-gdl-file (mkstr "gdl/" filename ".gdl"))))))
+
+
+; (dump-grounded "buttons")
+; (dump-grounded "8puzzle")
+; (dump-grounded "tictactoe")
+; (dump-grounded "roshambo2")
+
+
diff -r d21ec254ff4e -r 90dd275f6e81 vendor/make-quickutils.lisp
--- a/vendor/make-quickutils.lisp	Thu Sep 29 16:33:29 2016 +0000
+++ b/vendor/make-quickutils.lisp	Tue Oct 04 12:43:20 2016 +0000
@@ -8,10 +8,12 @@
                :ensure-gethash
                :ensure-list
                :map-product
+               :mkstr
                :once-only
                :rcurry
                :set-equal
                :with-gensyms
+               :with-output-to-file
 
                )
   :package "SCULLY.QUICKUTILS")
diff -r d21ec254ff4e -r 90dd275f6e81 vendor/quickutils.lisp
--- a/vendor/quickutils.lisp	Thu Sep 29 16:33:29 2016 +0000
+++ b/vendor/quickutils.lisp	Tue Oct 04 12:43:20 2016 +0000
@@ -2,7 +2,7 @@
 ;;;; See http://quickutil.org for details.
 
 ;;;; To regenerate:
-;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:CURRY :ENSURE-GETHASH :ENSURE-LIST :MAP-PRODUCT :ONCE-ONLY :RCURRY :SET-EQUAL :WITH-GENSYMS) :ensure-package T :package "SCULLY.QUICKUTILS")
+;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:CURRY :ENSURE-GETHASH :ENSURE-LIST :MAP-PRODUCT :MKSTR :ONCE-ONLY :RCURRY :SET-EQUAL :WITH-GENSYMS :WITH-OUTPUT-TO-FILE) :ensure-package T :package "SCULLY.QUICKUTILS")
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (unless (find-package "SCULLY.QUICKUTILS")
@@ -15,9 +15,10 @@
 (when (boundp '*utilities*)
   (setf *utilities* (union *utilities* '(:MAKE-GENSYM-LIST :ENSURE-FUNCTION
                                          :CURRY :ENSURE-GETHASH :ENSURE-LIST
-                                         :MAPPEND :MAP-PRODUCT :ONCE-ONLY
-                                         :RCURRY :SET-EQUAL :STRING-DESIGNATOR
-                                         :WITH-GENSYMS))))
+                                         :MAPPEND :MAP-PRODUCT :MKSTR
+                                         :ONCE-ONLY :RCURRY :SET-EQUAL
+                                         :STRING-DESIGNATOR :WITH-GENSYMS
+                                         :WITH-OPEN-FILE* :WITH-OUTPUT-TO-FILE))))
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defun make-gensym-list (length &optional (x "G"))
     "Returns a list of `length` gensyms, each generated as if with a call to `make-gensym`,
@@ -107,6 +108,14 @@
       (%map-product (ensure-function function) (cons list more-lists))))
   
 
+  (defun mkstr (&rest args)
+    "Receives any number of objects (string, symbol, keyword, char, number), extracts all printed representations, and concatenates them all into one string.
+
+Extracted from _On Lisp_, chapter 4."
+    (with-output-to-string (s)
+      (dolist (a args) (princ a s))))
+  
+
   (defmacro once-only (specs &body forms)
     "Evaluates `forms` with symbols specified in `specs` rebound to temporary
 variables, ensuring that each initform is evaluated only once.
@@ -212,8 +221,44 @@
 unique symbol the named variable will be bound to."
     `(with-gensyms ,names ,@forms))
   
+
+  (defmacro with-open-file* ((stream filespec &key direction element-type
+                                                   if-exists if-does-not-exist external-format)
+                             &body body)
+    "Just like `with-open-file`, but `nil` values in the keyword arguments mean to use
+the default value specified for `open`."
+    (once-only (direction element-type if-exists if-does-not-exist external-format)
+      `(with-open-stream
+           (,stream (apply #'open ,filespec
+                           (append
+                            (when ,direction
+                              (list :direction ,direction))
+                            (when ,element-type
+                              (list :element-type ,element-type))
+                            (when ,if-exists
+                              (list :if-exists ,if-exists))
+                            (when ,if-does-not-exist
+                              (list :if-does-not-exist ,if-does-not-exist))
+                            (when ,external-format
+                              (list :external-format ,external-format)))))
+         ,@body)))
+  
+
+  (defmacro with-output-to-file ((stream-name file-name &rest args
+                                                        &key (direction nil direction-p)
+                                                        &allow-other-keys)
+                                 &body body)
+    "Evaluate `body` with `stream-name` to an output stream on the file
+`file-name`. `args` is sent as is to the call to `open` except `external-format`,
+which is only sent to `with-open-file` when it's not `nil`."
+    (declare (ignore direction))
+    (when direction-p
+      (error "Can't specifiy :DIRECTION for WITH-OUTPUT-TO-FILE."))
+    `(with-open-file* (,stream-name ,file-name :direction :output ,@args)
+       ,@body))
+  
 (eval-when (:compile-toplevel :load-toplevel :execute)
-  (export '(curry ensure-gethash ensure-list map-product once-only rcurry
-            set-equal with-gensyms with-unique-names)))
+  (export '(curry ensure-gethash ensure-list map-product mkstr once-only rcurry
+            set-equal with-gensyms with-unique-names with-output-to-file)))
 
 ;;;; END OF quickutils.lisp ;;;;