Rubik's Cube 2*2

README.md

使用 elisp 解魔方

运行方法：

加载好所有函数和变量后

M-: (run)

cube.el

;; use lexical scope
(setq lexical-binding t)

(defun make-yqueue ()
  (let ((new-queue (make-record 'yyqueue 3 nil)))
    (aset new-queue 1 0)
    new-queue))

(defun yqueue-push (yq val)
  (cond
   ((eq (aref yq 1) 0)
    (aset yq 1 1)
    (let ((newcon (list val)))
      (aset yq 2 newcon)
      (aset yq 3 newcon)))
   (t
    (aset yq 1 (+ (aref yq 1) 1))
    (setcdr (aref yq 3) (list val))
    (aset yq 3 (cdr (aref yq 3))))))

(defun yqueue-pop (yq)
  (cond
   ((eq (aref yq 1) 0) nil)
   (t
    (let ((v (car (aref yq 2))))
      (cond
       ((eq (aref yq 2) (aref yq 3))
	(aset yq 1 0)
	(aset yq 2 nil)
	(aset yq 3 nil))
       (t
	(aset yq 1 (- (aref yq 1) 1))
	(aset yq 2 (cdr (aref yq 2)))))
      v))))

(defun yqueue-null? (yq)
  (eq (aref yq 1) 0))

(defun yqueue-length (yq)
  (aref yq 1))

;;rotate operations' name
(setq op_name (vector 'F+ 'F2 'F-
		      'R+ 'R2 'R-
		      'U+ 'U2 'U-))

(setq rot_tablemap
      [
       ;; F+ F2 and F-
       [6 7 8 0 1 2 9 10 11 3 4 5 12 13 14 15 16 17 18 19 20 21 22 23]
       [9 10 11 6 7 8 3 4 5 0 1 2 12 13 14 15 16 17 18 19 20 21 22 23]
       [3 4 5 9 10 11 0 1 2 6 7 8 12 13 14 15 16 17 18 19 20 21 22 23]
       ;; R+ R2 and R-
       [0 1 2 11 9 10 6 7 8 22 23 21 12 13 14 4 5 3 18 19 20 17 15 16]
       [0 1 2 21 22 23 6 7 8 15 16 17 12 13 14 9 10 11 18 19 20 3 4 5]
       [0 1 2 17 15 16 6 7 8 4 5 3 12 13 14 22 23 21 18 19 20 11 9 10]
       ;; U+ U2 and U-
       [5 3 4 16 17 15 6 7 8 9 10 11 1 2 0 14 12 13 18 19 20 21 22 23]
       [15 16 17 12 13 14 6 7 8 9 10 11 3 4 5 0 1 2 18 19 20 21 22 23]
       [14 12 13 1 2 0 6 7 8 9 10 11 16 17 15 5 3 4 18 19 20 21 22 23]
       ])

(defmacro atab (tab x y)
  `(aref (aref ,tab ,x) ,y))

(defun cuberot (v op)
  "rotate the cube with operation op"
  (let ((i 0)
	(vec (make-vector 24 0)))
    (while (< i 24)
      (aset vec i (aref v (atab rot_tablemap op i)))
      (setq i (+ i 1)))
    vec))

;; reverse op
(setq rot_reverse_table
      [2 1 0 5 4 3 8 7 6])

;; the pos's color, from 0 to 5
(setq color_table
      [[0  3  6  9 ]
       [1  8  14 19]
       [2  4  13 17]
       [5  10 16 23]
       [7  11 20 22]
       [12 15 18 21]])

;; position infot to color info
(defun pos-to-color (v) ;length : 24
  (let ((i 0)
	(j 0)
	(k 0))
    (while (< i 24)
      (setq j 0)
      (while (< j 6)
	(setq k 0)
	(while (< k 4)
	  (when (= (aref v i) (atab color_table j k))
	    (aset v i j))
	  (setq k (+ k 1)))
	(setq j (+ j 1)))
      (setq i (+ i 1)))))


;; the six^n, 0 <= n < 24
(setq pow_of_six ;length: 24
      [1 6 36 216 1296 7776 46656 279936 1679616 10077696
	 60466176 362797056 2176782336 13060694016 78364164096
	 470184984576 2821109907456 16926659444736 101559956668416
	 609359740010496 3656158440062976 21936950640377856 131621703842267136 789730223053602816])


(defun color-to-keynum (v) ;; v is color vector
  (let ((i 0)
	(n 0))
    (while (< i 24)
      (setq n (+ n (* (aref v i) (aref pow_of_six i))))
      (setq i (+ i 1)))
    n))

(defun keynum-to-color (n)
  (let ((res (make-vector 24 0))
	(i 0))
    (while (not (= n 0))
      (aset res i (% n 6))
      (setq n (/ n 6))
      (setq i (+ i 1)))
    res))

(defun bfs (init-cube target-color)
  (let ((step-hash (make-hash-table :size 1000))
	(queue (make-yqueue))
	(target-num (color-to-keynum target-color)))
    (let* ((init-color (progn
			 (pos-to-color init-cube)
			 init-cube))
	   (init-keynum (color-to-keynum init-color))
	   (res))
      (catch 'finish
	(yqueue-push queue init-keynum)
	(puthash init-keynum '(-1) step-hash)
	(while t
	  (let* ((que-size (yqueue-length queue))
		 (i 0))
	    (while (< i que-size)
	      (let* ((kurr-val (yqueue-pop queue))
		     (j 0))
		(while (< j 9)
		  (let* ((kv (keynum-to-color kurr-val))
			 (rotv (cuberot kv j))
			 (k-r-n (color-to-keynum rotv)))
		    (if (gethash k-r-n step-hash) (setq j (+ j 1))
		      (let ((kstep-list (gethash kurr-val step-hash)))
			(puthash k-r-n (cons j kstep-list) step-hash)
			(if (= k-r-n target-num)
			    (progn (setq res (gethash k-r-n step-hash))
				   (throw 'finish
					  (progn
					    (setq result
						  (mapcar
						   (lambda (x) (aref op_name x))
						   (cdr (seq-reverse res))))
					    result)))
			  (progn (yqueue-push queue k-r-n)
				 (setq j (+ j 1)))))))))
	      (setq i (+ i 1)))))))))




(setq std-cube [0 1 2 3 4 5 6 7 8 9 10
		  11 12 13 14 15 16 17 18 19 20 21 22 23])

(setq my-cube [10 11 9 5 3 4 6 7 8 22 23 21 1 2 0 14 12 13 18 19 20 17 15 16])

(progn
  (setq tar-cube (seq-copy std-cube))
  (pos-to-color tar-cube))

(defun run ()
  (bfs (seq-copy my-cube) tar-cube))

(run)
(message "%s" result)