Day 6, parts 1 & 2: Initial solutions.

Day6/Part1.hs

@@ -0,0 +1,41 @@
+#! /usr/bin/env stack
+-- stack --resolver lts-12.20 --install-ghc script
+{-# LANGUAGE ViewPatterns, TupleSections #-}
+module Main where
+
+import Control.Arrow ((***), (&&&))
+import Data.Bifunctor (Bifunctor, bimap)
+import Data.Function (on)
+import Data.Maybe (catMaybes)
+import qualified Data.Array as A
+import qualified Data.List  as L
+import qualified Data.Set   as S
+
+import Debug.Trace
+
+main :: IO ()
+main = interact $ (. (map parseLine . lines)) $ \points ->
+   let limits = (both minimum &&& both maximum) $ (map fst &&& map snd) points
+       ((minX,minY),(maxX,maxY)) = limits
+       closest = A.array limits $ map (\p -> (p, findClosest p)) (A.range limits)
+       dist (x0,y0) (x1,y1) = abs (x0-x1) + abs (y0-y1)
+       findClosest pt
+         | ((d0,pt0):(d1,_):_) <- L.sortBy (compare `on` fst) (map (dist pt &&& id) points)
+         , d0 < d1 = Just pt0
+         | otherwise = Nothing
+       infinite = S.fromList $ catMaybes $
+         [ closest A.! ix
+         | ix <- map (,minY) [minX..maxX-1]
+              ++ map (maxX,) [minY..maxY-1]
+              ++ map (,maxY) [minX+1..maxX]
+              ++ map (minX,) [minY+1..maxY]
+         ]
+       finite = S.fromList points `S.difference` infinite
+       areas = [ (p, length $ filter (== Just p) (A.elems closest)) | p <- S.toList finite ]
+   in traceShow closest $ unlines $ map show $ L.sortBy (compare `on` snd) areas
+
+parseLine :: String -> (Int, Int)
+parseLine (break (==',') -> (read -> x, ',':' ':(read -> y))) = (x, y)
+
+both :: Bifunctor p => (a -> b) -> p a a -> p b b
+both f = bimap f f

Day6/Part2.hs

@@ -0,0 +1,20 @@
+#! /usr/bin/env stack
+-- stack --resolver lts-12.20 --install-ghc script
+{-# LANGUAGE ViewPatterns #-}
+module Main where
+
+import Control.Arrow ((&&&))
+import Data.Bifunctor (Bifunctor, bimap)
+import Data.Ix (range)
+
+main :: IO ()
+main = interact $ (. (map parseLine . lines)) $ \points -> show $
+   let limits = (both minimum &&& both maximum) $ (map fst &&& map snd) points
+       dist (x0,y0) (x1,y1) = abs (x0-x1) + abs (y0-y1)
+   in length $ filter ((< 10000) . sum . flip map points . dist) $ range limits
+
+parseLine :: String -> (Int, Int)
+parseLine (break (==',') -> (read -> x, ',':' ':(read -> y))) = (x, y)
+
+both :: Bifunctor p => (a -> b) -> p a a -> p b b
+both f = bimap f f

Day6/input

@@ -0,0 +1,50 @@
+342, 203
+79, 64
+268, 323
+239, 131
+246, 87
+161, 93
+306, 146
+43, 146
+57, 112
+241, 277
+304, 303
+143, 235
+253, 318
+97, 103
+200, 250
+67, 207
+345, 149
+133, 222
+232, 123
+156, 359
+80, 224
+51, 145
+138, 312
+339, 294
+297, 256
+163, 311
+241, 321
+126, 66
+145, 171
+359, 184
+241, 58
+108, 312
+117, 118
+101, 180
+58, 290
+324, 42
+141, 190
+270, 149
+209, 294
+296, 345
+68, 266
+233, 281
+305, 183
+245, 230
+161, 295
+335, 352
+93, 66
+227, 59
+264, 249
+116, 173