1 -- Don't use this version as the BitString library doesn't support the currrent version of _base_
9 import Control.Monad.State.Lazy
11 import qualified Data.ByteString as BYS
12 import qualified Data.BitString.BigEndian as BS
13 -- import Data.Binary.Strict.Get
15 type ParseState = BS.BitString
17 data Packet = Packet Integer PacketContents
22 -- | Operator [Packet]
27 | GreaterThan Packet Packet
28 | LessThan Packet Packet
29 | EqualTo Packet Packet
34 do text <- readFile "data/advent16.txt"
35 let packetStream = bitify text
36 let (packet, _remaining) = runState getPacket packetStream
40 part1 :: Packet -> Integer
41 part1 = packetVersionSum
43 part2 :: Packet -> Integer
44 part2 = evaluatePacket
46 bitify :: String -> BS.BitString
47 bitify = BS.bitString . BYS.pack . hexPack . map (fromIntegral . digitToInt)
48 -- byteify = BYS.pack . hexPack . map (fromIntegral . digitToInt)
50 hexPack :: [Word8] -> [Word8]
52 hexPack (x:[]) = hexPack [x, 0]
53 hexPack (x:y:xs) = ((x `shift` 4) .|. y) : hexPack xs
55 wordify :: BS.BitString -> Integer
56 wordify bs = foldl' addBit 0 $ BS.to01List bs
57 where addBit w b = (w * 2) + (fromIntegral b)
60 getBool :: State ParseState Bool
63 let value = head $ BS.toList $ BS.take 1 bs
67 getInt :: Int64 -> State ParseState Integer
70 let bits = BS.take n bs
74 getBits :: Int64 -> State ParseState BS.BitString
77 let bits = BS.take n bs
81 getLiteral :: State ParseState Integer
82 getLiteral = getLiteralAcc 0
84 getLiteralAcc :: Integer -> State ParseState Integer
86 do continues <- getBool
88 let acc' = acc * 16 + nybble
90 then (do getLiteralAcc acc')
93 -- getLiteralPacket :: State ParseState (Integer, Integer, Integer)
95 -- do version <- getInt 3
98 -- return (version, pType, val)
101 getPacket :: State ParseState Packet
103 do version <- getInt 3
105 payload <- case pType of
106 4 -> do val <- getLiteral
108 _ -> do contents <- getOperatorContents
109 return $ mkOperator pType contents
110 return $ Packet version payload
112 mkOperator :: Integer -> [Packet] -> PacketContents
113 mkOperator pType contents = case pType of
115 1 -> Product contents
116 2 -> Minimum contents
117 3 -> Maximum contents
118 5 -> GreaterThan (contents!!0) (contents!!1)
119 6 -> LessThan (contents!!0) (contents!!1)
120 7 -> EqualTo (contents!!0) (contents!!1)
123 getOperatorContents :: State ParseState [Packet]
124 getOperatorContents =
125 do isNumPackets <- getBool
127 then do numPackets <- getInt 11
128 getPacketsByCount numPackets
129 else do numBits <- getInt 15
130 subString <- getBits (fromIntegral numBits)
131 return $ getPacketsByLength subString
133 getPacketsByLength :: BS.BitString -> [Packet]
134 getPacketsByLength bits
136 | otherwise = p : (getPacketsByLength remaining)
137 where (p, remaining) = runState getPacket bits
139 getPacketsByCount :: Integer -> State ParseState [Packet]
140 getPacketsByCount 0 = return []
141 getPacketsByCount n =
143 ps <- getPacketsByCount (n - 1)
146 packetVersionSum :: Packet -> Integer
147 packetVersionSum (Packet version contents) =
148 version + (contentsVersionSum contents)
150 contentsVersionSum :: PacketContents -> Integer
151 contentsVersionSum (Sum packets) = sum $ map packetVersionSum packets
152 contentsVersionSum (Product packets) = sum $ map packetVersionSum packets
153 contentsVersionSum (Minimum packets) = sum $ map packetVersionSum packets
154 contentsVersionSum (Maximum packets) = sum $ map packetVersionSum packets
155 contentsVersionSum (Literal _) = 0
156 contentsVersionSum (GreaterThan packet1 packet2) =
157 (packetVersionSum packet1) + (packetVersionSum packet2)
158 contentsVersionSum (LessThan packet1 packet2) =
159 (packetVersionSum packet1) + (packetVersionSum packet2)
160 contentsVersionSum (EqualTo packet1 packet2) =
161 (packetVersionSum packet1) + (packetVersionSum packet2)
163 evaluatePacket :: Packet -> Integer
164 evaluatePacket (Packet _version contents) = evaluateContents contents
166 evaluateContents :: PacketContents -> Integer
167 evaluateContents (Sum packets) = sum $ map evaluatePacket packets
168 evaluateContents (Product packets) = product $ map evaluatePacket packets
169 evaluateContents (Minimum packets) = minimum $ map evaluatePacket packets
170 evaluateContents (Maximum packets) = maximum $ map evaluatePacket packets
171 evaluateContents (Literal n) = n
172 evaluateContents (GreaterThan packet1 packet2) =
173 if (evaluatePacket packet1) > (evaluatePacket packet2) then 1 else 0
174 evaluateContents (LessThan packet1 packet2) =
175 if (evaluatePacket packet1) < (evaluatePacket packet2) then 1 else 0
176 evaluateContents (EqualTo packet1 packet2) =
177 if (evaluatePacket packet1) == (evaluatePacket packet2) then 1 else 0