gcodejam14c.hs

import Data.List (intercalate, transpose)
import Data.Maybe (fromJust)
import GHC.Exts (sortWith)

data Square = Empty | Mine | Click
newtype Minefield = Minefield [[Square]]

instance Show Square where
    show Empty = "."
    show Mine = "*"
    show Click = "c"

instance Show Minefield where
    show (Minefield mf) = intercalate "\n" . map (concatMap show) $ mf

transposeMF (Minefield mf) = Minefield (transpose mf)

possible :: Int -> Int -> Int -> Either String Minefield
possible r c m
    -- Lets us only work on minefields where c >= r
    -- Not really necessary in this solution, but I used it for an earlier idea
    | r > c = fmap transposeMF $ possible c r m

    -- Only one free square
    | f == 1 = Right . Minefield $ [Empty : replicate (c-1) Mine] ++ replicate (r-1) (replicate c Mine)

    -- Only one row
    | r == 1 = Right . Minefield $ [replicate f Empty ++ replicate m Mine]

    -- Couldn't find a rectangle fit
    | null rects = Left "No rect"

    -- Couldn't extend the rectangle
    | null exts = Left ("No fit " ++ show w ++ "×" ++ show h)

    -- Found both a rectangle fit and a valid extension
    | otherwise = Right . Minefield . take r $
        replicate er (line (w+1)) ++
        replicate (h-er) (line w) ++
        [line eb] ++
        replicate (c-h-1) (line 0)

    where
        -- Number of free squares we need to allocate
        f = r*c - m

        -- Get the largest possible rectangle that fits, and which does not leave a single free
        -- square (such a rectangle can't be extended, the single square will never be reached)
        rects = sortWith (\(w,h) -> -w*h) $ [(w,h) | w <- [2..c], h <- [2..r], w*h <= f && w*h /= f-1]
        (w,h) = head rects

        -- Number of free squares outside the rectangle we need to allocate
        rems = f - w*h

        -- The number of possible extensions to the rectangle: on the right and on the bottom
        -- The rectangle is assumed to be in the top left corner
        extR = if c > w then h else 0
        extB = if r > h then w else 0

        -- To extend, we can pick as many as we want on each side except 1
        exts = [(r,b) | r <- 0 : [2..extR], b <- 0 : [2..extB], r + b == rems]
        (er,eb) = head exts

        -- Auxiliary function that writes a row with n empty squares on the left
        line n = replicate n Empty ++ replicate (c-n) Mine

-- Put a click in the top left corner
possibleClick :: Int -> Int -> Int -> Either String Minefield
possibleClick r c m = case possible r c m of
    Left err -> Left err
    Right (Minefield mf) -> Right . Minefield $ putClick mf
    where
        putClick ((c:cs):css) = (Click : cs) : css

doTest :: Int -> Int -> IO ()
doTest n nCases
    | n > nCases = return ()
doTest n nCases = do
    [r, c, m] <- getLine >>= return . map read . words
    putStrLn $ "Case #" ++ show n ++ ":"
    case possibleClick r c m of
        Left _ -> putStrLn "Impossible"
        Right mf -> print mf
    doTest (n+1) nCases

main = do
    nCases <- readLn :: IO Int
    doTest 1 nCases