--- Writeup at https://work.njae.me.uk/2021/12/16/advent-of-code-2021-day-14/
+-- Writeup at https://work.njae.me.uk/2021/12/18/advent-of-code-2021-day-16/
import Data.Word
import Data.Bits
import Data.Char
-import Data.List
import Data.Int
-import Control.Monad.State.Lazy
+-- import Control.Monad.State.Lazy
+import Control.Monad.State.Strict
import qualified Data.ByteString as BYS
-import qualified Data.BitString.BigEndian as BS
--- import Data.Binary.Strict.Get
+import qualified Data.Bitstream as BS
-type ParseState = BS.BitString
+type Transmission = BS.Bitstream BS.Right
+
+type ParseTrans = State Transmission
data Packet = Packet Integer PacketContents
deriving (Show, Eq)
part2 :: Packet -> Integer
part2 = evaluatePacket
-bitify :: String -> BS.BitString
-bitify = BS.bitString . BYS.pack . hexPack . map (fromIntegral . digitToInt)
--- byteify = BYS.pack . hexPack . map (fromIntegral . digitToInt)
+bitify :: String -> Transmission
+bitify = BS.fromByteString . BYS.pack . hexPack . map (fromIntegral . digitToInt)
hexPack :: [Word8] -> [Word8]
hexPack [] = []
hexPack (x:[]) = hexPack [x, 0]
hexPack (x:y:xs) = ((x `shift` 4) .|. y) : hexPack xs
-wordify :: BS.BitString -> Integer
-wordify bs = foldl' addBit 0 $ BS.to01List bs
- where addBit w b = (w * 2) + (fromIntegral b)
-
-
-getBool :: State ParseState Bool
+getBool :: ParseTrans Bool
getBool =
do bs <- get
- let value = head $ BS.toList $ BS.take 1 bs
- put (BS.drop 1 bs)
+ let value = head $ BS.unpack $ BS.take 1 bs
+ put $ BS.drop 1 bs
return value
-getInt :: Int64 -> State ParseState Integer
+getInt :: Int64 -> ParseTrans Integer
getInt n =
do bs <- get
- let bits = BS.take n bs
- put (BS.drop n bs)
- return (wordify bits)
+ let value = BS.toBits $ BS.take n bs
+ put $ BS.drop n bs
+ return value
-getBits :: Int64 -> State ParseState BS.BitString
+getBits :: Int64 -> ParseTrans Transmission
getBits n =
do bs <- get
let bits = BS.take n bs
- put (BS.drop n bs)
+ put $ BS.drop n bs
return bits
-getLiteral :: State ParseState Integer
+getPacket :: ParseTrans Packet
+getPacket =
+ do version <- getInt 3
+ pType <- getInt 3
+ payload <- if pType == 4
+ then do val <- getLiteral
+ return $ Literal val
+ else do contents <- getOperatorContents
+ return $ mkOperator pType contents
+ return $ Packet version payload
+
+getLiteral :: ParseTrans Integer
getLiteral = getLiteralAcc 0
-getLiteralAcc :: Integer -> State ParseState Integer
+getLiteralAcc :: Integer -> ParseTrans Integer
getLiteralAcc acc =
do continues <- getBool
nybble <- getInt 4
let acc' = acc * 16 + nybble
if continues
- then (do getLiteralAcc acc')
- else (return acc')
+ then do getLiteralAcc acc'
+ else return acc'
--- getLiteralPacket :: State ParseState (Integer, Integer, Integer)
--- getLiteralPacket =
--- do version <- getInt 3
--- pType <- getInt 3
--- val <- getLiteral
--- return (version, pType, val)
-
-
-getPacket :: State ParseState Packet
-getPacket =
- do version <- getInt 3
- pType <- getInt 3
- payload <- case pType of
- 4 -> do val <- getLiteral
- return $ Literal val
- _ -> do contents <- getOperatorContents
- return $ mkOperator pType contents
- return $ Packet version payload
-
-mkOperator :: Integer -> [Packet] -> PacketContents
-mkOperator pType contents = case pType of
- 0 -> Sum contents
- 1 -> Product contents
- 2 -> Minimum contents
- 3 -> Maximum contents
- 5 -> GreaterThan (contents!!0) (contents!!1)
- 6 -> LessThan (contents!!0) (contents!!1)
- 7 -> EqualTo (contents!!0) (contents!!1)
-
-
-getOperatorContents :: State ParseState [Packet]
+getOperatorContents :: ParseTrans [Packet]
getOperatorContents =
do isNumPackets <- getBool
if isNumPackets
subString <- getBits (fromIntegral numBits)
return $ getPacketsByLength subString
-getPacketsByLength :: BS.BitString -> [Packet]
+getPacketsByLength :: Transmission -> [Packet]
getPacketsByLength bits
| BS.null bits = []
| otherwise = p : (getPacketsByLength remaining)
where (p, remaining) = runState getPacket bits
-getPacketsByCount :: Integer -> State ParseState [Packet]
+getPacketsByCount :: Integer -> ParseTrans [Packet]
getPacketsByCount 0 = return []
getPacketsByCount n =
do p <- getPacket
ps <- getPacketsByCount (n - 1)
return (p : ps)
+mkOperator :: Integer -> [Packet] -> PacketContents
+mkOperator pType contents = case pType of
+ 0 -> Sum contents
+ 1 -> Product contents
+ 2 -> Minimum contents
+ 3 -> Maximum contents
+ 5 -> GreaterThan (contents!!0) (contents!!1)
+ 6 -> LessThan (contents!!0) (contents!!1)
+ 7 -> EqualTo (contents!!0) (contents!!1)
+
+
packetVersionSum :: Packet -> Integer
packetVersionSum (Packet version contents) =
version + (contentsVersionSum contents)