31 lines
1.2 KiB
Haskell
31 lines
1.2 KiB
Haskell
|
import Data.Char
|
||
|
|
import Data.List (nub, sort)
|
||
|
|
|
||
|
|
findBegin s@((x,y), c) dict = case filter (\(p,_) -> p == (x,y-1)) dict of
|
||
|
|
[] -> s
|
||
|
|
n:xs -> findBegin n dict
|
||
|
|
|
||
|
|
uniqueLists :: [[((Int, Int), Char)]] -> [[((Int, Int), Char)]]
|
||
|
|
uniqueLists = nub . map sort
|
||
|
|
|
||
|
|
getNumber :: ((Int, Int), Char) -> [String] -> Int
|
||
|
|
getNumber ((x,y),c) dict = read (takeWhile isDigit (drop y (dict!!x))) :: Int
|
||
|
|
|
||
|
|
main :: IO ()
|
||
|
|
main = do
|
||
|
|
inputLines <- lines <$> getContents
|
||
|
|
|
||
|
|
let distances = concat (map (\x -> (map (\y -> (x,y)) [-1..1])) [-1..1])
|
||
|
|
|
||
|
|
let numInputLines = zip [0..] (map (zip [0..]) inputLines)
|
||
|
|
let charCoords = concat (map (\(x, l) -> (map (\(y, c) -> ((x,y),c)) l)) numInputLines)
|
||
|
|
let gears = map (\(p, c) -> p) (filter (\(_,c) -> c == '*') charCoords)
|
||
|
|
let digits = filter (\(_,c) -> isDigit c) charCoords
|
||
|
|
let gearsChars = map (\(x,y) -> (filter (\(p,xd) -> (elem p (map (\(x1,y1) -> (x+x1,y+y1)) distances))) digits)) gears
|
||
|
|
|
||
|
|
let gearsBegins = uniqueLists $ map (\gearChars -> (nub (map (\x -> (findBegin x digits)) gearChars))) gearsChars
|
||
|
|
let twoGears = filter (\x -> length x == 2) gearsBegins
|
||
|
|
let serialNumbers = map (\gs -> product $ map (\g -> getNumber g inputLines) gs) twoGears
|
||
|
|
print (sum serialNumbers)
|
||
|
|
|