Reordered bits

[advent-of-code-21.git] / advent16 / Main.hs

diff --git a/advent16/Main.hs b/advent16/Main.hs
index 1a6a78f6a30cb405edbcc7591159a17ba8df1679..ab142729267b96eb25818db83c8f647b8de5ca1c 100644 (file)
--- a/advent16/Main.hs
+++ b/advent16/Main.hs
@@ -1,18 +1,18 @@
--- 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 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)
@@ -43,84 +43,59 @@ part1 = packetVersionSum
 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
@@ -130,19 +105,30 @@ getOperatorContents =
              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)