|
0 |
import Control.Arrow
|
|
1 |
import Data.Function
|
|
2 |
import qualified Data.List as L
|
|
3 |
import qualified Data.Set as S
|
|
4 |
import Text.Parsec
|
|
5 |
import Text.Parsec.String
|
|
6 |
|
|
7 |
type Coord = (Int, Int)
|
|
8 |
type Base = (Int, Int, Int) -- x, y, id
|
|
9 |
type BasedCoord = (Int, Int, Int) -- x, y, id
|
|
10 |
|
|
11 |
parseInt = fmap (read :: String -> Int) $ many1 digit
|
|
12 |
parseBaseLoc :: Parser (Int, Int)
|
|
13 |
parseBaseLoc = do
|
|
14 |
x <- parseInt
|
|
15 |
_ <- string ", "
|
|
16 |
y <- parseInt
|
|
17 |
return (x, y)
|
|
18 |
|
|
19 |
readBases :: String -> Either ParseError [Base]
|
|
20 |
readBases s = case parse (sepEndBy parseBaseLoc (char '\n')) "input.txt" s of
|
|
21 |
Right coords -> Right $ zipWith (\(x, y) c -> (x, y, c)) coords [1..]
|
|
22 |
Left err -> Left err
|
|
23 |
|
|
24 |
gridSize = 400
|
|
25 |
allCoords :: [Coord]
|
|
26 |
allCoords =
|
|
27 |
let xs = enumFromTo 0 gridSize
|
|
28 |
ys = enumFromTo 0 gridSize
|
|
29 |
in concat $ map (\xx -> zip (repeat xx) ys) xs
|
|
30 |
|
|
31 |
minBy :: Ord a => Ord b => (a -> b) -> [a] -> a
|
|
32 |
minBy f as = snd $ L.minimum $ zip (map f as) as
|
|
33 |
|
|
34 |
manhattan (x1, y1) (x2, y2) = abs (x1 - x2) + abs (y1 - y2)
|
|
35 |
|
|
36 |
mapToNearest :: [Base] -> Coord -> BasedCoord
|
|
37 |
mapToNearest bs c@(x, y) = let (_, _, b) = minBy (\(xb, yb, b) -> manhattan c (xb, yb)) bs in (x, y, b)
|
|
38 |
|
|
39 |
baseId :: Base -> Int
|
|
40 |
baseId (_, _, b) = b
|
|
41 |
baseCoord :: Base -> Coord
|
|
42 |
baseCoord (x, y, _) = (x, y)
|
|
43 |
|
|
44 |
findInfBases :: [BasedCoord] -> S.Set Int
|
|
45 |
findInfBases bcs =
|
|
46 |
filter (\(x, y, _) -> x == 0 || x == gridSize || y == 0 || y == gridSize) bcs
|
|
47 |
& map baseId
|
|
48 |
& S.fromList
|
|
49 |
|
|
50 |
findAreas :: [Base] -> [(Int, Base)]
|
|
51 |
findAreas bs =
|
|
52 |
let bcs = map (mapToNearest bs) allCoords
|
|
53 |
in let infBases = findInfBases bcs
|
|
54 |
in let goodBases = filter (\(_, _, b) -> not $ S.member b infBases) bs
|
|
55 |
in map (\base@(_, _, b) -> (length $ filter (\(_, _, bcb) -> b == bcb) bcs, base)) goodBases
|
|
56 |
|
|
57 |
findSumDist :: [Base] -> Coord -> Int
|
|
58 |
findSumDist bs c = sum $ map (manhattan c . baseCoord) bs
|
|
59 |
|
|
60 |
countGoodPoints :: [Base] -> Int
|
|
61 |
countGoodPoints bs = length $ filter (\c -> findSumDist bs c < 10000) allCoords
|
|
62 |
|
|
63 |
main = readFile "input.txt" >>= \str -> case readBases str of
|
|
64 |
Right bases -> do
|
|
65 |
putStrLn $ (++) "1: " $ show $ L.maximum $ findAreas bases
|
|
66 |
putStrLn $ (++) "2: " $ show $ countGoodPoints bases
|
|
67 |
Left err -> print err
|