Playing around with cubes
author |
Steve Losh <steve@stevelosh.com> |
date |
Fri, 14 Oct 2016 22:51:16 +0000 |
parents |
833316fc5296
|
children |
1b413ff8aa5f
|
branches/tags |
(none) |
files |
package.lisp sand.asd src/rubiks.lisp src/zero-suppressed-decision-diagrams.lisp |
Changes
--- 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 *)