fork download 
  1. import Data.Array
  2. import Data.Monoid
  3. import Data.Foldable (foldMap)
  4.  
  5. main :: IO ()
  6. main = (print . minTurns) =<< fmap read getLine
  7.  
  8. minTurns :: (Int, Int) -> Int
  9. minTurns x
  10.   | x < (0, 0) = -1
  11.   | otherwise  =
  12.     let ls = search genBoards goal (uncurry (*) x) [initialBoard x]
  13.     in case ls of Nothing -> -1; Just a  -> length a - 1
  14.  
  15. data Tile = Tile {painted :: Bool, wet :: Int} deriving (Eq)
  16. data Board = Board {pos :: (Int, Int), tiles :: Array (Int, Int) Tile} deriving (Eq)
  17. type Boards = [Board]
  18.  
  19. initialBoard :: (Int, Int) -> Board
  20. initialBoard x = Board (1, 1) (listArray ((1, 1), x) $ repeat (Tile False 0))
  21.  
  22. goal :: Boards -> Bool
  23. goal []                = False
  24. goal ((Board _ ts):_)  = all painted $ elems ts
  25.  
  26. mandist :: (Int, Int) -> (Int, Int) -> Int
  27. mandist (x1, y1) (x2, y2) = abs (x1 - x2) + abs (y1 - y2)
  28.  
  29. genBoards :: Boards -> [Boards]
  30. genBoards [] = []
  31. genBoards n@(b:_) = genBoards' b
  32.   where
  33.     genBoards' (Board p ts) = [b' : n | b' <- allPaints ++ allSteps ++ [Board p ts']]
  34.       where
  35.         allPaints :: Boards
  36.         allPaints =
  37.           [Board p (ts' // [(i, t {painted = True, wet = 5})])
  38.             | (i, t) <- assocs ts, mandist p i == 1, not (painted t)]
  39.         allSteps :: Boards
  40.         allSteps =
  41.           [Board i ts'
  42.             | (i, t) <- assocs ts, mandist p i == 1, wet t == 0]
  43.         ts' = fmap (\t -> t {wet = dry t}) ts
  44.         dry t | w <- wet t, w > 0 = w - 1
  45.               | otherwise         = 0
  46.  
  47. search :: (Eq a) => (a -> [a]) -> (a -> Bool) -> Int -> a -> Maybe a
  48. search f g l x = getFirst $ foldMap (search' ([x])) ([l..] :: [Int])
  49.   where
  50.     search' (y:ys) d
  51.       | d == 0    = mempty
  52.       | g y       = First $ Just y
  53.       | otherwise =
  54.         search' (f y) (d - 1) <> search' ys d
  55.     search' _ _   = mempty
  56.  
Success #stdin #stdout 0.17s 6304KB
comments (?)
stdin 
(3,2)
stdout 
9
https://ideone.com/6kdpdT
language:
Haskell (ghc 8.4.4)
created:
12 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!