fork download
  1. import Control.Monad
  2. import Data.Array
  3. import Control.Exception (handle, SomeException)
  4.  
  5. main :: IO ()
  6. main = handle errorHandler $ (print . minTurns) =<< fmap read getLine
  7.  
  8. errorHandler :: SomeException -> IO ()
  9. errorHandler _ = putStrLn "-1"
  10.  
  11. minTurns :: (Int, Int) -> Int
  12. minTurns x
  13. | x <= (1, 1) = -1
  14. | otherwise = maybe 0 length ls - 1
  15. where ls = search (genBoards True) goal num [initialBoard]
  16. `mplus`
  17. search (genBoards False) goal num [initialBoard]
  18. initialBoard = Board (1, 1) (listArray ((1, 1), x) $ repeat (Tile False 0))
  19. num = uncurry (*) x
  20.  
  21. data Tile = Tile {painted :: Bool, wet :: Int} deriving (Eq, Show)
  22. data Board = Board {pos :: (Int, Int), tiles :: Array (Int, Int) Tile} deriving (Eq, Show)
  23. type Boards = [Board]
  24.  
  25. goal :: Boards -> Bool
  26. goal [] = False
  27. goal ((Board _ ts):_) = all painted $ elems ts
  28.  
  29. genBoards :: Bool -> Boards -> [Boards]
  30. genBoards _ [] = []
  31. genBoards ipass n@(b:bs) = genBoards' b
  32. where
  33. genBoards' (Board p ts) = map (: n) $ allPaints ++ allSteps ++ pass
  34. where
  35. allPaints =
  36. [Board p (ts' // [(i, t {painted = True, wet = 5})])
  37. | (i, t) <- assocs ts, mandist p i == 1, not (painted t)]
  38. allSteps =
  39. [Board i ts'
  40. | (i, t) <- assocs ts, mandist p i == 1, wet t == 0, i `notElemr` map pos bs]
  41. pass = if ipass then [] else [Board p ts']
  42. ts' = fmap dry ts
  43. dry t | w <- wet t, w > 0 = t {wet = w - 1}
  44. | otherwise = t
  45. notElemr :: Eq a => a -> [a] -> Bool
  46. notElemr q = foldr ((&&) . (/=q)) True
  47.  
  48. mandist :: (Int, Int) -> (Int, Int) -> Int
  49. mandist (x1, y1) (x2, y2) = abs (x1 - x2) + abs (y1 - y2)
  50.  
  51. search :: (Eq a, MonadPlus m) => (a -> [a]) -> (a -> Bool) -> Int -> a -> m a
  52. search f g l x = msum $ map (search' [x]) ([l + 3 .. l * 5] :: [Int])
  53. where
  54. search' (y:ys) d
  55. | d == 0 = mzero
  56. | g y = return y `mplus` search' ys d
  57. | otherwise = search' (f y) (d - 1) `mplus` search' ys d
  58. search' _ _ = mzero
  59.  
Success #stdin #stdout 0.56s 6324KB
stdin
(3,3)
stdout
14