結果

問題 No.2986 Permutation Puzzle
コンテスト
ユーザー ID 21712
提出日時 2024-12-18 22:34:54
言語 Haskell
(9.10.1)
結果
AC  
実行時間 101 ms / 2,000 ms
コード長 2,954 bytes
コンパイル時間 15,694 ms
コンパイル使用メモリ 193,664 KB
実行使用メモリ 8,192 KB
最終ジャッジ日時 2024-12-18 22:35:13
合計ジャッジ時間 5,030 ms
ジャッジサーバーID
（参考情報） 		judge3 / judge4
このコードへのチャレンジ
（要ログイン）
ファイルパターン 結果
sample AC * 4
other AC * 40
権限があれば一括ダウンロードができます
コンパイルメッセージ
Loaded package environment from /home/judge/.ghc/x86_64-linux-9.8.2/environments/default
[1 of 2] Compiling Main             ( Main.hs, Main.o )

Main.hs:9:1: warning: [GHC-94817] [-Wtabs]
    Tab character found here, and in 45 further locations.
    Suggested fix: Please use spaces instead.
  |
9 |         (n, k, a, b) <- readProblem
  | ^^^^^^^^

Main.hs:25:57: warning: [GHC-63394] [-Wx-partial]
    In the use of ‘tail’
    (imported from Prelude, but defined in GHC.List):
    "This is a partial function, it throws an error on empty lists. Replace it with drop 1, or use pattern matching or Data.List.uncons instead. Consider refactoring to use Data.List.NonEmpty."
   |
25 |                 zzs = map (signum op*) $ take (cnt-1) $ tail zs
   |                                                         ^^^^
[2 of 2] Linking a.out

ソースコード

diff # 

module Main where

import Data.Array (Array,listArray,(!),array,bounds)
import Data.List (find,unfoldr,findIndices)
import Data.Maybe (isJust,fromJust)

main :: IO ()
main = do
	(n, k, a, b) <- readProblem
	let ans = solve n k a b
	putStrLn (show $ length ans)
	let f x = if x < 0 then ("R " ++ show (abs x)) else ("C " ++ show x)
	putStr $ unlines $ map f ans

solve :: Int -> Int -> PPuzzle -> PPuzzle -> [Int]
solve n k a b = concat $ reverse $ unfoldr f (ops,a) where
	ops = reverse $ fromJust $ search b k a []
	f ([],_) = Nothing
	f ((op:rest),t) = Just (zzs,(rest,tt)) where
		(p,tt) = if op < 0
					then (selectRow (abs op) t, operateRow (abs op) t)
					else (selectCol op t, operateCol op t)
		zs = abs op : map (p!) zs
		cnt = cycleSize p
		zzs = map (signum op*) $ take (cnt-1) $ tail zs

readAll :: IO [Int]
readAll = map read <$> words <$> getContents

readProblem :: IO (Int, Int, PPuzzle, PPuzzle)
readProblem = do
	(n:k:rest) <- readAll
	let (a, b) = splitAt (n*n) rest
	return (n, k, newPPuzzle n a, newPPuzzle n b)

type Indexes = Array Int Int
type ICol = Indexes
type IRow = Indexes
type Perm = Array Int Int
type Matrix = Array Int Perm

data PPuzzle = PPuzzle (Int, ICol, IRow, Matrix) deriving Show

newPPuzzle :: Int -> [Int] -> PPuzzle
newPPuzzle n vs = PPuzzle (n, icol, irow, matrix) where
	icol = listArray (1,n) [1..n]
	irow = icol
	matrix = listArray (1,n) $ map (listArray (1,n)) $ f vs
	f [] = []
	f xs = let (p,q) = splitAt n xs in p : f q

type Col = Int	
type Row = Int

at :: Row -> Col -> PPuzzle -> Int
at r c (PPuzzle (_,icol,irow,matrix)) = matrix ! (irow ! r) ! (icol ! c)

size :: PPuzzle -> Int
size (PPuzzle(n,_,_,_)) = n

selectCol :: Col -> PPuzzle -> Perm
selectCol x pp = listArray (1,size pp) [at r x pp | r <- [1..size pp]]

selectRow :: Row -> PPuzzle -> Perm
selectRow y pp = listArray (1,size pp) [at y c pp | c <- [1..size pp]]

rotByPerm :: Perm -> Indexes -> Indexes
rotByPerm p s = array (bounds s) [(p!i,s!i) | i <- [1..snd (bounds s)]]

operateCol :: Col -> PPuzzle -> PPuzzle
operateCol x pp@(PPuzzle(n,icol,irow,matrix)) = PPuzzle (n,icol2,irow,matrix)
	where icol2 = rotByPerm (selectCol x pp) icol

operateRow :: Row -> PPuzzle -> PPuzzle
operateRow y pp@(PPuzzle(n,icol,irow,matrix)) = PPuzzle (n,icol,irow2,matrix)
	where irow2 = rotByPerm (selectRow y pp) irow

iter :: PPuzzle -> [Int]
iter pp = [at r c pp | r <- [1..size pp], c <- [1..size pp]]

isSame :: PPuzzle -> PPuzzle -> Bool
isSame p1 p2 = iter p1 == iter p2

search :: PPuzzle -> Int -> PPuzzle -> [Int] -> Maybe [Int]
search b 0 t v = if isSame b t then Just v else Nothing
search b k t v = find isJust xs >>= id
	where
		xs = [search b (k-1) s (e:v) | (e,s) <- cs++rs]
		cs = [(c,operateCol c t) | c <- [1..size t]]
		rs = [(-r,operateRow r t) | r <- [1..size t]]

cycleSize :: Perm -> Int
cycleSize p = (!!1) $ findIndices (ls==) xxs where
	ls = listArray (bounds p) [1..snd (bounds p)]
	xxs = ls : map (rotByPerm p) xxs
0