this repo has no description
1module Millisecond03 where
2
3import Data.List
4import qualified Data.Map.Strict as M
5
6data Direction = R | U | L | D deriving (Show)
7
8move :: (Int, Int) -> Direction -> (Int, Int)
9move (x, y) R = (x + 1, y)
10move (x, y) U = (x, y + 1)
11move (x, y) L = (x - 1, y)
12move (x, y) D = (x, y - 1)
13
14directions :: [Direction]
15directions = [R, U, L, D]
16
17moves :: [Direction]
18moves = concat $ zipWith replicate (concat $ zipWith (\a b -> [a,b]) [1..] [1..]) (cycle directions)
19
20part1 :: Int -> Int
21part1 i = (\(x, y) -> x + y) $ last $ take i path
22 where path :: [(Int, Int)]
23 path = snd $ mapAccumL (\c d -> (move c d, move c d)) (-1, 0) moves
24
25buildSpiralMapUntil :: Int -> (M.Map (Int, Int) Int) -> (Int, Int) -> [Direction] -> Int
26buildSpiralMapUntil _ _ _ [] = 0
27buildSpiralMapUntil i m c@(x, y) (d:ds) =
28 case sumAdjacents > i of
29 True -> sumAdjacents
30 False -> buildSpiralMapUntil i (M.insert c sumAdjacents m) nextCoord ds
31 where nextCoord = move c d
32 adjacents = [ (x', y') | x' <- [(x-1)..(x+1)], y' <- [(y-1)..(y+1)], (x, y) /= (x', y') ]
33 sumAdjacents = sum $ map (\c -> case M.lookup c m of
34 Nothing -> 0
35 Just i' -> i' ) adjacents
36
37part2 :: Int -> Int
38part2 i = buildSpiralMapUntil i (M.singleton (0, 0) 1) (1, 0) $ tail moves
39
40main :: IO ()
41main = do
42 -- let answer1 = part1 361527
43 -- in print answer1
44 let answer2 = part2 361527
45 in print answer2