86 lines
3.1 KiB
Haskell
86 lines
3.1 KiB
Haskell
module Main where
|
|
import Data.List (foldl', unfoldr)
|
|
import Debug.Trace (traceShow)
|
|
|
|
type Packet = [Bool]
|
|
data Length = Bits Int | Count Int deriving Show
|
|
data DecodedPacket = Lit Int Int Int | Op Int Int Length [DecodedPacket] deriving Show
|
|
|
|
binToDec :: [Bool] -> Int
|
|
binToDec = foldl' (\acc x -> acc * 2 + fromEnum x) 0
|
|
|
|
decodeHex :: Char -> Packet
|
|
decodeHex '0' = map toEnum [0, 0, 0, 0]
|
|
decodeHex '1' = map toEnum [0, 0, 0, 1]
|
|
decodeHex '2' = map toEnum [0, 0, 1, 0]
|
|
decodeHex '3' = map toEnum [0, 0, 1, 1]
|
|
decodeHex '4' = map toEnum [0, 1, 0, 0]
|
|
decodeHex '5' = map toEnum [0, 1, 0, 1]
|
|
decodeHex '6' = map toEnum [0, 1, 1, 0]
|
|
decodeHex '7' = map toEnum [0, 1, 1, 1]
|
|
decodeHex '8' = map toEnum [1, 0, 0, 0]
|
|
decodeHex '9' = map toEnum [1, 0, 0, 1]
|
|
decodeHex 'A' = map toEnum [1, 0, 1, 0]
|
|
decodeHex 'B' = map toEnum [1, 0, 1, 1]
|
|
decodeHex 'C' = map toEnum [1, 1, 0, 0]
|
|
decodeHex 'D' = map toEnum [1, 1, 0, 1]
|
|
decodeHex 'E' = map toEnum [1, 1, 1, 0]
|
|
decodeHex 'F' = map toEnum [1, 1, 1, 1]
|
|
decodeHex x = []
|
|
|
|
buildPacket :: [Bool] -> [(DecodedPacket, [Bool])]
|
|
buildPacket p = unfoldr go p where
|
|
go [] = Nothing
|
|
go p = Just ((dec, next), next) where (dec,next) = decode p
|
|
|
|
decode :: Packet -> (DecodedPacket, [Bool])
|
|
decode p = decode' typeID $ drop 6 p where
|
|
version = binToDec $ take 3 p
|
|
typeID = binToDec $ take 3 $ drop 3 p
|
|
|
|
decodeLit :: [Bool] -> ([Bool], [Bool])
|
|
decodeLit [] = error "trying to decode an empty list"
|
|
decodeLit (False:ps) = splitAt 4 ps
|
|
decodeLit (True:ps) = let (next,rem) = decodeLit (drop 4 ps) in (take 4 ps ++ next, rem)
|
|
|
|
decode' :: Int -> [Bool] -> (DecodedPacket, [Bool])
|
|
decode' 4 p = let (num, rem) = decodeLit p in (Lit version typeID (binToDec num), rem)
|
|
decode' x [] = error "unexpected end-of-packet"
|
|
decode' x (False:ps) = (Op version typeID (Bits numBits) ourPackets, next) where
|
|
numBits = binToDec $ take 15 ps
|
|
(this,next) = splitAt numBits $ drop 15 ps
|
|
ourPackets = map fst $ buildPacket this
|
|
decode' x (True:ps) = (Op version typeID (Count numPackets) (map fst ourPackets), remainder) where
|
|
numPackets = binToDec $ take 11 ps
|
|
ourPackets = take numPackets $ buildPacket $ drop 11 ps
|
|
remainder = snd $ last ourPackets
|
|
|
|
versionSum :: DecodedPacket -> Int
|
|
versionSum (Lit v t x) = v
|
|
versionSum (Op v t l ps) = v + sum (map versionSum ps)
|
|
|
|
evalPacket :: DecodedPacket -> Int
|
|
evalPacket (Lit v t x) = x
|
|
evalPacket (Op v 0 l ps) = sum $ map evalPacket ps
|
|
evalPacket (Op v 1 l ps) = product $ map evalPacket ps
|
|
evalPacket (Op v 2 l ps) = minimum $ map evalPacket ps
|
|
evalPacket (Op v 3 l ps) = maximum $ map evalPacket ps
|
|
evalPacket (Op v 5 l (x:y:xs)) = fromEnum $ evalPacket x > evalPacket y
|
|
evalPacket (Op v 6 l (x:y:xs)) = fromEnum $ evalPacket x < evalPacket y
|
|
evalPacket (Op v 7 l (x:y:xs)) = fromEnum $ evalPacket x == evalPacket y
|
|
evalPacket x = error $ "invalid packet: " ++ show x
|
|
|
|
|
|
main :: IO ()
|
|
main = do
|
|
input <- concatMap decodeHex <$> getContents
|
|
let packet = fst $ decode input
|
|
print packet
|
|
|
|
putStr "part 1: "
|
|
print $ versionSum packet
|
|
|
|
putStr "part 2: "
|
|
print $ evalPacket packet
|
|
|
|
print "bye" |