adventofcode/2022/day13.hs

64 lines
1.9 KiB
Haskell

import Data.Char (isDigit)
import Control.Exception (assert)
import Data.List.Split (splitOn)
import Data.Maybe (fromJust)
import Data.List (sortBy, elemIndex)
data Packet = Num Int | List [Packet] deriving Eq
readPacket' :: String -> [Packet] -> ([Packet], String)
readPacket' [] p = (p, [])
readPacket' ('[':xs) p = let (child, rem) = readPacket' xs [] in
readPacket' rem (p ++ [List child])
readPacket' (']':xs) p = (p, xs)
readPacket' (',':xs) p = readPacket' xs p
readPacket' xs p = readPacket' rem (p ++ [Num digit]) where
digit = read (takeWhile isDigit xs)
rem = dropWhile isDigit xs
readPacket :: String -> Packet
readPacket xs = let ([p], []) = readPacket' xs [] in assert (show p == xs) p
instance Show Packet where
show (Num i) = show i
show (List ps) = show ps
test :: Packet -> Packet -> Maybe Bool
test (Num a) (Num b)
| a < b = Just True
| a > b = Just False
| a == b = Nothing
test (List []) (List []) = Nothing
test (List []) (List (x:xs)) = Just True
test (List (x:xs)) (List []) = Just False
test l@(Num a) r@(List b) = test (List [l]) r
test l@(List a) r@(Num b) = test l (List [r])
test (List (x:xs)) (List (y:ys)) = case test x y of
Just b -> Just b
Nothing -> test (List xs) (List ys)
cmpPacket :: Packet -> Packet -> Ordering
cmpPacket a b
| a == b = EQ
| fromJust (test a b) = LT
| otherwise = GT
main :: IO ()
main = do
x <- splitOn [""] . lines <$> getContents
let pairs = map (\[a,b] -> (readPacket a, readPacket b)) x
putStr "part 1: "
let order = map (fromJust . uncurry test) pairs
let indices = map fst $ filter snd $ zip [1..] order
print $ sum indices
putStr "part 2: "
let divider x = List [List [Num x]]
let all = divider 2 : divider 6 : concatMap (\(a,b) -> [a,b]) pairs
let msg = sortBy cmpPacket all
let find x = (+1). fromJust . elemIndex x
let i = find (divider 2) msg
let j = find (divider 6) msg
print (i*j)