--- 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
--- /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)
--- /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)))
--- 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")
+
+
--- 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")
--- 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 ;;;;