1日1個 @nabetani さんの作った問題を解く、どう書くAdventCalendarの7日目です。
今日は本戦( http://atnd.org/events/45016 )がありますので、その参考問題を解きます。過去問じゃないですけど！ 問題は http://nabetani.sakura.ne.jp/hena/ord16lcove/ にあります。
module Doukaku.LCover (solve) where
import Data.List.Split (splitOn)
import Data.Char (ord)
import Data.Maybe (isJust)
type Dots = [(Int, Int)]
type LCover = ((Int, Int), (Int, Int), Int, Int)
boardsize :: Int
boardsize = 10
solve :: String -> String
solve = show' . minimum' . map minArea . allDirections . parse
where
allDirections :: Dots -> [Dots]
allDirections = flip (scanr ($)) $ replicate 3 turnLeft
minimum' xs = let xs' = filter isJust xs
in if null xs' then Nothing else minimum xs'
show' Nothing = "-"
show' (Just x) = show x
parse :: String -> Dots
parse = map pair . splitOn ","
where
pair (x:y:_) = (digit x, digit y)
digit = (subtract (ord '0')) . ord
turnLeft :: Dots -> Dots
turnLeft = map (\(x, y) -> (boardsize - 1 - y, x))
area :: LCover -> Int
area ((x1, x2), (y1, y2), w, h) = (x2 - x1 + 1) * (y2 - y1 + 1) - w * h
isCovered :: Dots -> LCover -> Bool
isCovered ds ((x1, x2), (y1, y2), w, h) = all inIt ds
where
inIt (x, y) = x1 <= x && x <= x2 && y1 <= y && y <= y2
&& (x > x1 + w - 1 || y > y1 + h - 1)
minArea :: Dots -> Maybe Int
minArea ds = minimum' . map area . filter (isCovered ds) $ ls
where
ls = [((x1, x2), (y1, y2), w, h) | x1 <- [0..x2], w <- [1..x2 - x1],
y1 <- [0..y2], h <- [1..y2 - y1]]
x2 = maximum . map fst $ ds
y2 = maximum . map snd $ ds
minimum' [] = Nothing
minimum' xs = Just . minimum $ xs
左上が欠けているL字被覆の最小面積を求めるロジックminAreaを実装し、90度ずつ回転させて4回チャレンジさせています。minAreaは総当りで、全領域を被覆できているL字のうち最小の面積となるものを返しています。昨日解いたテトロミノのように余白をカットするアプローチをとってしまうと、左上の角が埋まっている場合に切り詰めた領域内ではL字が作れず苦しい場合分けを強いられそうなので、切り詰めませんでした。実装時間は1時間をちょっと超えるくらいだと思います。
後、組み込みのminimumはMaybe Intに適用できるため型チェックが通ってしまって初めハマったのですが、この実装ではNothingがJust xよりも小さいので今回の目的には合いません。Just xを優先するようなminimum'を実装して使っています。
http://qiita.com/Nabetani/items/7be4bc2a3514bbfbfc15 に他の方の回答もありますので、見ると参考になるでしょう。