summaryrefslogtreecommitdiff
path: root/2021/16.hs
diff options
context:
space:
mode:
authorTom Smeding <tom@tomsmeding.com>2021-12-16 20:55:46 +0100
committerTom Smeding <tom@tomsmeding.com>2021-12-16 21:07:19 +0100
commitc0ed02a358e658b12287437a446513f9fab2cd5d (patch)
tree185f80fb9aa99f800d97d29d80a88a169cdba0f3 /2021/16.hs
parentaec4b7b0c4f083562a24305e5b65a289d5a1db07 (diff)
I don't know what you're all about with parsec and stuff, plain recursive descent?
Diffstat (limited to '2021/16.hs')
-rw-r--r--2021/16.hs71
1 files changed, 71 insertions, 0 deletions
diff --git a/2021/16.hs b/2021/16.hs
new file mode 100644
index 0000000..6432014
--- /dev/null
+++ b/2021/16.hs
@@ -0,0 +1,71 @@
+module Main where
+
+import Data.Bifunctor (first, second)
+import Data.Bits
+import Numeric.Natural
+
+import Input
+
+
+data Packet = Lit Int Natural | Op Int Int [Packet]
+ deriving (Show)
+
+dec :: [Bool] -> Natural
+dec l = sum (zipWith (*) (map (fromIntegral . fromEnum) (reverse l)) (iterate (*2) 1))
+
+parse :: [Bool] -> (Packet, [Bool])
+parse l =
+ let (ver, l1) = splitAt 3 l
+ (typ, l2) = splitAt 3 l1
+ in case dec typ of
+ 4 -> let collectGroups m =
+ let (g1, m1) = splitAt 5 m
+ in case g1 of False : g1' -> (g1', m1)
+ True : g1' -> first (g1' ++) (collectGroups m1)
+ [] -> error "Unexpected EOF in literal"
+ in first (Lit (fromIntegral (dec ver)) . dec) (collectGroups l2)
+ typ' | False : l3 <- l2 ->
+ let (bodylen, l4) = splitAt 15 l3
+ (body, l5) = splitAt (fromIntegral (dec bodylen)) l4
+ in (Op (fromIntegral (dec ver)) (fromIntegral typ') (parseMany body), l5)
+ | True : l3 <- l2 ->
+ let (numpkt, l4) = splitAt 11 l3
+ (pkts, l5) = parseN (dec numpkt) l4
+ in (Op (fromIntegral (dec ver)) (fromIntegral typ') pkts, l5)
+ | otherwise -> error "Unexpected EOF before length ID bit in operator"
+
+parseMany :: [Bool] -> [Packet]
+parseMany [] = []
+parseMany l = uncurry (:) (second parseMany (parse l))
+
+parseN :: Natural -> [Bool] -> ([Packet], [Bool])
+parseN 0 l = ([], l)
+parseN n l = let (pkt, rest) = parse l
+ (pkts, rest') = parseN (n - 1) rest
+ in (pkt : pkts, rest')
+
+operator :: Int -> [Natural] -> Natural
+operator 0 = sum
+operator 1 = product
+operator 2 = minimum
+operator 3 = maximum
+operator 5 = \[a,b] -> fromIntegral (fromEnum (a > b))
+operator 6 = \[a,b] -> fromIntegral (fromEnum (a < b))
+operator 7 = \[a,b] -> fromIntegral (fromEnum (a == b))
+operator n = error ("Invalid operator " ++ show n)
+
+eval :: Packet -> Natural
+eval (Lit _ n) = n
+eval (Op _ n ps) = operator n (map eval ps)
+
+main :: IO ()
+main = do
+ let decodeHex c | '0' <= c, c <= '9' = fromEnum c - fromEnum '0'
+ | 'A' <= c, c <= 'F' = 10 + fromEnum c - fromEnum 'A'
+ | otherwise = error "Invalid hex digit"
+ toBinary4 n = [testBit n i | i <- [3,2,1,0]]
+ bits <- concatMap (toBinary4 . decodeHex) . head <$> getInput 16
+ let addVers (Lit v _) = v
+ addVers (Op v _ ps) = v + sum (map addVers ps)
+ print (addVers (fst (parse bits)))
+ print (eval (fst (parse bits)))