Add day 3
Diff
3.hs | 87 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 87 insertions(+)
@@ -1,0 +1,87 @@
#!/usr/bin/env nix-shell
#!nix-shell -i runghc -p "haskellPackages.ghcWithPackages (pkgs: with pkgs; [ ])"
import Data.Char (isNumber)
import Data.List (findIndices)
main = do
input <- getContents
let (schematics, symbols) = takeSymbols input
print $ sum $ part1FindNumbersAdjacentToSchematic schematics symbols
print $ sum $ map product $ part2FindGearPartNumbers schematics symbols
part1FindNumbersAdjacentToSchematic :: [Schematic] -> [Symbol] -> [Int]
part1FindNumbersAdjacentToSchematic schematics symbols = map partNumber $ filter (isSchematicAdjacentToAnySymbol symbols) schematics
part2FindGearPartNumbers :: [Schematic] -> [Symbol] -> [[Int]]
part2FindGearPartNumbers schematics symbols = map (map partNumber) $ filter (\inner -> length inner == 2) $ map (findSchematicsAdjacentToSymbol schematics) symbols
findSchematicsAdjacentToSymbol :: [Schematic] -> Symbol -> [Schematic]
findSchematicsAdjacentToSymbol schematics symbol = filter (`isSchematicAdjacent` symbol) schematics
isSchematicAdjacentToAnySymbol :: [Symbol] -> Schematic -> Bool
isSchematicAdjacentToAnySymbol symbol schematic = any (isSchematicAdjacent schematic) symbol
isSchematicAdjacent :: Schematic -> Symbol -> Bool
isSchematicAdjacent sc sy = isAdjacent (symbolCoords sy) (schematicCoords sc)
isAdjacent :: (Int, Int) -> (Int, Int, Int) -> Bool
isAdjacent (px, py) (rx, ry, width) =
let leftX = rx
rightX = rx + width - 1
upperY = ry + 1
lowerY = ry - 1
in (px >= leftX - 1 && px <= rightX + 1 && py == ry)
|| (py == upperY || py == lowerY) && (px >= leftX && px <= rightX)
|| (px == leftX - 1 || px == rightX + 1) && (py == upperY || py == lowerY)
data Schematic = Schematic
{ partNumber :: Int,
schematicCoords :: (Int, Int, Int)
}
deriving (Show)
data Symbol = Symbol
{ symbolCoords :: (Int, Int),
symbolType :: Char
}
deriving (Show)
takeSymbols :: String -> ([Schematic], [Symbol])
takeSymbols input = takeSymbol input Nothing (0, 0) [] []
takeSymbol :: String -> Maybe Schematic -> (Int, Int) -> [Schematic] -> [Symbol] -> ([Schematic], [Symbol])
takeSymbol "" Nothing _ schematicAcc symbolAcc = (schematicAcc, symbolAcc)
takeSymbol "" (Just inProgressSchematic) _ schematicAcc symbolAcc = (schematicAcc ++ [inProgressSchematic], symbolAcc)
takeSymbol (x : xs) inProgressSchematic (posX, posY) schematicAcc symbolAcc =
case x of
_ | isNumber x -> takeSymbol xs (Just $ appendToSchematic inProgressSchematic (posX, posY) (read [x])) (posX + 1, posY) schematicAcc symbolAcc
'.' -> takeSymbol xs Nothing (posX + 1, posY) (maybeAppend schematicAcc inProgressSchematic) symbolAcc
'\n' -> takeSymbol xs Nothing (0, posY + 1) (maybeAppend schematicAcc inProgressSchematic) symbolAcc
_ -> takeSymbol xs Nothing (posX + 1, posY) (maybeAppend schematicAcc inProgressSchematic) (symbolAcc ++ [buildSymbol posX posY x])
appendToSchematic :: Maybe Schematic -> (Int, Int) -> Int -> Schematic
appendToSchematic (Just schematic) _ c =
let (x, y, n) = schematicCoords schematic
currPartNumber = partNumber schematic
in schematic {partNumber = currPartNumber * 10 + c, schematicCoords = (x, y, n + 1)}
appendToSchematic Nothing (x, y) c = Schematic {partNumber = c, schematicCoords = (x, y, 1)}
maybeAppend :: [Schematic] -> Maybe Schematic -> [Schematic]
maybeAppend out (Just new) = out ++ [new]
maybeAppend out Nothing = out
buildSymbol :: Int -> Int -> Char -> Symbol
buildSymbol x y symbolType = Symbol {symbolCoords = (x, y), symbolType}