Bomb dropping algorithm

Question

I have an n x m matrix consisting of non-negative integers. For example:

2 3 4 7 1
1 5 2 6 2
4 3 4 2 1
2 1 2 4 1
3 1 3 4 1
2 1 4 3 2
6 9 1 6 4
         


        

Answer 1

I got 28 moves as well. I used two tests for the best next move: first the move producing the minimum sum for the board. Second, for equal sums, the move producing the maximum density, defined as:

number-of-zeros / number-of-groups-of-zeros

This is Haskell. "solve board" shows the engine's solution. You can play the game by typing "main", then enter a target point, "best" for a recommendation, or "quit" to quit.

OUTPUT:
*Main> solve board
[(4,4),(3,6),(3,3),(2,2),(2,2),(4,6),(4,6),(2,6),(3,2),(4,2),(2,6),(3,3),(4,3),(2,6),(4,2),(4,6),(4,6),(3,6),(2,6),(2,6),(2,4),(2,4),(2,6),(3,6),(4,2),(4,2),(4,2),(4,2)]

import Data.List
import Data.List.Split
import Data.Ord
import Data.Function(on)

board = [2,3,4,7,1,
         1,5,2,6,2,
         4,3,4,2,1,
         2,1,2,4,1,
         3,1,3,4,1,
         2,1,4,3,2,
         6,9,1,6,4]

n = 5
m = 7

updateBoard board pt =
  let x = fst pt
      y = snd pt
      precedingLines = replicate ((y-2) * n) 0
      bomb = concat $ replicate (if y == 1
                                    then 2
                                    else min 3 (m+2-y)) (replicate (x-2) 0 
                                                         ++ (if x == 1 
                                                                then [1,1]
                                                                else replicate (min 3 (n+2-x)) 1)
                                                                ++ replicate (n-(x+1)) 0)
  in zipWith (\a b -> max 0 (a-b)) board (precedingLines ++ bomb ++ repeat 0)

showBoard board = 
  let top = "   " ++ (concat $ map (\x -> show x ++ ".") [1..n]) ++ "\n"
      chunks = chunksOf n board
  in putStrLn (top ++ showBoard' chunks "" 1)
       where showBoard' []     str count = str
             showBoard' (x:xs) str count =
               showBoard' xs (str ++ show count ++ "." ++ show x ++ "\n") (count+1)

instances _ [] = 0
instances x (y:ys)
  | x == y    = 1 + instances x ys
  | otherwise = instances x ys

density a = 
  let numZeros = instances 0 a
      groupsOfZeros = filter (\x -> head x == 0) (group a)
  in if null groupsOfZeros then 0 else numZeros / fromIntegral (length groupsOfZeros)

boardDensity board = sum (map density (chunksOf n board))

moves = [(a,b) | a <- [2..n-1], b <- [2..m-1]]               

bestMove board = 
  let lowestSumMoves = take 1 $ groupBy ((==) `on` snd) 
                              $ sortBy (comparing snd) (map (\x -> (x, sum $ updateBoard board x)) (moves))
  in if null lowestSumMoves
        then (0,0)
        else let lowestSumMoves' = map (\x -> fst x) (head lowestSumMoves) 
             in fst $ head $ reverse $ sortBy (comparing snd) 
                (map (\x -> (x, boardDensity $ updateBoard board x)) (lowestSumMoves'))   

solve board = solve' board [] where
  solve' board result
    | sum board == 0 = result
    | otherwise      = 
        let best = bestMove board 
        in solve' (updateBoard board best) (result ++ [best])

main :: IO ()
main = mainLoop board where
  mainLoop board = do 
    putStrLn ""
    showBoard board
    putStr "Pt: "
    a <- getLine
    case a of 
      "quit"    -> do putStrLn ""
                      return ()
      "best"    -> do putStrLn (show $ bestMove board)
                      mainLoop board
      otherwise -> let ws = splitOn "," a
                       pt = (read (head ws), read (last ws))
                   in do mainLoop (updateBoard board pt)