結果

問題 No.179 塗り分け
ユーザー A_kirisakiA_kirisaki
提出日時 2017-05-01 13:51:12
言語 Haskell
(9.8.2)
結果
AC  
実行時間 173 ms / 3,000 ms
コード長 2,435 bytes
コンパイル時間 4,089 ms
コンパイル使用メモリ 201,292 KB
実行使用メモリ 11,400 KB
最終ジャッジ日時 2023-09-30 20:54:18
合計ジャッジ時間 4,477 ms
ジャッジサーバーID
（参考情報） 		judge13 / judge12
このコードへのチャレンジ
（要ログイン）

テストケース

テストケース表示
入力 結果 実行時間
実行使用メモリ
testcase_00 AC 3 ms
7,128 KB
testcase_01 AC 3 ms
7,148 KB
testcase_02 AC 3 ms
7,172 KB
testcase_03 AC 3 ms
7,184 KB
testcase_04 AC 2 ms
7,160 KB
testcase_05 AC 3 ms
7,472 KB
testcase_06 AC 3 ms
7,576 KB
testcase_07 AC 3 ms
7,584 KB
testcase_08 AC 63 ms
11,280 KB
testcase_09 AC 72 ms
11,328 KB
testcase_10 AC 6 ms
9,780 KB
testcase_11 AC 5 ms
9,556 KB
testcase_12 AC 173 ms
11,280 KB
testcase_13 AC 3 ms
7,644 KB
testcase_14 AC 3 ms
7,268 KB
testcase_15 AC 3 ms
7,116 KB
testcase_16 AC 3 ms
7,096 KB
testcase_17 AC 2 ms
7,208 KB
testcase_18 AC 12 ms
11,352 KB
testcase_19 AC 13 ms
11,288 KB
testcase_20 AC 4 ms
8,352 KB
testcase_21 AC 3 ms
7,876 KB
testcase_22 AC 13 ms
11,240 KB
testcase_23 AC 4 ms
8,604 KB
testcase_24 AC 12 ms
11,236 KB
testcase_25 AC 4 ms
8,024 KB
testcase_26 AC 7 ms
11,304 KB
testcase_27 AC 22 ms
11,300 KB
testcase_28 AC 6 ms
9,876 KB
testcase_29 AC 12 ms
11,392 KB
testcase_30 AC 12 ms
11,308 KB
testcase_31 AC 13 ms
11,280 KB
testcase_32 AC 13 ms
11,208 KB
testcase_33 AC 12 ms
11,400 KB
testcase_34 AC 6 ms
10,608 KB
testcase_35 AC 13 ms
11,368 KB
testcase_36 AC 2 ms
7,124 KB
testcase_37 AC 3 ms
7,148 KB
testcase_38 AC 3 ms
7,184 KB
testcase_39 AC 3 ms
7,120 KB
testcase_40 AC 3 ms
7,240 KB
testcase_41 AC 3 ms
7,156 KB
testcase_42 AC 3 ms
7,152 KB
testcase_43 AC 3 ms
7,976 KB
testcase_44 AC 5 ms
9,736 KB
testcase_45 AC 3 ms
7,468 KB
権限があれば一括ダウンロードができます
コンパイルメッセージ
Loaded package environment from /home/judge/.ghc/x86_64-linux-9.6.1/environments/default
[1 of 2] Compiling Main             ( Main.hs, Main.o )
[2 of 2] Linking a.out

ソースコード

diff # 

import Data.Array.Unboxed
import Data.List
import Data.Maybe

type Point = (Int,Int)
type Bitmap = UArray Point Bool

-- テキスト前処理
cropText :: [String] -> [String]
cropText strs = let
  h = length strs
  w = minimum $ map length strs
  indices = map (elemIndices '#') strs
  top = (length $ takeWhile (==[]) indices) 
  bottom = h - (length $ takeWhile (==[]) $ reverse indices)
  left = minimum $ concat indices 
  right = (maximum $ concat indices) +1
  in
     map (drop left) $ map (take right)(drop top $ take bottom strs)
  
textBitmap :: [String] -> Bitmap
textBitmap []  = listArray ((0,0),(0,0)) [False] -- 強引な処理
textBitmap strs  = let
  toBool '#' = True
  toBool '.' = False
  ixs = [(x,y) | y<-[0..(length strs)-1], x<-[0..(maximum $ map length strs)-1]]
  imax = maximum ixs
  in
    array ((0,0),imax) (zip ixs (map toBool $ concat strs))

-- ピクセル移動
-- 失敗したらNothing
shiftPixel :: Bitmap -> Point -> Point -> Maybe Bitmap
shiftPixel b src dest 
  | ps == False && pd == False = Just b
  | ps == False && pd == True  = Just b
  | ps == True  && pd == False = Nothing
  | ps == True  && pd == True  =
      Just $ b // [(src, False), (dest, False)]
  where
    ps = b ! src
    pd = b ! dest

-- 再帰的にチェック
-- 失敗したら探索打ち切り
checkPixels :: Maybe Bitmap -> [(Point,Point)] -> Bool
checkPixels Nothing _ = False
checkPixels (Just b) [] = not $ or $ elems b
checkPixels (Just b) (p:ps) = let
  (src,dest) = p
  b' = shiftPixel b src dest 
  in
    checkPixels b' ps

-- 移動量から移動前後の位置リストを作り探索
checkOneCase :: Bitmap -> Point -> Bool
checkOneCase b (x,y) = let
  (x',y') = maximum $ indices b
  ps = if x >= 0
       then [((xa,ya),(xa+x,ya+y)) | ya <- [0..y'-y], xa <- [0..x'-x]]
       else [((xa,ya),(xa+x,ya+y)) | ya <- [0..y'-y], xa <- [abs x..x']]
  in
    checkPixels (Just b) ps

-- 取りうる移動量全てに対し探索
solveNuriwake :: Bitmap -> Bool
solveNuriwake b = let
  (w,h) = maximum $ indices b 
  ss = [(x,y) | y <- [0..h], x <- [-w..w], not(x<=0 && y==0)]
  n = length $ filter id $ elems b
  in
    if  odd n || n == 0
    then False
    else or $ map (checkOneCase b)  ss
  
main = do
  getLine -- 1行目のサイズは必要ないので無視
  str <- getContents
  let problem = textBitmap . cropText $ lines str
  if solveNuriwake problem
    then putStr "YES"
    else putStr "NO"
0