haskell: 2023 03 a
This commit is contained in:
parent
fab02e54e2
commit
7e33d41980
|
@ -27,12 +27,12 @@ day03 = do
|
||||||
case Day03.parse text of
|
case Day03.parse text of
|
||||||
Left err -> putStrLn err
|
Left err -> putStrLn err
|
||||||
Right xd -> do
|
Right xd -> do
|
||||||
--print . Day02.solveA $ xd
|
print . Day03.solveA $ xd
|
||||||
--print . Day02.solveB $ xd
|
--print . Day02.solveB $ xd
|
||||||
print xd
|
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
-- day01
|
-- day01
|
||||||
-- day02
|
-- day02
|
||||||
day03
|
day03
|
||||||
|
pure ()
|
||||||
|
|
|
@ -1,12 +1,13 @@
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
module Day03 (parse, solveA, solveB) where
|
module Day03 (parse, solveA, solveB) where
|
||||||
|
|
||||||
import Data.Bifunctor (first)
|
import Data.Bifunctor (first, second)
|
||||||
import Data.Void (Void)
|
import Data.Void (Void)
|
||||||
import Data.Char (digitToInt, isSpace)
|
import Data.Char (digitToInt, isSpace)
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import Text.Megaparsec (errorBundlePretty, Parsec, runParser, many, eof, choice, satisfy, manyTill)
|
import Text.Megaparsec (errorBundlePretty, Parsec, runParser, many, eof, choice, satisfy, manyTill)
|
||||||
import Text.Megaparsec.Char (digitChar, char)
|
import Text.Megaparsec.Char (digitChar, char)
|
||||||
|
import Data.Maybe (mapMaybe)
|
||||||
|
|
||||||
|
|
||||||
data Item
|
data Item
|
||||||
|
@ -15,10 +16,14 @@ data Item
|
||||||
| Empty
|
| Empty
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
|
type Grid = [[Item]]
|
||||||
|
type Row = Int
|
||||||
|
type Col = Int
|
||||||
|
|
||||||
type Parser = Parsec Void Text
|
type Parser = Parsec Void Text
|
||||||
|
|
||||||
|
|
||||||
parse :: Text -> Either String [[Item]]
|
parse :: Text -> Either String Grid
|
||||||
parse = first errorBundlePretty . runParser full ""
|
parse = first errorBundlePretty . runParser full ""
|
||||||
where
|
where
|
||||||
item :: Parser Item
|
item :: Parser Item
|
||||||
|
@ -32,12 +37,60 @@ parse = first errorBundlePretty . runParser full ""
|
||||||
full :: Parser [[Item]]
|
full :: Parser [[Item]]
|
||||||
full = many line <* eof
|
full = many line <* eof
|
||||||
|
|
||||||
|
findSpans :: (a -> a -> Bool) -> [a] -> [[a]]
|
||||||
|
findSpans = helper []
|
||||||
|
where
|
||||||
|
helper :: [[a]] -> (a -> a -> Bool) -> [a] -> [[a]]
|
||||||
|
helper acc _ [] = reverse . map reverse $ acc
|
||||||
|
helper [] p (x:xs) = helper [[x]] p xs
|
||||||
|
helper acc@(a:as) p (x:xs) =
|
||||||
|
if p (head a) x
|
||||||
|
then helper ((x:a):as) p xs
|
||||||
|
else helper ([x]:acc) p xs
|
||||||
|
|
||||||
|
withCoords :: [[a]] -> [((Row, Col), a)]
|
||||||
|
withCoords grid = [((r, c), a) | (r, row) <- zip [0..] grid, (c, a) <- zip [0..] row]
|
||||||
|
|
||||||
|
getSymbols :: Grid -> [(Row, Col)]
|
||||||
|
getSymbols = mapMaybe isSymbol . withCoords
|
||||||
|
where
|
||||||
|
isSymbol :: ((Row, Col), Item) -> Maybe (Row, Col)
|
||||||
|
isSymbol (rc, item) = case item of
|
||||||
|
Symbol _ -> Just rc
|
||||||
|
_ -> Nothing
|
||||||
|
|
||||||
|
getNumbers :: Grid -> [(Int, (Row, Col, Col))]
|
||||||
|
getNumbers = concat . zipWith processRow [0..]
|
||||||
|
where
|
||||||
|
getDigit :: (Col, Item) -> Maybe (Col, Int)
|
||||||
|
getDigit (i, item) = case item of
|
||||||
|
Digit d -> Just (i, d)
|
||||||
|
_ -> Nothing
|
||||||
|
isNext :: (Col, Int) -> (Col, Int) -> Bool
|
||||||
|
isNext a b = fst a + 1 == fst b
|
||||||
|
merge :: Row -> [(Col, Int)] -> (Int, (Row, Col, Col))
|
||||||
|
merge r items =
|
||||||
|
let n = foldl (\acc (_, d) -> 10 * acc + d) 0 items
|
||||||
|
s = minimum $ map fst items
|
||||||
|
e = maximum $ map fst items
|
||||||
|
in (n, (r, s, e))
|
||||||
|
processRow :: Row -> [Item] -> [(Int, (Row, Col, Col))]
|
||||||
|
processRow r = map (merge r) . findSpans isNext . mapMaybe getDigit . zip [0..]
|
||||||
|
|
||||||
|
getNeigbors :: (Row, Col, Col) -> [(Row, Col)]
|
||||||
|
getNeigbors (r, s, e) = [(r, s-1), (r, e+1)]
|
||||||
|
<> [(r-1, c) | c <- [s-1..e+1]]
|
||||||
|
<> [(r+1, c) | c <- [s-1..e+1]]
|
||||||
|
|
||||||
solveA :: [[Item]] -> Int
|
solveA :: [[Item]] -> Int
|
||||||
solveA = const 1
|
solveA grid =
|
||||||
|
let symbols = getSymbols grid
|
||||||
|
numbers = getNumbers grid
|
||||||
|
in sum . map fst . filter (hasSymbol symbols . snd) . map (second getNeigbors) $ numbers
|
||||||
|
where
|
||||||
|
hasSymbol :: [(Row, Col)] -> [(Row, Col)] -> Bool
|
||||||
|
hasSymbol symbols = any (`elem` symbols)
|
||||||
|
|
||||||
solveB :: [[Item]] -> Int
|
solveB :: [[Item]] -> Int
|
||||||
solveB = const 2
|
solveB = undefined
|
||||||
|
|
||||||
-- >>> parse input
|
|
||||||
-- Right [Digit 4,Digit 6,Digit 7,Empty,Empty,Digit 1,Digit 1,Digit 4,Empty,Empty]
|
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue