Submission #1611165

---

Source Code Expand

{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}

import Debug.Trace
import Data.Maybe
import qualified Data.Set as S
import qualified Data.List as L
import qualified Data.IntMap as M
import qualified Data.Sequence as Q
import qualified Data.ByteString.Char8 as B

import qualified Data.Foldable as F

import Data.Array
import Data.Array.ST
import Control.Monad.ST

type Index = Int
type StartPoints = S.Set (Index, Index)
type Board = (M.IntMap B.ByteString)
type Memo = (M.IntMap (M.IntMap Int))
type Point = (Index,Index)

type Visited s = (ST s) (STUArray s (Int,Int) Int)

d = [(-1, 0), (1, 0), (0, -1), (0, 1)]

make :: Int -> Int -> Visited s
make h w = newArray ((0,0), (h-1,w-1)) 0

dfs :: Board -> Int -> Point -> Int -> Int -> StartPoints
dfs b k (sy,sx) h w = runST $
  make h w
  >>= \visited ->
        dfs' b k (sy,sx) (visited, S.fromList [(sy,sx)]) h w
        >>= \(visited,l) -> return l

dfs' b k p@(y,x) (visited,l) h w =
  if k == 0 then return (visited,l)
  else F.foldlM (\z d -> step (z,p) d) (visited,l) d
  where
    ng y x = y < 0 || y >= h || x < 0 || x >= w
    step ((visited,l),p@(y,x)) (dy,dx) =
      let y' = y + dy
          x' = x + dx
          p' = (y',x')
          k' = k - 1
      in if ng y' x'
      then return (visited,l)
      else readArray visited p'
           >>= \u -> if k' < u || v b y' x' /= '.'
                     then return (visited,l)
                     else writeArray visited p' k' >>
                          dfs' b k' p' (visited, S.insert p' l) h w


listStart :: Board -> Int -> Int -> Int -> StartPoints
listStart b k = dfs b k s
  where
    s = find b 'S'

solve :: [B.ByteString] -> Int
solve (xs:xss) = 1 + ceiling (fromIntegral m / fromIntegral k)
  where
    [h,w,k] = map readInt $ B.words xs
    b = M.fromList $ zip [0..] xss
    s = listStart b k h w
    m = S.foldl' (\z (y,x) -> min z (minimum [y, x, h-y-1, w-x-1])) 1000000000 s

readInt = fst . fromJust . B.readInt
main = B.getContents >>= print . solve .  B.lines

--------------------------------------------------
-- Matrix
--------------------------------------------------
class (Show a) => Matrix a b | a -> b, b -> a where
   v :: a -> Int -> Int -> b
   find :: a -> b -> (Int,Int)
   findAll :: a -> b -> [(Int,Int)]
   update :: a -> Int -> Int -> b -> a
   initMat :: Int -> Int -> b -> a

instance Matrix Memo Int where
  v b i j = (b M.! i) M.! j
  update b i j c = M.update (Just . M.update (\x -> Just c) j) i b
  initMat i j c = M.fromList $ zip [0..(i-1)] $ L.replicate i xs
    where xs = M.fromList $ zip [0..(j-1)] $ L.replicate j c
  findAll b c = concatMap (\(y,xs) -> zip [y,y..] xs) $ M.toList $ M.map (map fst . M.toList . M.filter (== c)) b

instance Matrix Board Char where
  v b i j = B.index (b M.! i) j
  find b c = head tmp3
    where
      tmp = M.map (B.elemIndex c) b
      tmp2 = M.filterWithKey (\i x -> isJust x) tmp
      tmp3 = map (\(i, x) -> (i, fromJust x)) (M.toList tmp2)
  update b i j c = M.update (Just . replace) i b
    where
      replace x = B.append (B.take j x) $ B.cons c (B.drop (j+1) x)

pp b d = M.foldl' (\z' xs -> z' ++ M.foldl' (\z y -> z ++ (if y == d then "x" else show y)) "" xs ++ " ") "" b

Submission Info

Compile Error

Main.hs:86:10: Warning:
    No explicit implementation for
      ‘find’
    In the instance declaration for ‘Matrix Memo Int’

Main.hs:93:10: Warning:
    No explicit implementation for
      ‘findAll’ and ‘initMat’
    In the instance declaration for ‘Matrix Board Char’

Judge Result