;; (load "rube.l") ;;;; RUBE.L ;;; Constructs the cycle decomposition of sequences of moves on the ;;; Rubik's Cube. Faces are denoted by F, R, B, L, U and D for front, ;;; right, back, left, up and down, respectively. Corner pieces are ;;; denoted by their three faces, or 'elements', edges by their two. ;;; ;;; Moves are denoted by their face and either: +, -, or 2, for ;;; clockwise, counterclockwise and half-turn, or no suffix, -1 and 2, ;;; for CW, CCW and half-turn. Examples: U+, F-1, R2. ;;; ;;; Processes are given as a list of moves, e.g. '(U+ F-1 R2). Note ;;; that the two notation styles for turns may be intermixed; however, ;;; the first style is higher in the association lists, resulting in ;;; faster lookup time. ;;; ;;; John Kerl ;;; 12/93 ;;; ================================================================ ;;; This software is released under the terms of the GNU GPL. ;;; Please see LICENSE.txt in the same directory as this file. ;;; ================================================================ ;;;; ----------------------------------------------------------------------------- ;; Implementation of these functions depends on the platform: ;; For CL, use "string". ;; For EL, use "prin1-to-string". (defun symbol-to-string (sym) ;; (prin1-to-string sym) (string sym)) ;; For CL, use "char". ;; For EL, use "aref". (defun select-char-in-string (string elt) ;;(aref string elt) (char string elt)) ;;;; ----------------------------------------------------------------------------- (defun cycle-decomposition (moves) ;; Given a list of Rubik's Cube pieces and a list of moves, return the cycle ;; decomposition of the moves, omitting trivial cycles. (delete-1-cycles (find-cycles *rube-list-of-all-pieces* moves nil))) ;; (cycle-decomposition '(F)) ;; (cycle-decomposition '(F R)) ;; (cycle-decomposition '(F R B L)) ;; (cycle-decomposition '(F2 R2)) ;; (cycle-decomposition '(F2)) ;; (cycle-decomposition '(F2 B2)) (defun pprint-cycle-decomposition (moves) (rube-pprint (cycle-decomposition moves))) (defun pared-moves-on-all-pieces (moves) (labels ((diff (image original) (cond ((or (null image) (null original)) '()) ((equal (car image) (car original)) (diff (cdr image) (cdr original))) (t (cons (if (rube-piece-equal (car image) (car original)) (cons (car original) (sign-of-rotation (car original) (car image))) (list (car original) '-> (car image))) (diff (cdr image) (cdr original))))))) (diff (moves-on-pieces moves *rube-list-of-all-pieces*) *rube-list-of-all-pieces*))) ;; (pared-moves-on-all-pieces '(F)) ;; (setf moves '(F)) (defun moves-on-pieces (moves pieces) (mapcar #'(lambda (x) (moves-on-piece moves x)) pieces)) ;; (rube-piece-equal 'URF 'UFR) ;; (rube-piece-equal 'URF (moves-on-piece '(F F F F) 'UFR)) ;; (moves-on-pieces '(F) '(UFR UF)) ;; (moves-on-pieces '(F F) '(UFR UF)) ;; (moves-on-pieces '(F F F) '(UFR UF)) ;; (moves-on-pieces '(F F F F) '(UFR UF)) ;; (moves-on-piece '(F) 'UFR) ;; (moves-on-piece '(F) 'UF) (defun delete-1-cycles (cycles) (cond ((null cycles) '()) ((> (length (car cycles)) 1) (cons (car cycles) (delete-1-cycles (cdr cycles)))) (t (delete-1-cycles (cdr cycles))))) (defun find-cycles (pieces moves current-cycles) (cond ((null pieces) current-cycles) ((memtree (car pieces) current-cycles) (find-cycles (cdr pieces) moves current-cycles)) (t (find-cycles (cdr pieces) moves (append current-cycles (list (find-cycle (car pieces) moves))))))) (defun memtree (atm tree) ;; A predicate to determine whether non-null atom ATM is rube-equivalent ;; to an atomic member of TREE (i.e. if the piece given by atm is the same ;; piece as one in the tree, not considering spin). (cond ((null tree) nil) ((not (listp tree)) (rube-piece-equal atm tree)) ;; ((equal atm tree) t) ;; would use equal outside of rube code ;; Want to see if a piece has already been decomposed, ;; regardless of orientation; hence the need for rube-piece-equal. (t (or (memtree atm (car tree)) (memtree atm (cdr tree)))))) ;; (memtree 'F '(A B C)) ;; (memtree 'F '(A F C)) ;; (memtree 'F '(A (D F E) C)) (defun find-cycle (piece moves) (let ((cycle (list piece))) (do ((next (moves-on-piece moves piece) (moves-on-piece moves next))) ((rube-piece-equal piece next) (append cycle (sign-of-rotation piece next))) (setf cycle (append cycle (list next)))))) ;; (find-cycle 'UFR '(U F)) (defun sign-of-rotation (orient-1 orient-2) (cond ((equal orient-1 orient-2) nil) ; Same representation of same piece -- no spin. ;; No sign if pieces aren't the same. ((not (rube-piece-equal orient-1 orient-2)) nil) ;; Arbitrarily, say + for any differently represented edges ;; (rotation group only has order 2). ((= (length (symbol-to-string orient-1)) 2) '(+)) ;; Now they must be corner pieces. Do a table lookup. ((member orient-1 *clockwise-orient-list*) (if (char= (select-char-in-string (symbol-to-string orient-1) 1) (select-char-in-string (symbol-to-string orient-2) 0)) '(+) '(-))) (t (if (char= (select-char-in-string (symbol-to-string orient-1) 1) (select-char-in-string (symbol-to-string orient-2) 0)) '(-) '(+))))) ;; (sign-of-rotation 'UFR 'UFL) ;; (sign-of-rotation 'UFR 'UFR) ;; (sign-of-rotation 'UFR 'URF) ;; (sign-of-rotation 'FUR 'FRU) ;; (sign-of-rotation 'UFR 'UR) ;; The names of three adjacent faces provide the name of a corner piece; ;; the names of two adjacent faces provide the name of an edge piece. ;; However, a corner's three faces may be combined in any of six (3!) ways, e.g. ;; URF, UFR, FRU, FUR, RFU, and RUF; and an edge's two faces may be combined ;; in one of two (2!) ways, e.g. UF and FU. ;; ;; This function sees if two representations refer to the same piece. ;; E.g. UFR is the same as FRU; UFR is not the same as UFL; UFR is not the ;; same as UF. (defun rube-piece-equal (piece-1 piece-2) (let ((length-1 (length (symbol-to-string piece-1))) (length-2 (length (symbol-to-string piece-2)))) (cond ((not (= length-1 length-2)) nil);; Edges and corners can't possibly be the same! ((= length-1 3) ; Corner piece; there are 6 permutations of elts to consider. (let* ((p1 (symbol-to-string piece-1)) (p2 (symbol-to-string piece-2)) (p11 (select-char-in-string p1 0)) (p12 (select-char-in-string p1 1)) (p13 (select-char-in-string p1 2)) (p21 (select-char-in-string p2 0)) (p22 (select-char-in-string p2 1)) (p23 (select-char-in-string p2 2))) (or (and (char= p11 p21) (char= p12 p22) (char= p13 p23)) (and (char= p11 p21) (char= p12 p23) (char= p13 p22)) (and (char= p11 p22) (char= p12 p21) (char= p13 p23)) (and (char= p11 p22) (char= p12 p23) (char= p13 p21)) (and (char= p11 p23) (char= p12 p21) (char= p13 p22)) (and (char= p11 p23) (char= p12 p22) (char= p13 p21))))) ((= length-1 2) ; Edge piece; there are 2 permutation of elts to consider. (let* ((p1 (symbol-to-string piece-1)) (p2 (symbol-to-string piece-2)) (p11 (select-char-in-string p1 0)) (p12 (select-char-in-string p1 1)) (p21 (select-char-in-string p2 0)) (p22 (select-char-in-string p2 1))) (or (and (char= p11 p21) (char= p12 p22)) (and (char= p12 p21) (char= p11 p22))))) ;; The 't' statement keeps this predicate from returning # in Scheme. (t (equal piece-1 piece-2))))) ;; (rube-piece-equal 'UFR 'URF) ;; (rube-piece-equal 'UFR 'URL) ;; (rube-piece-equal 'UFR 'UF) (defun moves-on-piece (moves piece) ;; Need to tune this (auxiliary function?) so that it ;; doesn't check the same piece over and over for corner/edge. ;; Once passed in, it won't change! (cond ((= 3 (length (symbol-to-string piece))) (if (null moves) piece (moves-on-piece (cdr moves) (move-on-corner-piece (car moves) piece)))) ((= 2 (length (symbol-to-string piece))) (if (null moves) piece (moves-on-piece (cdr moves) (move-on-edge-piece (car moves) piece)))))) ;; (moves-on-piece '(U F R) 'UFR) ;; Returns the image of a corner piece under a move. ;; Breaks the piece up into its component faces; looks up the image ;; of each face under the specifed move; then puts the resulting ;; faces back together. ;; ;; What the if-statement does is, if the move (denoted by a face) ;; isn't on the same face as one of the piece's faces, then the ;; piece is unaffected by the move. E.g. URF is affected by F; ;; but URL is not. ;; ;; Both arguments are represented by symbols. (defun move-on-corner-piece (move corner) (let* ((ps (symbol-to-string corner)) (ps0 (select-char-in-string ps 0)) (ps1 (select-char-in-string ps 1)) (ps2 (select-char-in-string ps 2)) (face (select-char-in-string (symbol-to-string move) 0))) (if (or (equal face ps0) (equal face ps1) (equal face ps2)) (intern (concatenate 'string (symbol-to-string (move-on-face move ps0)) (symbol-to-string (move-on-face move ps1)) (symbol-to-string (move-on-face move ps2)))) ; else corner))) ;; (move-on-corner-piece 'F 'URF) ;; (move-on-corner-piece 'F 'URL) ;; Returns the image of an edge piece under a move. ;; Breaks the piece up into its component faces; looks up the image ;; of each face under the specifed move; then puts the resulting ;; faces back together by turning a string into a symbol. ;; (See Steele's CLTL for a description of the difference between ;; intern and make-symbol. For me, the relevant difference is that ;; a symbol created with make-symbol prints with a leading #: (ugly), ;; whereas a symbol created with intern doesn't (pretty). ;; ;; What the if-statement does is, if the move (denoted by a face) ;; isn't on the same face as one of the piece's faces, then the ;; piece is unaffected by the move. E.g. UF is affected by F; ;; but UR is not. ;; ;; Both arguments are represented by symbols. (defun move-on-edge-piece (move edge) (let* ((ps (symbol-to-string edge)) (ps0 (select-char-in-string ps 0)) (ps1 (select-char-in-string ps 1)) (face (select-char-in-string (symbol-to-string move) 0))) (if (or (equal face ps0) (equal face ps1)) (intern ;;string->symbol (concatenate 'string (symbol-to-string (move-on-face move ps0)) (symbol-to-string (move-on-face move ps1)))) ;; else edge))) ;; (move-on-edge-piece 'F 'UF) ;; (move-on-edge-piece 'F 'UR) ;; (setf edge 'UF) ;; (setf move 'F) ;; (setf ps (symbol-to-string edge)) ;; (setf ps0 (select-char-in-string ps 0)) ;; (setf ps1 (select-char-in-string ps 1)) ;; (setf face (select-char-in-string (symbol-to-string move) 0)) ;; (string->symbol "abc") ;; (apropos 'symbol) ;; (symbol "abc") ;; Returns the image of a face under a move. ;; Faces are represented by characters; moves are represented by symbols. ;; Does a simple table lookup. (defun move-on-face (move face) (let ((row-vector (assoc face *move-on-face-table*)) (vector-index (assoc move *move-index-lookup-alist*))) (cond ((equal nil row-vector) (error (format nil "move-on-face: Rule lookup failed for face ~A.~%" (cond ((symbolp face) (symbol-to-string face)) ((stringp face) face) ((characterp face) (symbol-to-string face)))))) ((equal nil vector-index) (error (format nil "move-on-face: Rule lookup failed for move ~A.~%" (cond ((symbolp move) (string move)) ((stringp move) move) ((characterp move) (symbol-to-string move)))))) (t (aref (cdr row-vector) (cdr vector-index)))))) ;; (move-on-face 'U #\F) ;; (setf face #\F) ;; (setf move 'U) ;;;; ----------------------------------------------------------------------------- ;;;; RUBE DATA SECTION -- lookup tables. ;; The names of three adjacent faces provides the name of a corner piece. ;; However, those three faces may be combined in any of six ways, e.g. ;; URF, UFR, FRU, FUR, RFU, and RUF. ;; This variable contains all such names in which the faces are listed ;; in a clockwise direction. This could be calculated at run-time, ;; but it seems simpler to do a table lookup. (defvar *clockwise-orient-list* '(URF UFL ULB UBR DFR DRB DBL DLF RFU FLU LBU BRU FRD RBD BLD LFD FUR LUF BUL RUB RDF BDR LDB FDL)) ;; Data for the image of a face under a move. Faces are down the table; moves are across. ;; Faces are represented as characters; moves are represented by symbols. ;; Key into this table by face to get an array of images of that face. ;; Index into the resulting array, using the *move-index-lookup-alist*, to get ;; the image of the specified face under the specified move. (defvar *move-on-face-table* ;; F+ R+ B+ L+ U+ D+ F- R- B- L- U- D- F2 R2 B2 L2 U2 D2 ;; FRBLUD going down '((#\F . #( #\F #\U #\F #\D #\L #\R #\F #\D #\F #\U #\R #\L #\F #\B #\F #\B #\B #\B )) (#\R . #( #\D #\R #\U #\R #\F #\B #\U #\R #\D #\R #\B #\F #\L #\R #\L #\R #\L #\L )) (#\B . #( #\B #\D #\B #\U #\R #\L #\B #\U #\B #\D #\L #\R #\B #\F #\B #\F #\F #\F )) (#\L . #( #\U #\L #\D #\L #\B #\F #\D #\L #\U #\L #\F #\B #\R #\L #\R #\L #\R #\R )) (#\U . #( #\R #\B #\L #\F #\U #\U #\L #\F #\R #\B #\U #\U #\D #\D #\D #\D #\U #\R )) (#\D . #( #\L #\F #\R #\B #\D #\D #\R #\B #\L #\F #\D #\D #\U #\U #\U #\U #\D #\D )))) ;; See above comment. (defvar *move-index-lookup-alist* '((F+ . 0) (R+ . 1) (B+ . 2) (L+ . 3) (U+ . 4) (D+ . 5) (F- . 6) (R- . 7) (B- . 8) (L- . 9) (U- . 10) (D- . 11) (F2 . 12) (R2 . 13) (B2 . 14) (L2 . 15) (U2 . 16) (D2 . 17) (F . 0) (R . 1) (B . 2) (L . 3) (U . 4) (D . 5) (F-1 . 6) (R-1 . 7) (B-1 . 8) (L-1 . 9) (U-1 . 10) (D-1 . 11) (f+ . 0) (r+ . 1) (b+ . 2) (l+ . 3) (u+ . 4) (d+ . 5) (f- . 6) (r- . 7) (b- . 8) (l- . 9) (u- . 10) (d- . 11) (f2 . 12) (r2 . 13) (b2 . 14) (l2 . 15) (u2 . 16) (d2 . 17) (f . 0) (r . 1) (b . 2) (l . 3) (u . 4) (d . 5) (f-1 . 6) (r-1 . 7) (b-1 . 8) (l-1 . 9) (u-1 . 10) (d-1 . 11))) ;; A table to show the inverse of any move. (defvar *invert-move-alist* '((F+ . F-) (R+ . R-) (B+ . B-) (L+ . L-) (U+ . U-) (D+ . D-) (F- . F+) (R- . R+) (B- . B+) (L- . L+) (U- . U+) (D- . D+) (F2 . F2) (R2 . R2) (B2 . B2) (L2 . L2) (U2 . U2) (D2 . D2) (F . F-) (R . R-) (B . B-) (L . L-) (U . U-) (D . D-) (F- . F ) (R- . R ) (B- . B ) (L- . L ) (U- . U ) (D- . D ) (f+ . f-) (r+ . r-) (b+ . b-) (l+ . l-) (u+ . u-) (d+ . d-) (f- . f+) (r- . r+) (b- . b+) (l- . l+) (u- . u+) (d- . d+) (f2 . f2) (r2 . r2) (b2 . b2) (l2 . l2) (u2 . u2) (d2 . d2) (f . f-) (r . r-) (b . b-) (l . l-) (u . u-) (d . d-) (f- . f ) (r- . r ) (b- . b ) (l- . l ) (u- . u ) (d- . d ))) ;; A table of all the movable pieces (i.e., not including centers) ;; on the cube. (defvar *rube-list-of-all-pieces* '(UFR UFL UBL UBR DFR DFL DBL DBR UF UL UB UR FR FL BL BR DF DL DB DR)) ;;;; ----------------------------------------------------------------------------- ;;;; RUBE EXPONENT SECTION ;; Inverting a list of moves means reversing it and replacing each ;; individual move with its inverse -- ( A * B )^-1 = B^-1 * A^-1. (defun invert-moves (proc) (cond ((null proc) '()) ((not (listp proc)) (list proc)) (t (append (invert-moves (cdr proc)) (list (invert-move (car proc))))))) (defun invert-move (move) (let ((inv (assoc move *invert-move-alist*))) (cond ((equal nil inv) (error (string-append "invert-move: Couldn\'t find inverse for " (cond ((symbolp move) (symbol-to-string move)) ((characterp move) (symbol-to-string move))) "\n"))) (t (cdr inv))))) (defun power-of-sequence (moves power) (cond ((= power 0) '()) ((= power 1) moves) ((> power 1) (append moves (power-of-sequence moves (- power 1)))) ((= power -1) (invert-moves moves)) ((< power -1) (power-of-sequence (invert-moves moves) (- power))))) (defun rube-conjugate (proc1 proc2) ;; This returns the conjugate of A by B, denoted A * B * A^-1. (let ((lproc1 (if (symbolp proc1) (list proc1) proc1)) (lproc2 (if (symbolp proc2) (list proc2) proc2))) (append lproc1 lproc2 (invert-moves lproc1)))) ;; This returns the commutator of two moves or list of moves on the ;; Rubik's Cube. In group theory, the commutator of A and B, denoted ;; by [A B], is defined to be A * B * A^-1 * B^-1. [A B] == the identity ;; sequence precisely when A and B commute (i.e. when A*B == B*A). (defun commutator (proc1 proc2) (let ((lproc1 (if (symbolp proc1) (list proc1) proc1)) (lproc2 (if (symbolp proc2) (list proc2) proc2))) (append lproc1 lproc2 (invert-moves lproc1) (invert-moves lproc2)))) ;; (defun order (cycle-list) ;; (apply #'lcm (map cycle-length cycle-list))) (defun order (moves) (apply #'lcm (mapcar #'cycle-length (cycle-decomposition moves)))) (defun cycle-length (cycle) (cond ((or (equal (last cycle) '+) (equal (last cycle) '-)) (let ((edge-or-corner (length (symbol-to-string (car cycle))))) (cond ((= edge-or-corner 3) (* 3 (- (length cycle) 1))) ((= edge-or-corner 2) (* 2 (- (length cycle) 1))) (t (length cycle))))) (t (length cycle)))) ;;;; ----------------------------------------------------------------------------- ;;;; RUBE PPRINT SECTION ;; This is a function to print output of cycle-decompose with nice line breaks. ;; Actually what is does is print the elements of any list one line at a time. (defun rube-pprint (lst) (labels ((rube-pprint-aux (lst) (cond ((null lst) nil) ((not (consp lst)) (format t "~A~%" lst)) (t (progn (format t "~A~%" (car lst)) (rube-pprint-aux (cdr lst))))))) (rube-pprint-aux lst)) (values)) ;; (rube-pprint '(a b c d e)) ;; (rube-pprint '((a b) (c d) (e f))) ;;;; ----------------------------------------------------------------------------- ;;;; TESTS ;; (mapcar #'(lambda (x) (move-on-face 'U x)) '(#\F #\R #\B #\L #\U #\D)) ;; (setf forward-moves '(F R B L U D)) ;; (setf backward-moves '(F- R- B- L- U- D-)) ;; (setf double-moves '(F2 R2 B2 L2 U2 D2)) ;; (mapcar #'(lambda (x) (move-on-edge-piece x 'UF)) forward-moves) ;; (mapcar #'(lambda (x) (move-on-edge-piece x 'UF)) backward-moves) ;; (mapcar #'(lambda (x) (move-on-edge-piece x 'UF)) double-moves) ;; (mapcar #'(lambda (x) (move-on-edge-piece x 'FU)) forward-moves) ;; (mapcar #'(lambda (x) (move-on-edge-piece x 'FU)) backward-moves) ;; (mapcar #'(lambda (x) (move-on-edge-piece x 'FU)) double-moves) ;; (mapcar #'(lambda (x) (move-on-corner-piece x 'UFR)) forward-moves) ;; (mapcar #'(lambda (x) (move-on-corner-piece x 'UFR)) backward-moves) ;; (mapcar #'(lambda (x) (move-on-corner-piece x 'UFR)) double-moves) ;; (rube-piece-equal 'UFR 'FRU) ;; (rube-piece-equal 'Ufr 'FUR) ;; (rube-piece-equal 'FUR 'FUR) ;; (rube-piece-equal 'FUR 'FU) ;; ;; (sign-of-rotation 'UFR 'FRU) ;; (sign-of-rotation 'UFR 'UFR) ;; (sign-of-rotation 'UFR 'URF) ;; (sign-of-rotation 'UFR 'FR) ;; (sign-of-rotation 'RF 'FR) ;; (sign-of-rotation 'RF 'RF) ;; ;; (memtree 'UF '(FR UR BL DL)) ;; (memtree 'U '(F R B U)) ;; (rube-piece-equal 'U 'F) ;; (moves-on-piece '(F) (moves-on-piece '(F) (moves-on-piece '(F)(moves-on-piece '(F) 'UFR)))) ;; ;; (find-cycle 'UFR '(F)) ;; (find-cycle 'UF '(U2)) ;; (find-cycle 'UFR '(F)) ;; (find-cycle 'UFR '(F R B L)) ;; (find-cycle 'UF '(B)) ;; (find-cycle 'UF '(F R)) ;; (find-cycle 'UF (power-of-sequence '(F2 R2) 2)) ;; (find-cycle 'UF (power-of-sequence '(F2 R2) 3)) ;; (find-cycle 'UFR '(F R)) ;; (find-cycle 'UFR '(F R B L)) ;; ;; (invert-moves '(F+ R+ B+ L+)) ;; (rube-conjugate '(F R) '(B L)) ;; (commutator '(F R) '(B L)) ;; (rube-conjugate '(B) (power-of-sequence '(L U L- U-) 3)) ;; ;; (cycle-decomposition '(F R B L)) ;; (cycle-decomposition (power-of-sequence '(F R) 2)) ;; (cycle-decomposition '(B- U2 B2 U B- U- B- U2 F R B R- F-)) ;; (cycle-decomposition '(R L- F R- L D2 R L- F R- L)) ;; (cycle-decomposition (power-of-sequence '(B R- D2 R B- U2) 1)) ;; (cycle-decomposition (power-of-sequence '(B R- D2 R B- U2) 2)) ;; (cycle-decomposition (power-of-sequence '(F R) 2)) ;; (cycle-decomposition (power-of-sequence '(F2 R2) 6)) ;; (cycle-decomposition ;; '(R L- F R- L D ;; R L- F R- L D ;; R L- F2 R- L D ;; R L- F R- L D ;; R L- F R- L D2)) ;; (moves-on-pieces (power-of-sequence '(B R- D2 R B- U2) 2) *rube-list-of-all-pieces*) ;; (moves-on-pieces '(R L- F R- L D2 R L- F R- L) '(DR DB DL)) ;; (moves-on-pieces '(R L- F R- L D2 R L- F R- L) *rube-list-of-all-pieces*) ;; (moves-on-pieces (power-of-sequence '(B R- D2 R B- U2) 2) *rube-list-of-all-pieces*) ;; (pared-moves-on-all-pieces '(R L- F R- L D2 R L- F R- L)) ;; (pared-moves-on-all-pieces (power-of-sequence '(B R- D2 R B- U2) 2)) ;; (pared-moves-on-all-pieces (power-of-sequence '(F2 R2) 2)) ;; ;; (order (power-of-sequence '(B R- D2 R B- U2) 2)) ;; (order '(R L- F R- L D2 R L- F R- L)) ;; (order '(R L- F R- L D2 R L- F R- L)) ;; (order (power-of-sequence '(B R- D2 R B- U2) 2)) ;; (order '(R L- F R- L D2 R L- F R- L)) ;; (order (power-of-sequence '(B R- D2 R B- U2) 2)) ;; (order (power-of-sequence '(F2 R2) 2)) ;; (order '(F R B L)) ;; (order '(F2 R2)) ;; (order '(F R)) ;; (order '(F R-)) ;; (order '(F R2)) ;; (order '(F U R)) ;; (order '(F U R B D L)) ;; (order '(F U R B L D)) ;; (order '(F)) ;; ;; (setf moves '(F2 R2)) (defun tell-about (moves) (format t "-- Sequence is: ~%~A~%~%" moves) (format t "-- Image is: ~%~A~%~%" (pared-moves-on-all-pieces moves)) (format t "-- Cycle decomposition is: ~%~A~%~%" (cycle-decomposition moves)) (format t "-- Order is: ~%~A~%~%" (order moves)) (values)) (defun tell-about (moves) (format t "~%-- Sequence is: ~%~A~%" moves) (format t "~%-- Image is: ~%") (rube-pprint (pared-moves-on-all-pieces moves)) (format t "~%-- Cycle decomposition is: ~%") (rube-pprint (cycle-decomposition moves)) (format t "~%-- Order is: ~%~A~%~%" (order moves)) (values)) ;; (values) to avoid having a return value from this defun print out. ;; rube-pprint prints each element of a list on a line by itself; ;; format with a ~A prints all the elements of a list on one line. ;; ;; So I could use these in tell-about -- having each list element on a ;; single line makes output more readable, but on the other hand makes ;; the window scroll a lot. Kind of a trade-off. For now, I'm not ;; using these. ;; (rube-pprint (pared-moves-on-all-pieces moves)) ;; (rube-pprint (cycle-decomposition moves)) ;; (tell-about '(F)) ;; (tell-about (power-of-sequence '(B R- D2 R B- U2) 2)) ;; (tell-about '(R L- F R- L D2 R L- F R- L)) ;; (tell-about (power-of-sequence '(F2 R2) 2)) ;; (tell-about '(F R B L)) ;; (tell-about '(F R B L D U)) ;; (tell-about '(R L- F R- L D ;; R L- F R- L D ;; R L- F2 R- L D ;; R L- F R- L D ;; R L- F R- L D2))