This commit is contained in:
thornAvery 2021-12-05 08:20:44 +00:00
parent 5fbc4e51eb
commit cb84fc681c

View file

@ -3,19 +3,30 @@ module Main where
import Data.List
import Text.Parsec
type Point = (Int,Int)
data LinePoints =
Straight [Point]
| Diag [Point]
main :: IO ()
main = do
raw <- getContents
putStrLn $ "day5a: " ++ show (solveA $ validate $ map (parse (lineP createSpots) []) $ lines raw)
putStrLn $ "day5b: " ++ show (solveB $ validate $ map (parse (lineP createSpots') []) $ lines raw)
let input = validate $ map (parse lineP []) $ lines raw
putStrLn $ "day5a: " ++ show (solve $ concatLP $ filter isStraight input)
putStrLn $ "day5b: " ++ show (solve $ concatLP input)
validate :: [Either ParseError [(Int,Int)]] -> [(Int,Int)]
concatLP :: [LinePoints] -> [Point]
concatLP [] = []
concatLP ((Straight ps):ls) = ps ++ (concatLP ls)
concatLP ((Diag ps):ls) = ps ++ (concatLP ls)
validate :: [Either ParseError a] -> [a]
validate [] = []
validate ((Left _):_) = error "invalid input"
validate ((Right b):bs) = b ++ (validate bs)
validate ((Right b):bs) = b:(validate bs)
lineP :: ((Int,Int) -> (Int,Int) -> [(Int,Int)]) -> Parsec String () [(Int,Int)]
lineP f = do
lineP :: Parsec String () LinePoints
lineP = do
x1 <- many1 digit
_ <- char ','
y1 <- many1 digit
@ -23,26 +34,20 @@ lineP f = do
x2 <- many1 digit
_ <- char ','
y2 <- many1 digit
return $ f (read x1, read y1) (read x2, read y2)
return $ createSpots (read x1, read y1) (read x2, read y2)
range :: Int -> Int -> [Int]
range x y = [ i .. j ]
where
(i,j) = if x > y then (y,x) else (x,y)
createSpots :: (Int,Int) -> (Int,Int) -> [(Int,Int)]
createSpots :: Point -> Point -> LinePoints
createSpots (x1,y1) (x2,y2)
| x1 == x2 = [ (x1,j) | j <- range y1 y2]
| y1 == y2 = [ (i,y1) | i <- range x1 x2]
| otherwise = []
| x1 == x2 = Straight [ (x1,j) | j <- range y1 y2]
| y1 == y2 = Straight [ (i,y1) | i <- range x1 x2]
| otherwise = Diag $ runDiag (x1,y1) (x2,y2)
createSpots' :: (Int,Int) -> (Int,Int) -> [(Int,Int)]
createSpots' (x1,y1) (x2,y2)
| x1 == x2 = [ (x1,j) | j <- range y1 y2]
| y1 == y2 = [ (i,y1) | i <- range x1 x2]
| otherwise = runDiag (x1,y1) (x2,y2)
runDiag :: (Int,Int) -> (Int,Int) -> [(Int,Int)]
runDiag :: Point -> Point -> [Point]
runDiag (x1,y1) (x2,y2)
| y1 < y2 =
if x1 < x2
@ -51,11 +56,10 @@ runDiag (x1,y1) (x2,y2)
| otherwise =
if x1 < x2
then take (x2-x1+1) $ iterate dr (x2,y2)
else take (x1-x2+1) $ iterate ur (x1,y1)
else take (x1-x2+1) $ iterate dl (x2,y2)
where
dl (x,y) = (x+1,y+1)
dr (x,y) = (x-1,y+1)
ur (x,y) = (x-1,y-1)
rle :: Eq a => [a] -> [(Int,a)]
rle xs = rle' $ zip (repeat 1) xs
@ -67,8 +71,10 @@ rle' ((xv,xk):(yv,yk):xs) =
else (xv,xk) : (rle' ((yv,yk):xs))
rle' xs = xs
solveA :: [(Int,Int)] -> Int
solveA ps = length $ filter (\x -> (fst x) >= 2) $ rle $ sort ps
isStraight :: LinePoints -> Bool
isStraight (Straight _) = True
isStraight _ = False
solve :: [Point] -> Int
solve ps = length $ filter (\x -> (fst x) >= 2) $ rle $ sort ps
solveB :: [(Int,Int)] -> Int
solveB ps = length $ filter (\x -> (fst x) >= 2) $ rle $ sort ps