74 lines
2.4 KiB
Haskell
74 lines
2.4 KiB
Haskell
{-# LANGUAGE TupleSections #-}
|
|
|
|
module Days.Day13 where
|
|
|
|
import AOCUtil
|
|
import Data.Bool
|
|
import Data.Char
|
|
import Data.List
|
|
import Data.Maybe
|
|
import Debug.Trace
|
|
import GHC.Arr
|
|
import GHC.Utils.Misc
|
|
|
|
runA :: IO ()
|
|
runA = interactF "data/day13.txt" solve
|
|
|
|
runB :: IO ()
|
|
runB = interactF "data/day13.txt" solveB
|
|
|
|
solve :: String -> String
|
|
solve = show . sum . map fst . filter ((== LT) . snd) . zip [1 ..] . map (uncurry cmpE . first2 . map parseElement) . splitOn "" . lines
|
|
|
|
solveB :: String -> String
|
|
solveB = show . product . map fst . filter ((`elem` dividers) . snd) . zip [1 ..] . sortBy cmpE . (++ dividers) . map parseElement . filter (/= "") . lines
|
|
|
|
data Element = I Int | E [Element] deriving (Eq)
|
|
|
|
instance Show Element where
|
|
show (I i) = show i
|
|
show (E ls) = show ls
|
|
|
|
dividers :: [Element]
|
|
dividers = [E [E [I 2]], E [E [I 6]]]
|
|
|
|
cmpE :: Element -> Element -> Ordering
|
|
cmpE (I i) (I j) = compare i j
|
|
cmpE (E ls) (E ms) = fromMaybe EQ . listToMaybe . dropWhile (== EQ) . (++ [length ls `compare` length ms]) . zipWith cmpE ls $ ms
|
|
cmpE (E ls) (I j) = cmpE (E ls) (E [I j])
|
|
cmpE (I i) (E ms) = cmpE (E [I i]) (E ms)
|
|
|
|
parseElement :: String -> Element
|
|
parseElement s
|
|
| isDigit (head s) = I . read $ s
|
|
| (== '[') . head $ s = E . map parseElement . splitBlocks . tail . init $ s
|
|
|
|
splitBlocks :: String -> [String]
|
|
splitBlocks = filter (not . null) . splitBlocks' 0 ""
|
|
|
|
splitBlocks' :: Int -> String -> String -> [String]
|
|
splitBlocks' l p [] = [p]
|
|
splitBlocks' l prev (s : ss)
|
|
| l /= 0 && s == '[' = splitBlocks' (l + 1) (prev ++ [s]) ss -- levle up
|
|
| l /= 0 && s == ']' = splitBlocks' (l - 1) (prev ++ [s]) ss -- level down
|
|
| s == '[' = prev : splitBlocks' (l + 1) [s] ss -- levle up
|
|
| s == ']' = prev : splitBlocks' (l - 1) [] ss -- level down
|
|
| l /= 0 = splitBlocks' l (prev ++ [s]) ss
|
|
| s == ',' = prev : splitBlocks' l [] ss
|
|
| otherwise = splitBlocks' l (prev ++ [s]) ss
|
|
|
|
-- newtype Parser a = P {parse :: String -> (String, Maybe a)}
|
|
|
|
-- instance Functor Parser where
|
|
-- fmap f (P st) = P $ \stream -> case st stream of
|
|
-- (res, Nothing) -> (res, Nothing)
|
|
-- (res, Just a) -> (res, Just (f a))
|
|
|
|
-- instance Applicative Parser where
|
|
-- pure a = P (\stream -> (stream, Just a))
|
|
-- P ff <*> P xx = P $ \stream0 -> case ff stream0 of
|
|
-- (stream1, Nothing) -> (stream1, Nothing)
|
|
-- (stream1, Just f) -> case xx stream1 of
|
|
-- (stream2, Nothing) -> (stream2, Nothing)
|
|
-- (stream2, Just x) -> (stream2, Just (f x))
|