結果

問題 No.157 2つの空洞
ユーザー okadukiokaduki
提出日時 2015-02-27 01:33:52
言語 Haskell
(9.8.2)
結果
AC  
実行時間 5 ms / 2,000 ms
コード長 1,147 bytes
コンパイル時間 7,581 ms
コンパイル使用メモリ 192,512 KB
実行使用メモリ 7,680 KB
最終ジャッジ日時 2024-06-23 22:12:05
合計ジャッジ時間 6,438 ms
ジャッジサーバーID
(参考情報)
judge5 / judge3
このコードへのチャレンジ
(要ログイン)

テストケース

テストケース表示
入力 結果 実行時間
実行使用メモリ
testcase_00 AC 2 ms
6,812 KB
testcase_01 AC 2 ms
6,816 KB
testcase_02 AC 1 ms
6,944 KB
testcase_03 AC 1 ms
6,944 KB
testcase_04 AC 1 ms
6,940 KB
testcase_05 AC 2 ms
6,944 KB
testcase_06 AC 1 ms
6,940 KB
testcase_07 AC 1 ms
6,944 KB
testcase_08 AC 1 ms
6,940 KB
testcase_09 AC 2 ms
6,948 KB
testcase_10 AC 2 ms
6,940 KB
testcase_11 AC 2 ms
6,940 KB
testcase_12 AC 2 ms
6,944 KB
testcase_13 AC 2 ms
6,940 KB
testcase_14 AC 2 ms
6,940 KB
testcase_15 AC 2 ms
6,940 KB
testcase_16 AC 2 ms
6,944 KB
testcase_17 AC 5 ms
7,680 KB
testcase_18 AC 2 ms
6,940 KB
testcase_19 AC 1 ms
6,944 KB
権限があれば一括ダウンロードができます
コンパイルメッセージ
Loaded package environment from /home/judge/.ghc/x86_64-linux-9.8.2/environments/default
[1 of 2] Compiling Main             ( Main.hs, Main.o )
[2 of 2] Linking a.out

ソースコード

diff #

import Control.Applicative
import Control.Monad
import Data.Maybe (fromJust)
import Text.Printf
import Data.Array
import Debug.Trace

type Pos = (Int,Int)
type Map = Array Pos Char

around (y,x) = [(y,x+1), (y,x-1), (y+1,x), (y-1,x)]

main = do
  [w,h] <- map (read :: String->Int) . words <$> getLine
  xs <- getContents
  let m = listArray ((0,0),(h-1,w-1)) $ filter (/='\n') xs
  print $ solve $ part m (0,0) h w

part :: Map -> Pos -> Int -> Int -> [[Pos]]
part m (y,x) h w
  | y == h = []
  | x == w = part m (y+1,0) h w
  | otherwise = if (m!(y,x)) == '.'
                then pss : part m' (y,x+1) h w
                else part m (y,x+1) h w
    where (m',pss) = fill m (y,x)

fill :: Map -> Pos -> (Map, [Pos])
fill m p
  | m!p == '#' = (m, [])
  | otherwise = let
    (m1,ps1) = fill after (ap!!0)
    (m2,ps2) = fill m1 (ap!!1)
    (m3,ps3) = fill m2 (ap!!2)
    (m4,ps4) = fill m3 (ap!!3)
    in (m4,[p]++ps1++ps2++ps3++ps4)
  where
    after = m // [(p,'#')]
    ap = around p
    
solve [ps1,ps2] = (+(-1)) $ minimum $
                  map (\p1-> minimum $ map (dist p1) ps2) ps1

dist (y1,x1) (y2,x2) = abs (y1 - y2) + abs (x1 - x2)
0