git.haldean.org aoc-2018 / master
yaas day 6 bb Haldean Brown 1 year, 9 days ago
2 changed file(s) with 118 addition(s) and 0 deletion(s). Raw diff Collapse all Expand all
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
0 224, 153
1 176, 350
2 353, 241
3 207, 59
4 145, 203
5 123, 210
6 113, 203
7 191, 241
8 172, 196
9 209, 249
10 260, 229
11 98, 231
12 305, 215
13 258, 141
14 337, 282
15 156, 140
16 325, 197
17 179, 279
18 283, 233
19 317, 150
20 305, 245
21 67, 109
22 251, 140
23 245, 59
24 173, 105
25 59, 173
26 257, 70
27 269, 110
28 102, 162
29 179, 180
30 324, 112
31 357, 311
32 317, 245
33 239, 112
34 321, 220
35 133, 97
36 334, 99
37 117, 102
38 133, 112
39 222, 316
40 68, 296
41 150, 287
42 263, 263
43 66, 347
44 128, 118
45 63, 202
46 68, 236
47 264, 122
48 77, 243
49 92, 110