結果

問題 No.2986 Permutation Puzzle
ユーザー ID 21712
提出日時 2025-02-03 12:37:12
言語 Common Lisp
(sbcl 2.5.0)
結果
AC  
実行時間 135 ms / 2,000 ms
コード長 2,392 bytes
コンパイル時間 478 ms
コンパイル使用メモリ 33,024 KB
実行使用メモリ 69,760 KB
最終ジャッジ日時 2025-02-03 12:37:17
合計ジャッジ時間 5,424 ms
ジャッジサーバーID
（参考情報） 		judge4 / judge2
このコードへのチャレンジ
（要ログイン）
ファイルパターン 結果
sample AC * 4
other AC * 40
権限があれば一括ダウンロードができます
コンパイルメッセージ
; compiling file "/home/judge/data/code/Main.lisp" (written 03 FEB 2025 12:37:12 PM):

; wrote /home/judge/data/code/Main.fasl
; compilation finished in 0:00:00.049

ソースコード

diff # 

(defun make-int-array (n) (make-array n :element-type 'integer :initial-element 0))

(defun mref (s irow icol r c)
	(aref s (aref irow r) (aref icol c)))

(defun select-col (n s irow icol x) (let 
	((a (make-int-array n)))
	(dotimes (r n a) (setf (aref a r) (mref s irow icol r x)))))

(defun select-row (n s irow icol y) (let 
	((a (make-int-array n)))
	(dotimes (c n a) (setf (aref a c) (mref s irow icol y c)))))

(defun rotate-indexes (n indexes perm) (let
	((a (make-int-array n)))
	(dotimes (i n a) (setf (aref a (aref perm i)) (aref indexes i)))))

(defun findi-map (n f)
	(dotimes (i n)
		(let ((r (apply f (list i))))
			(when r (return r)))))

(defun findi (n f) (findi-map n #'(lambda (i) (when (apply f (list i)) i))))

(defun is-same (n b a irow icol)
	(dotimes (r n t)
		(let ((f (lambda (c) (/= (aref b r c) (mref a irow icol r c)))))
		(when (findi n f) (return)))))

(defun search-ops (n b k a irow icol)
	(if (= k 0) (when (is-same n b a irow icol) '(nil))
		(findi-map (* n 2) #'(lambda (op)
			(let* ((perm (if (< op n) (select-col n a irow icol op) (select-row n a irow icol (- op n))))
				   (icol2 (if (< op n) (rotate-indexes n icol perm) icol))
				   (irow2 (if (< op n) irow (rotate-indexes n irow perm))))
				(map 'list #'(lambda (ops) (cons (cons op perm) ops))
					(search-ops n b (1- k) a irow2 icol2)))))))

(defun expand (n opperm)
	(let* ((op (car opperm))
		   (perm (cdr opperm))
		   (z (aref perm (mod op n)))
		   (zz (* n (floor (/ op n))))
		   (ops nil)
		   (a (rotate-indexes n perm perm)))
		(loop 
			(when (every #'= a perm) (return (reverse ops)))
			(setf ops (cons (+ z zz) ops))
			(setf a (rotate-indexes n a perm))
			(setf z (aref perm z)))))


(defun solve (n k a b)
	(let ((irow (make-int-array n))
		  (icol (make-int-array n)))
		(dotimes (i n)
			(setf (aref irow i) i)
			(setf (aref icol i) i))
		(apply #'append
			(map 'list #'(lambda (x) (expand n x))
				(reverse (car (search-ops n b k a irow icol)))))))

(defun read-matrix (n) (let 
	((a (make-array (list n n) :element-type 'integer :initial-element 0)))
	(dotimes (r n a) (dotimes (c n) (setf (aref a r c) (1- (read)))))))

(let* ((n (read))
	   (k (read))
	   (a (read-matrix n))
	   (b (read-matrix n))
	   (ans (solve n k a b)))
	(format t "~D~%" (length ans))
	(dolist (op ans)
		(if (< op n)
			(format t "C ~D~%" (1+ op))
			(format t "R ~D~%" (- (1+ op) n)))))
0