1 import Data.List (tails)
2 import qualified Data.HashMap.Strict as M
3 import Data.HashMap.Strict ((!))
4 import Control.Monad.State.Lazy
6 type Location = (Int, Int)
7 type Memory = M.HashMap Location Int
18 diagonal :: Int -> [Int]
19 diagonal n = scanl (+) 1 $ scanl (+) n $ repeat 8
26 interleave :: [[a]] -> [a]
27 interleave ([]:_) = []
28 interleave xss = map head xss ++ interleave (map tail xss)
31 countedDiags = interleave [(zip [0..] ur), (zip [0..] ul), (zip [0..] dl), (zip [0..] dr)]
33 part1 = let corners = head $ dropWhile ((< target) . snd . head . tail) $ tails countedDiags
34 (pcd, pcv) = head corners
35 (ncd, ncv) = head $ tail corners
36 result = if pcd == ncd
37 then if (target - pcv + 2) < ncv - target
38 then pcd * 2 - (target - pcv)
39 else ncd * 2 - (ncv - target)
40 else if (target - pcv + 1) < ncv - target
41 then pcd * 2 - (target - pcv) + 2
42 else ncd * 2 - (ncv - target)
46 part2 = (!) memoryValues $ head $ dropWhile (\l -> memoryValues!l <= target) locations
47 where memoryValues = execState (updateMemory (take 100 $ drop 1 locations)) emptyMemory
49 up (a, b) = (a, b + 1)
50 down (a, b) = (a, b - 1)
51 left (a, b) = (a - 1, b)
52 right (a, b) = (a + 1, b)
53 directions = [right, up, left, down]
55 locations = scanl (\c f -> f c) (0,0) $ concat $ zipWith replicate steps (cycle directions)
57 steps = concat $ zipWith (\a b -> [a,b]) [1..] [1..]
59 adjacentMap (r, c) = M.filterWithKey adjacent
60 where adjacent k _ = abs (fst k - r) <= 1 && abs (snd k - c) <= 1
62 adjacentMapSum here = M.foldr (+) 0 . adjacentMap here
65 emptyMemory = M.singleton (0, 0) 1
67 updateMemoryOnce :: Location -> State Memory Int
68 updateMemoryOnce here =
70 let total = adjacentMapSum here m0
71 put (M.insert here total m0)
74 updateMemory :: [Location] -> State Memory Int
75 updateMemory [] = do return 0