8a22df7c2b9d

Clean up and get the rule forest generation working properly
[view raw] [browse files]
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 ;;;;