https://github.com/johanlindberg/Rubik/blob/master/2x2x2.lisp
| Код |
;;;; Rubik's 2x2x2 Cube
(defpackage :rubik
(:use :cl)
(:export #:make-cube #:scramble #:do-moves #:undo-moves #:match
#:U #:Ui #:D #:Di #:F #:Fi #:B #:Bi #:L #:Li #:R #:Ri #:X #:Y #:Z))
(in-package :rubik)
(defvar *moves* (list '(U . Ui) '(Ui . U)
'(D . Di) '(Di . D)
'(F . Fi) '(Fi . F)
'(B . Bi) '(Bi . B)
'(L . Li) '(Li . L)
'(R . Ri) '(Ri . R)))
;; Public
(defun make-cube (&key (size 2))
"Returns an array representing a (solved) Rubik's cube of size <size>."
(let ((result '()))
(dotimes (f 6) ; face
(let ((rows '()))
(dotimes (r size) ; row
(let ((row '()))
(dotimes (c size) ; column
(push f row))
(push row rows)))
(push rows result)))
(make-array (list 6 size size) :initial-contents (reverse result))))
(defun solvedp (cube)
"Returns T if <cube> is solved, otherwise NIL."
(let ((dimensions (array-dimensions cube)))
(dotimes (f (car dimensions)) ; face
(let ((color (aref cube f 0 0)))
(dotimes (r (cadr dimensions)) ; row
(dotimes (c (caddr dimensions)) ; column
(unless (eq (aref cube f r c) color)
(return-from solvedp))))))
t))
;; Public
(defun scramble (cube &key (n 10))
"Scrambles <cube> using a random sequence of length <n>."
(do-moves cube (generate-random-sequence n)))
(defun generate-random-sequence (length)
(let ((result '())
(moves (mapcar #'car *moves*)))
(tagbody
gen-seq
(dotimes (i length)
;; available-moves contains all moves that won't undo the last one
(let ((available-moves (remove (cdr (assoc (car result) *moves*)) moves)))
(push (nth (random (length available-moves)) available-moves) result)))
;; if the sequence produces a solved cube we try again
(when (solvedp (do-moves (make-cube) (reverse result)))
(go gen-seq)))
(reverse result)))
;; Public
(defun do-moves (cube sequence)
(if (eq sequence '())
cube
(do-moves (funcall (car sequence) cube) (cdr sequence))))
;; Public
(defun undo-moves (cube sequence)
(do-moves cube (reverse (reverse-moves sequence))))
(defun reverse-moves (sequence)
(if (eq sequence '())
'()
(cons (cdr (assoc (car sequence) *moves*))
(reverse-moves (cdr sequence)))))
;; Public
(defun match (cube state)
(assert (equal (array-dimensions cube)
(array-dimensions state)))
(let ((dimensions (array-dimensions state)))
(dotimes (f (car dimensions)) ; face
(dotimes (r (cadr dimensions)) ; row
(dotimes (c (caddr dimensions)) ;column
(unless (eq (aref cube f r c)
(aref state f r c))
(when (numberp (aref state f r c))
(return-from match)))))))
t)
;; Moves
(defmacro define-move (name &rest transformations)
(let ((result '()))
(dolist (transformation transformations)
(let ((temp '())
(previous '()))
(dolist (position transformation)
(when previous
(push `(setf (aref cube ,@previous) (aref cube ,@position)) temp))
(setf previous position))
(push `(let ((temp (aref cube ,@(nth 0 transformation))))
,@(reverse temp)
(setf (aref cube ,@(nth (- (length transformation) 1) transformation)) temp))
result)))
`(defun ,name (cube)
,@(reverse result)
(values cube (solvedp cube)))))
(define-move U ((1 0 0) (5 0 0) (3 0 0) (4 0 0))
((1 0 1) (5 0 1) (3 0 1) (4 0 1))
((0 0 0) (0 1 0) (0 1 1) (0 0 1)))
(define-move Ui ((1 0 0) (4 0 0) (3 0 0) (5 0 0))
((1 0 1) (4 0 1) (3 0 1) (5 0 1))
((0 0 0) (0 0 1) (0 1 1) (0 1 0)))
(define-move D ((1 1 0) (4 1 0) (3 1 0) (5 1 0))
((1 1 1) (4 1 1) (3 1 1) (5 1 1))
((2 0 0) (2 1 0) (2 1 1) (2 0 1)))
(define-move Di ((1 1 0) (5 1 0) (3 1 0) (4 1 0))
((1 1 1) (5 1 1) (3 1 1) (4 1 1))
((2 0 0) (2 0 1) (2 1 1) (2 1 0)))
(define-move F ((0 1 0) (4 1 1) (2 0 1) (5 0 0))
((0 1 1) (4 0 1) (2 0 0) (5 1 0))
((1 0 0) (1 1 0) (1 1 1) (1 0 1)))
(define-move Fi ((0 1 0) (5 0 0) (2 0 1) (4 1 1))
((0 1 1) (5 1 0) (2 0 0) (4 0 1))
((1 0 0) (1 0 1) (1 1 1) (1 1 0)))
(define-move B ((0 0 0) (5 0 1) (2 1 1) (4 1 0))
((0 0 1) (5 1 1) (2 1 0) (4 0 0))
((3 0 0) (3 1 0) (3 1 1) (3 0 1)))
(define-move Bi ((0 0 0) (4 1 0) (2 1 1) (5 0 1))
((0 0 1) (4 0 0) (2 1 0) (5 1 1))
((3 0 0) (3 0 1) (3 1 1) (3 1 0)))
(define-move L ((0 0 0) (3 1 1) (2 0 0) (1 0 0))
((0 1 0) (3 0 1) (2 1 0) (1 1 0))
((4 0 0) (4 1 0) (4 1 1) (4 0 1)))
(define-move Li ((0 0 0) (1 0 0) (2 0 0) (3 1 1))
((0 1 0) (1 1 0) (2 1 0) (3 0 1))
((4 0 0) (4 0 1) (4 1 1) (4 1 0)))
(define-move R ((0 0 1) (1 0 1) (2 0 1) (3 1 0))
((0 1 1) (1 1 1) (2 1 1) (3 0 0))
((5 0 0) (5 1 0) (5 1 1) (5 0 1)))
(define-move Ri ((0 0 1) (3 1 0) (2 0 1) (1 0 1))
((0 1 1) (3 0 0) (2 1 1) (1 1 1))
((5 0 0) (5 0 1) (5 1 1) (5 1 0)))
(defun X (cube)
(L cube)
(Ri cube))
(defun Xi (cube)
(Li cube)
(R cube))
(defun Y (cube)
(U cube)
(Di cube))
(defun Yi (cube)
(Ui cube)
(D cube))
(defun Z (cube)
(F cube)
(Bi cube))
(defun Zi (cube)
(Fi cube)
(B cube))
|
|