Haskell for Advent of Code (Day 2-3)
Day 2
I probably should not have used so many . and used $ for some of these instead.
import System.IO
import Data.List
readArr :: String -> [Int]
readArr = map read.words
good :: [Int] -> Bool
good = all (\x -> 1<=x && x<=3) . ((\xs -> zipWith (-) (tail xs) (init xs)) . sort)
sorted :: [Int] -> Bool
sorted x = x == sort x || x == (reverse.sort) x
safe :: [Int] -> Bool
safe x = good x && sorted x
almostSafe :: [Int] -> Bool
almostSafe xs = (any safe . map (\idx -> take (idx-1) xs ++ drop idx xs)) [1 .. length xs]
main :: IO()
main = do
inp <- getContents
let arr2D = map readArr (lines inp)
(print . length . (filter safe)) arr2D
(print . length . (filter almostSafe)) arr2D
Day 3
Shoutout to Hutton’s Programming in Haskell for the parser.
import System.IO
import Control.Applicative
import Data.Char
newtype Parser a = P (String -> [(a,String)])
parse :: Parser a -> String -> [(a,String)]
parse (P p) inp = p inp
item :: Parser Char
item = P (\inp -> case inp of
[] -> []
(x:xs) -> [(x,xs)])
instance Functor Parser where
-- fmap :: (a -> b) -> Parser a -> Parser b
fmap g p = P (\inp -> case parse p inp of
[] -> []
[(v,out)] -> [(g v, out)])
instance Applicative Parser where
-- pure :: a -> Parser a
pure v = P (\inp -> [(v,inp)])
-- <*> :: Parser (a -> b) -> Parser a -> Parser b
pg <*> px = P (\inp -> case parse pg inp of
[] -> []
[(g,out)] -> parse (fmap g px) out)
instance Monad Parser where
-- (>>=) :: Parser a -> (a -> Parser b) -> Parser b
p >>= f = P (\inp -> case parse p inp of
[] -> []
[(v,out)] -> parse (f v) out)
instance Alternative Parser where
-- empty :: Parser a
empty = P (\inp -> [])
-- (<|>) :: Parser a -> Parser a -> Parser a
p <|> q = P (\inp -> case parse p inp of
[] -> parse q inp
[(v,out)] -> [(v,out)])
sat :: (Char -> Bool) -> Parser Char
sat p = do
x <- item
if p x then return x else empty
digit :: Parser Char
digit = sat isDigit
char :: Char -> Parser Char
char x = sat (== x)
string :: String -> Parser String
string [] = return []
string (x:xs) = do
char x
string xs
return (x:xs)
nat :: Parser Int
nat = do
xs <- some digit
return (read xs)
mul :: Parser Int
mul = do
string "mul("
x <- nat
string ","
y <- nat
string ")"
return (x*y)
mul2 :: Parser Int
mul2 = do
string "do()"
return (-1)
<|> do
string "don't()"
return (-2)
<|> mul
solve1 :: String -> Int
solve1 [] = 0
solve1 xs = case (parse mul xs) of
[(a,b)] -> a + solve1(b)
[] -> solve1 (tail xs)
solve2 :: Int -> String -> Int
solve2 _ [] = 0
solve2 f xs = case (parse mul2 xs) of
[(a,b)] -> if a<0 then solve2 (a+2) b else a*f+solve2 f b
[] -> solve2 f (tail xs)
main :: IO()
main = do
inp <- getContents
print (solve1 inp)
print (solve2 1 inp)
I know we can do without it since the parsing here is quite simple, but I wanted to try to understand Monads and stuff better. I guess it worked a bit?
Here is a solution without copying the parsing code from Hutton.
import System.IO
import Data.Maybe
import Data.List.Split
import Text.Read
mul :: String -> Maybe Int
mul ('m':'u':'l':'(':xs) = (*) <$> a <*> b
where
(a:b:_) = map readMaybe $ splitOn "," $ splitOn ")" xs!!0++","
mul _ = Nothing
solve :: Int -> String -> [Int]
solve f s | isJust x = zipWith (+) [jx*f,jx*(1-f)] $ solve f ts
| "don't()" == take 7 s = solve 0 ts
| "do()" == take 4 s = solve 1 ts
| s==[] = [0,0]
| otherwise = solve f ts
where x = mul s
jx = fromJust x
ts = tail s
main :: IO()
main = do
inp <- getContents
let ans=solve 1 inp
print(sum ans)
print(ans!!0)