Clean up and get the rule forest generation working properly
author |
Steve Losh <steve@stevelosh.com> |
date |
Wed, 07 Dec 2016 17:52:35 -0500 |
parents |
3cfc630a3e6e
|
children |
6ff8b64f6041
|
branches/tags |
(none) |
files |
src/logic.lisp vendor/make-quickutils.lisp vendor/quickutils.lisp |
Changes
--- 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*)
--- 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
--- 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 ;;;;