# HG changeset patch # User Steve Losh # Date 1481151155 18000 # Node ID 8a22df7c2b9dce3db98bffee17259e100cb4a043 # Parent 3cfc630a3e6e3b52b5d5bfab9aa9ba76371a35c7 Clean up and get the rule forest generation working properly diff -r 3cfc630a3e6e -r 8a22df7c2b9d src/logic.lisp --- a/src/logic.lisp Thu Nov 24 16:08:20 2016 +0000 +++ b/src/logic.lisp Wed Dec 07 17:52:35 2016 -0500 @@ -2,10 +2,10 @@ (defparameter *rules* - ; (scully.gdl::read-gdl "gdl/tictactoe-grounded.gdl") + (scully.gdl::read-gdl "gdl/tictactoe-grounded.gdl") ; (scully.gdl::read-gdl "gdl/hanoi-grounded.gdl") ; (scully.gdl::read-gdl "gdl/8puzzle-grounded.gdl") - (scully.gdl::read-gdl "gdl/roshambo2-grounded.gdl") + ; (scully.gdl::read-gdl "gdl/roshambo2-grounded.gdl") ) @@ -15,38 +15,41 @@ hash-table-values (mapcar #'scully.rule-trees::make-rule-tree <>))) +(defun make-rule-forests (rules) + "Turn a set of grounded GDL rules into rule forests and mapping tables. -(setf *print-length* 10 - *print-depth* 5) + A rule forest is a collection of individual rule trees in a single layer, + stratified as necessary: -(defun make-rule-forest (rules) + POSSIBLE: (STRATUM-1 STRATUM-2 ...) + HAPPENS: (STRATUM-1 STRATUM-2 ...) + || || + || \/ + || (rule-tree-1 rule-tree-2 ...) + \/ + (rule-tree-1 rule-tree-2 ...) + + Returns a list of: + + * The :possible layer's rule forest. + * The :happens layer's rule forest. + * The term->number hash table. + * The number->term hash table. + + " (destructuring-bind (term->number number->term rule-layers) - (scully.terms::integerize-rules rules) - (flet ((draw (rt) - (scully.graphviz::draw-rule-tree - rt :label-fn (lambda (n) - (gethash n number->term))) - (break) - )) - (print-hash-table rule-layers) - (-<> rule-layers - (gethash :possible <>) - scully.terms::stratify-layer - (nth 0 <>) - (make-stratum-rule-trees <>) - (map nil #'draw <>) - ; (map nil #'pr <>) - ; (mapcar (curry #'group-by #'car) <>) - ; (map nil #'print-hash-table <>) - ; (hash-table-values <>) - ; (map nil (lambda (rule) - ; (-<> rule - ; (scully.rule-trees::make-rule-tree <>) - ; ) - ; (break)) - ; <>) - ))) - ) + (-> rules + scully.gdl::normalize-rules + scully.terms::integerize-rules) + (flet ((make-forest (layer) + (-<> rule-layers + (gethash layer <>) + scully.terms::stratify-layer + (mapcar #'make-stratum-rule-trees <>)))) + (list (make-forest :possible) + (make-forest :happens) + term->number + number->term)))) ; (make-rule-forest *rules*) diff -r 3cfc630a3e6e -r 8a22df7c2b9d vendor/make-quickutils.lisp --- a/vendor/make-quickutils.lisp Thu Nov 24 16:08:20 2016 +0000 +++ b/vendor/make-quickutils.lisp Wed Dec 07 17:52:35 2016 -0500 @@ -19,6 +19,8 @@ :once-only :rcurry :set-equal + :subdivide + :symb :with-gensyms :with-output-to-file :write-string-into-file diff -r 3cfc630a3e6e -r 8a22df7c2b9d vendor/quickutils.lisp --- a/vendor/quickutils.lisp Thu Nov 24 16:08:20 2016 +0000 +++ b/vendor/quickutils.lisp Wed Dec 07 17:52:35 2016 -0500 @@ -2,7 +2,7 @@ ;;;; See http://quickutil.org for details. ;;;; To regenerate: -;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:COMPOSE :COPY-HASH-TABLE :CURRY :ENSURE-BOOLEAN :ENSURE-GETHASH :ENSURE-LIST :EXTREMUM :FLATTEN-ONCE :HASH-TABLE-KEYS :HASH-TABLE-VALUES :MAP-PRODUCT :MKSTR :ONCE-ONLY :RCURRY :SET-EQUAL :WITH-GENSYMS :WITH-OUTPUT-TO-FILE :WRITE-STRING-INTO-FILE :YES-NO) :ensure-package T :package "SCULLY.QUICKUTILS") +;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:COMPOSE :COPY-HASH-TABLE :SUBDIVIDE :CURRY :ENSURE-BOOLEAN :ENSURE-GETHASH :ENSURE-LIST :EXTREMUM :FLATTEN-ONCE :HASH-TABLE-KEYS :HASH-TABLE-VALUES :MAP-PRODUCT :MKSTR :ONCE-ONLY :RCURRY :SET-EQUAL :SYMB :WITH-GENSYMS :WITH-OUTPUT-TO-FILE :WRITE-STRING-INTO-FILE :YES-NO) :ensure-package T :package "SCULLY.QUICKUTILS") (eval-when (:compile-toplevel :load-toplevel :execute) (unless (find-package "SCULLY.QUICKUTILS") @@ -14,13 +14,13 @@ (when (boundp '*utilities*) (setf *utilities* (union *utilities* '(:MAKE-GENSYM-LIST :ENSURE-FUNCTION - :COMPOSE :COPY-HASH-TABLE :CURRY - :ENSURE-BOOLEAN :ENSURE-GETHASH + :COMPOSE :COPY-HASH-TABLE :SUBDIVIDE + :CURRY :ENSURE-BOOLEAN :ENSURE-GETHASH :ENSURE-LIST :EXTREMUM :FLATTEN-ONCE :MAPHASH-KEYS :HASH-TABLE-KEYS :MAPHASH-VALUES :HASH-TABLE-VALUES :MAPPEND :MAP-PRODUCT :MKSTR - :ONCE-ONLY :RCURRY :SET-EQUAL + :ONCE-ONLY :RCURRY :SET-EQUAL :SYMB :STRING-DESIGNATOR :WITH-GENSYMS :WITH-OPEN-FILE* :WITH-OUTPUT-TO-FILE :WRITE-STRING-INTO-FILE :YES-NO)))) @@ -100,6 +100,28 @@ copy)) + (defun subdivide (sequence chunk-size) + "Split `sequence` into subsequences of size `chunk-size`." + (check-type sequence sequence) + (check-type chunk-size (integer 1)) + + (etypecase sequence + ;; Since lists have O(N) access time, we iterate through manually, + ;; collecting each chunk as we pass through it. Using SUBSEQ would + ;; be O(N^2). + (list (loop :while sequence + :collect + (loop :repeat chunk-size + :while sequence + :collect (pop sequence)))) + + ;; For other sequences like strings or arrays, we can simply chunk + ;; by repeated SUBSEQs. + (sequence (loop :with len := (length sequence) + :for i :below len :by chunk-size + :collect (subseq sequence i (min len (+ chunk-size i))))))) + + (defun curry (function &rest arguments) "Returns a function that applies `arguments` and the arguments it is called with to `function`." @@ -329,6 +351,15 @@ (return nil)))))) + (defun symb (&rest args) + "Receives any number of objects, concatenates all into one string with `#'mkstr` and converts them to symbol. + +Extracted from _On Lisp_, chapter 4. + +See also: `symbolicate`" + (values (intern (apply #'mkstr args)))) + + (deftype string-designator () "A string designator type. A string designator is either a string, a symbol, or a character." @@ -431,9 +462,10 @@ nil) (eval-when (:compile-toplevel :load-toplevel :execute) - (export '(compose copy-hash-table curry ensure-boolean ensure-gethash - ensure-list extremum flatten-once hash-table-keys hash-table-values - map-product mkstr once-only rcurry set-equal with-gensyms - with-unique-names with-output-to-file write-string-into-file yes no))) + (export '(compose copy-hash-table subdivide curry ensure-boolean + ensure-gethash ensure-list extremum flatten-once hash-table-keys + hash-table-values map-product mkstr once-only rcurry set-equal symb + with-gensyms with-unique-names with-output-to-file + write-string-into-file yes no))) ;;;; END OF quickutils.lisp ;;;;