d45bff9b6951

--- a/package.lisp	Fri Oct 14 21:15:54 2016 +0000
+++ b/package.lisp	Fri Oct 14 22:51:16 2016 +0000
@@ -164,6 +164,17 @@
   (:export
     ))
 
+(defpackage #:sand.rubiks
+  (:use
+    #:cl
+    #:cl-arrows
+    #:losh
+    #:iterate
+    #:sand.quickutils
+    #:sand.utils)
+  (:export
+    ))
+
 (defpackage #:sand.streams
   (:use
     #:cl

--- a/sand.asd	Fri Oct 14 21:15:54 2016 +0000
+++ b/sand.asd	Fri Oct 14 22:51:16 2016 +0000
@@ -53,6 +53,7 @@
                  (:file "streams")
                  (:file "color-difference")
                  (:file "number-letters")
+                 (:file "rubiks")
                  (:module "terrain"
                   :serial t
                   :components ((:file "diamond-square")))

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/rubiks.lisp	Fri Oct 14 22:51:16 2016 +0000
@@ -0,0 +1,118 @@
+(in-package #:sand.rubiks)
+
+; (declaim (optimize (speed 1) (safety 3) (debug 3)))
+
+(deftype cube () '(simple-array t (6 9)))
+
+(defun make-solved-cube ()
+  (make-array '(6 9)
+    :adjustable nil
+    ; :element-type 'symbol
+    :initial-contents
+    '((w w w w w w w w w) ; top
+      (g g g g g g g g g) ; left
+      (r r r r r r r r r) ; front
+      (b b b b b b b b b) ; right
+      (o o o o o o o o o) ; back
+      (y y y y y y y y y)))) ; down
+
+
+(defun face-index (face)
+  (case face
+    (:top 0)
+    (:left 1)
+    (:front 2)
+    (:right 3)
+    (:back 4)
+    (:down 5)))
+
+
+(defmacro defaccessor (name face)
+  `(defmacro ,name (cube n)
+    `(aref ,cube ,(face-index ,face) ,n)))
+
+
+(defaccessor top :top)
+(defaccessor down :down)
+(defaccessor left :left)
+(defaccessor right :right)
+(defaccessor front :front)
+(defaccessor back :back)
+
+(defmacro define-move (name &rest groups)
+  (flet ((access (spec)
+           `(,(first spec) cube ,(second spec))))
+    `(progn
+      (declaim (ftype (function (cube) null) ,name))
+      (defun ,name (cube)
+        ,@(mapcar (lambda (group)
+                    `(rotatef ,@(mapcar #'access group)))
+                  groups)
+        nil))))
+
+;       0 1 2
+;       3 4 5
+;       6 7 8
+; 0 1 2 0 1 2 0 1 2 0 1 2
+; 3 4 5 3 4 5 3 4 5 3 4 5
+; 6 7 8 6 7 8 6 7 8 6 7 8
+;       0 1 2
+;       3 4 5
+;       6 7 8
+
+(define-move move-front
+  ((front 0) (front 6) (front 8) (front 2))
+  ((front 1) (front 3) (front 7) (front 5))
+  ((top 6) (left 8) (down 2) (right 0))
+  ((top 7) (left 5) (down 1) (right 3))
+  ((top 8) (left 2) (down 0) (right 6)))
+
+(define-move move-top
+  ((top 0) (top 6) (top 8) (top 2))
+  ((top 1) (top 3) (top 7) (top 5))
+  ((front 0) (right 0) (back 0) (left 0))
+  ((front 1) (right 1) (back 1) (left 1))
+  ((front 2) (right 2) (back 2) (left 2)))
+
+(define-move move-left
+  ((left 0) (left 6) (left 8) (left 2))
+  ((left 1) (left 3) (left 7) (left 5))
+  ((front 0) (top 0) (back 2) (down 0))
+  ((front 3) (top 3) (back 5) (down 3))
+  ((front 6) (top 6) (back 8) (down 6)))
+
+(define-move move-right
+  ((right 0) (right 6) (right 8) (right 2))
+  ((right 1) (right 3) (right 7) (right 5))
+  ((front 2) (down 2) (back 8) (top 2))
+  ((front 5) (down 5) (back 5) (top 5))
+  ((front 8) (down 8) (back 2) (top 8)))
+
+
+
+(defun print-cube (cube)
+  (flet ((pad ()
+           (format t "      "))
+         (row (face row)
+           (format t "~A ~A ~A "
+                   (aref cube (face-index face) (+ 0 (* row 3)))
+                   (aref cube (face-index face) (+ 1 (* row 3)))
+                   (aref cube (face-index face) (+ 2 (* row 3))))))
+    (pad) (row :top 0) (terpri)
+    (pad) (row :top 1) (terpri)
+    (pad) (row :top 2) (terpri)
+    (row :left 0) (row :front 0) (row :right 0) (row :back 0) (terpri)
+    (row :left 1) (row :front 1) (row :right 1) (row :back 1) (terpri)
+    (row :left 2) (row :front 2) (row :right 2) (row :back 2) (terpri)
+    (pad) (row :down 0) (terpri)
+    (pad) (row :down 1) (terpri)
+    (pad) (row :down 2) (terpri))
+  (values))
+
+
+(defparameter *c* (make-solved-cube))
+; (move-front *c*)
+; (move-top *c*)
+; (move-left *c*)
+; (move-right *c*)
+; (print-cube *c*)

--- a/src/zero-suppressed-decision-diagrams.lisp	Fri Oct 14 21:15:54 2016 +0000
+++ b/src/zero-suppressed-decision-diagrams.lisp	Fri Oct 14 22:51:16 2016 +0000
@@ -67,18 +67,18 @@
              (enumerate-zdd low)))))
 
 
-(zdd-union (zdd-union (zdd-with 2) (zdd-with 1))
-           (zdd-adjoin
-             (zdd-union (zdd-union (zdd-with 2) (zdd-with 3))
-                        (zdd-union (zdd-with 1) (zdd-with 3)))
-             2))
+; (zdd-union (zdd-union (zdd-with 2) (zdd-with 1))
+;            (zdd-adjoin
+;              (zdd-union (zdd-union (zdd-with 2) (zdd-with 3))
+;                         (zdd-union (zdd-with 1) (zdd-with 3)))
+;              2))
 
-(zdd-adjoin
-  (zdd-union (zdd-union (zdd-with 2) (zdd-with 3))
-             (zdd-union (zdd-with 1) (zdd-with 3)))
-  2)
+; (zdd-adjoin
+;   (zdd-union (zdd-union (zdd-with 2) (zdd-with 3))
+;              (zdd-union (zdd-with 1) (zdd-with 3)))
+;   2)
 
-(zdd-disjoin * 2)
+; (zdd-disjoin * 2)
 
 
-(enumerate-zdd *)
+; (enumerate-zdd *)