Haskell で AtCoder ABC 395 A-E

A

　問題文 : https://atcoder.jp/contests/abc395/tasks/abc395_a
　リスト as の隣接要素の関係を見るイディオムとして，id as と tail as に分けて zipWith をするというのをよく使っています．今回の場合は，それらを (<) で zipWith すると [Bool] になるので，これが全部 True かを and で判定すれば解けます．
　Control.Arrow にある (&&&) を使うと id as と tail as のタプルを作れるので，これを uncurry した zipWith (<) に渡せば大体ワインライナーになります．

main = getLine >> readInts >>= putStrLn . yesno . and . uncurry ( zipWith (<) ) . ( id &&& tail )

B

　問題文 : https://atcoder.jp/contests/abc395/tasks/abc395_b
　位置 $( i, j )$ ($0$-indexed) に入る文字は $\min \{ i, n - 1 - i, j, n - 1 - j \}$ の奇遇で決まります．適当な方法で [String] を作ればよいですが，横に長くなりすぎるのもいやなので二重の do で．

main = do
	n <- readInt
	mapM_ putStrLn $ do
		i <- [ 0 .. n - 1 ]
		return $ do
			j <- [ 0 .. n - 1 ]
			return $ if even $ minimum [ i, ( n - 1 - i ), j, ( n - 1 - j ) ]
				then '#'
				else '.'

C

　問題文 : https://atcoder.jp/contests/abc395/tasks/abc395_c
　値毎にその出現位置の添字を順に並べた列を作って，「それぞれの中での隣接要素の差の最小値」の最小値が答えになります．値ごとに添え字を並べるので欲しいのはプリミティブには [[Int]] ですが，ランダムアクセスが必要そうに見えてリストだと遅いので，[Int] の配列を作ります．配列を作るのであれば accumArray という超絶便利関数が使えて，初期値を [] として (:) で足し込んでいけばよいです．地味に (:) の引数の順序が逆で困りますが，flip すれば OK です．足し込み操作の列は zip as [ 1 .. ] で作れます．
　配列が作れたら，A 問題と同じような考え方で uncurry ( zipWith (-) ) . ( id &&& tail ) を concatMap して中身があればそれが（ほぼ）答えです（空なら -1）．

main = do
	n <- readInt
	as <- readInts
	let
		res = concatMap ( uncurry ( zipWith (-) ) . ( id &&& tail ) ) $ accumArray ( flip (:) ) [] ( 1, 1000000 ) $ zip as [ 1 .. ]
	print $ if null res then -1 else minimum res + 1

D

　問題文 : https://atcoder.jp/contests/abc395/tasks/abc395_d
　クエリ 2. について，巣の中身を入れ替えるのではなく，中身をその場に残して（名前付きの）巣だけを挿げ替えると考えます．高速にシミュレートするために，各巣について

• 元々の位置から現在位置への表
• 位置から名前への表

を管理り，各鳩について

• 自分が属する箱の現在位置

を管理します．
　ミュータブルな配列を 3 本使って実装します．基本的な操作しか知らないせいなのか，実装がつらい……．クエリの種類による場合分けをパターンマッチで処理できるのはいい感じ．

main = do
	[ n, q ] <- readInts
	queries <- replicateM q readInts
	mapM_ print $ solve n queries

swapArrayElem a i1 i2 = do
	x <- readArray a i1
	y <- readArray a i2
	writeArray a i1 y
	writeArray a i2 x

solve n queries = runST $ do
	arrays <- replicateM 3 ( newListArray ( 1, n ) [ 1 .. n ] :: ST s ( STUArray s Int Int ) )
	let	[ boxes_name, boxes_pos, pigeons ] = arrays
	res <- newSTRef []
	forM_ queries $ \query -> case query of
		[ 1, a, b ] -> do
			writeArray pigeons a =<< readArray boxes_pos b
		[ 2, a, b ] -> do
			x <- readArray boxes_pos a
			y <- readArray boxes_pos b
			swapArrayElem boxes_name x y
			swapArrayElem boxes_pos a b
		[ 3, a ] -> do
			modifySTRef res =<< (:) <$> ( readArray boxes_name =<< readArray pigeons a )
	reverse <$> readSTRef res

E

　問題文 : https://atcoder.jp/contests/abc395/tasks/abc395_e
　$( \text{現在位置}, \text{辺を反転中かを表す Boolean} )$ を頂点にして Dijkstra 法をします．順位キューを提供しているのが標準っぽくなさそうな雰囲気なので，Data.Set を順位キューとして使います．

main = do
	[ n, m, x ] <- readInts
	es <- replicateM m readInts
	let
		[ g, gr ] = map ( accumArray ( flip (:) ) [] ( 1, n ) . map mp ) [ es, map reverse es ]
	print $ solve g gr x

solve g gr x = runST $ do
	let ( _, n ) = bounds g
	distances <- newArray ( ( 1, 0 ), ( n, 1 ) ) ( 10^18 ) :: ST s ( STArray s ( Int, Int ) Int )
	writeArray distances ( 1, 0 ) 0
	dijkstra distances ( Set.singleton ( 0, 1, 0 ) )
	res1 <- readArray distances ( n, 0 )
	res2 <- readArray distances ( n, 1 )
	return $ min res1 res2
	where
	dijkstra distances que = do
		when ( not $ Set.null que ) $ do
			let ( d, u, r ) = Set.elemAt 0 que
			dist <- readArray distances ( u, r )
			updates <- newSTRef []
			let
				update v r' c = do
					dist' <- readArray distances ( v, r' )
					when ( d + c < dist' ) $ do
						writeArray distances ( v, r' ) ( d + c )
						modifySTRef updates ( ( d + c, v, r' ) : )
			when ( dist == d ) $ do
				forM_ ( ( if r == 0 then g else gr ) ! u ) $ \v -> do
					update v r 1
				update u ( 1 - r ) x
			dijkstra distances =<< foldl ( flip Set.insert ) ( Set.drop 1 que ) <$> readSTRef updates