day 15, common lib creation

15-a.hs

@@ -0,0 +1,51 @@
+{-# LANGUAGE TupleSections #-}
+import Common
+import Data.List.Split (splitOn)
+import Data.List (find)
+import Data.Char (isNumber)
+import Data.Maybe (isJust)
+
+type SensorData = (Pos, Int)
+
+parseLine :: String -> SensorData
+parseLine l = (sensorPos, sensorPos `taxicabDist` beaconPos)
+  where
+    sensorPos = getPos left
+    beaconPos = getPos right
+
+    getPos :: String -> Pos
+    getPos s = (x, y)
+      where [x, y] = map (read . filter isNumber) $ filter (isJust . find isNumber) $ words s
+
+    [left, right] = splitOn ":" l
+
+scanY :: Int
+scanY = 2000000
+
+getMinX :: SensorData -> Int
+getMinX ((x, y), dist) = x - dist
+getMaxX :: SensorData -> Int
+getMaxX ((x, y), dist) = x + dist
+
+getXScanRange :: [SensorData] -> (Int, Int)
+getXScanRange sensors = (minX, maxX)
+  where
+    minX = minimum $ map getMinX sensors
+    maxX = maximum $ map getMaxX sensors
+
+-- manual recursion for extra speed
+canContainBeacon :: [SensorData] -> Pos -> Bool
+canContainBeacon ((sensorPos, sensorRange):xs) p = p `taxicabDist` sensorPos > sensorRange && (canContainBeacon xs p)
+canContainBeacon [] _ = True
+
+countContainsBeacon :: [SensorData] -> Int
+countContainsBeacon sensors = count (not . canContainBeacon sensors) $ map (, scanY) [minX .. maxX]
+  where
+    (minX, maxX) = getXScanRange sensors
+
+main = interact $
+  show
+  . flip (-) 1
+  . countContainsBeacon
+  . map parseLine
+  . lines

15-b.hs

@@ -0,0 +1,63 @@
+{-# OPTIONS_GHC -O2 #-}
+{-# LANGUAGE TupleSections #-}
+import Common
+import Data.List.Split (splitOn)
+import Data.List (find)
+import Data.Char (isNumber)
+import Data.Maybe (fromJust, isJust)
+
+type SensorData = (Pos, Int)
+
+parseLine :: String -> SensorData
+parseLine l = (sensorPos, sensorPos `taxicabDist` beaconPos)
+  where
+    sensorPos = getPos left
+    beaconPos = getPos right
+
+    getPos :: String -> Pos
+    getPos s = (x, y)
+      where [x, y] = map (read . filter isNumber) $ filter (isJust . find isNumber) $ words s
+
+    [left, right] = splitOn ":" l
+
+beaconMaxX :: Int
+beaconMaxX = 4000000
+beaconMaxY :: Int
+beaconMaxY = 4000000
+
+-- manual recursion for extra speed
+canContainBeacon :: [SensorData] -> Pos -> Bool
+canContainBeacon ((sensorPos, sensorRange):xs) p = p `taxicabDist` sensorPos > sensorRange && (canContainBeacon xs p)
+canContainBeacon [] _ = True
+
+dedup a b
+  | a == b = [a]
+  | otherwise = [a, b]
+
+possibleSpots :: SensorData -> [Pos]
+possibleSpots ((x, y), dist) = concatMap drawLine [y - dist - 1 .. y + dist + 1]
+  where
+    drawLine y' = map (, y') (dedup (x - (dist - yDist) - 1) (x + (dist - yDist) + 1))
+      where
+        yDist = abs $ y' - y
+
+findBeaconInPositions :: [SensorData] -> [Pos] -> Maybe Pos
+findBeaconInPositions sensors = find canContainBeacon'
+  where
+    -- does this help performance???
+    canContainBeacon' = canContainBeacon sensors
+
+findBeacon :: [SensorData] -> Pos
+findBeacon sensors = fromJust $ findBeaconInPositions sensors positions
+  where
+    positions = filter (\(x, y) -> x >= 0 && x <= beaconMaxX && y >= 0 && y <= beaconMaxY) $ concatMap possibleSpots sensors
+
+getTuningFrequency :: Pos -> Int
+getTuningFrequency (x, y) = x * 4000000 + y
+
+main = interact $
+  show
+  . getTuningFrequency
+  . findBeacon
+  . map parseLine
+  . lines

Common.hs

@@ -0,0 +1,45 @@
+-- commonly used functions, types and etc
+
+module Common where
+import Data.List (findIndex, elemIndex)
+import GHC.IO (unsafePerformIO)
+import Control.DeepSeq (deepseq)
+
+type Pos = (Int, Int)
+type Grid a = [[a]]
+
+(!!!) :: Grid a -> Pos -> a
+(!!!) grid (x, y) = grid !! y !! x
+
+findPos :: (Eq a) => a -> Grid a -> Maybe Pos
+findPos target grid = do
+  y <- findIndex (target `elem`) grid
+  x <- elemIndex target (grid !! y)
+  Just (x, y)
+
+gridMap :: (a -> b) -> Grid a -> Grid b
+gridMap f = map (map f)
+
+gridWidth :: Grid a -> Int
+gridWidth = length . head
+gridHeight :: Grid a -> Int
+gridHeight = length
+
+taxicabDist :: Pos -> Pos -> Int
+taxicabDist (x1, y1) (x2, y2) = abs (x1 - x2) + abs (y1 - y2)
+
+addPos :: Pos -> Pos -> Pos
+addPos (x1, y1) (x2, y2) = (x1 + x2, y1 + y2)
+
+subPos :: Pos -> Pos -> Pos
+subPos (x1, y1) (x2, y2) = (x1 - x2, y1 - y2)
+
+{-# NOINLINE debug #-}
+debug :: Show a => a -> ()
+debug = unsafePerformIO . print
+
+trace :: Show b => b -> a -> a
+trace s = deepseq (debug s)
+
+count :: (a -> Bool) -> [a] -> Int
+count f = length . filter f