Changed libraries

diff --git a/advent-of-code21.cabal b/advent-of-code21.cabal
index bb917ae30553394bbabd922e0699113fceca8796..2532975bf97217da5feaf3777fb9c95bb56780b4 100644 (file)
--- a/advent-of-code21.cabal
+++ b/advent-of-code21.cabal
@@ -177,8 +177,13 @@ executable advent15prof
                        -threaded 
                        -rtsopts "-with-rtsopts=-N -p -s -hT"
 
+-- executable advent16
+  -- import: common-extensions, build-directives
+  -- main-is: advent16/Main.hs
+  -- build-depends: binary, bytestring, bitstring, mtl
+
 executable advent16
   import: common-extensions, build-directives
   main-is: advent16/Main.hs
-  build-depends: binary, bytestring, bitstring, mtl
+  build-depends: binary, bytestring, bitstream, mtl
 

diff --git a/advent16/Main.hs b/advent16/Main.hs
index 1a6a78f6a30cb405edbcc7591159a17ba8df1679..d9fc4a67c843656f888e85286dc129c8aa68cce7 100644 (file)
--- a/advent16/Main.hs
+++ b/advent16/Main.hs
@@ -3,16 +3,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,45 +43,39 @@ 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
+      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
+      let value = BS.toBits $ BS.take n bs
       put (BS.drop n bs)
-      return (wordify bits)
+      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)
       return bits
 
-getLiteral :: State ParseState Integer
+getLiteral :: ParseTrans Integer
 getLiteral = getLiteralAcc 0
 
-getLiteralAcc :: Integer -> State ParseState Integer
+getLiteralAcc :: Integer -> ParseTrans Integer
 getLiteralAcc acc =
   do  continues <- getBool
       nybble <- getInt 4
@@ -90,7 +84,7 @@ getLiteralAcc acc =
       then (do getLiteralAcc acc')
       else (return acc')
 
--- getLiteralPacket :: State ParseState (Integer, Integer, Integer)
+-- getLiteralPacket :: ParseTrans (Integer, Integer, Integer)
 -- getLiteralPacket = 
 --   do  version <- getInt 3
 --       pType <- getInt 3
@@ -98,7 +92,7 @@ getLiteralAcc acc =
 --       return (version, pType, val)
 
 
-getPacket :: State ParseState Packet
+getPacket :: ParseTrans Packet
 getPacket =
   do version <- getInt 3
      pType <- getInt 3
@@ -120,7 +114,7 @@ mkOperator pType contents = case pType of
   7 -> EqualTo (contents!!0) (contents!!1)
 
 
-getOperatorContents :: State ParseState [Packet]
+getOperatorContents :: ParseTrans [Packet]
 getOperatorContents =
   do isNumPackets <- getBool
      if isNumPackets
@@ -130,13 +124,13 @@ 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

diff --git a/advent16/MainObsolete.hs b/advent16/MainObsolete.hs
new file mode 100644 (file)
index 0000000..20e8544
--- /dev/null
+++ b/advent16/MainObsolete.hs
@@ -0,0 +1,177 @@
+-- Don't use this version as the BitString library doesn't support the currrent version of _base_
+
+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
+
+type ParseState = BS.BitString
+
+data Packet = Packet Integer PacketContents
+  deriving (Show, Eq)
+
+data PacketContents 
+  = Literal Integer
+  -- | Operator [Packet]
+  | Sum [Packet]
+  | Product [Packet]
+  | Minimum [Packet]
+  | Maximum [Packet]
+  | GreaterThan Packet Packet
+  | LessThan Packet Packet
+  | EqualTo Packet Packet
+  deriving (Show, Eq)
+
+main :: IO ()
+main = 
+  do  text <- readFile "data/advent16.txt"
+      let packetStream = bitify text
+      let (packet, _remaining) = runState getPacket packetStream
+      print $ part1 packet
+      print $ part2 packet
+
+part1 :: Packet -> Integer
+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)
+
+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 = 
+  do  bs <- get
+      let value = head $ BS.toList $ BS.take 1 bs
+      put (BS.drop 1 bs)
+      return value
+
+getInt :: Int64 -> State ParseState Integer
+getInt n = 
+  do  bs <- get
+      let bits = BS.take n bs
+      put (BS.drop n bs)
+      return (wordify bits)
+
+getBits :: Int64 -> State ParseState BS.BitString
+getBits n = 
+  do  bs <- get
+      let bits = BS.take n bs
+      put (BS.drop n bs)
+      return bits
+
+getLiteral :: State ParseState Integer
+getLiteral = getLiteralAcc 0
+
+getLiteralAcc :: Integer -> State ParseState Integer
+getLiteralAcc acc =
+  do  continues <- getBool
+      nybble <- getInt 4
+      let acc' = acc * 16 + nybble
+      if continues
+      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 =
+  do isNumPackets <- getBool
+     if isNumPackets
+     then do numPackets <- getInt 11
+             getPacketsByCount numPackets
+     else do numBits <- getInt 15
+             subString <- getBits (fromIntegral numBits)
+             return $ getPacketsByLength subString
+
+getPacketsByLength :: BS.BitString -> [Packet]
+getPacketsByLength bits
+  | BS.null bits = []
+  | otherwise = p : (getPacketsByLength remaining)
+  where (p, remaining) = runState getPacket bits
+
+getPacketsByCount :: Integer -> State ParseState [Packet]
+getPacketsByCount 0 = return []
+getPacketsByCount n = 
+  do p <- getPacket
+     ps <- getPacketsByCount (n - 1)
+     return (p : ps)
+
+packetVersionSum :: Packet -> Integer
+packetVersionSum (Packet version contents) = 
+  version + (contentsVersionSum contents)
+
+contentsVersionSum :: PacketContents -> Integer
+contentsVersionSum (Sum packets) = sum $ map packetVersionSum packets
+contentsVersionSum (Product packets) = sum $ map packetVersionSum packets
+contentsVersionSum (Minimum packets) = sum $ map packetVersionSum packets
+contentsVersionSum (Maximum packets) = sum $ map packetVersionSum packets
+contentsVersionSum (Literal _) = 0
+contentsVersionSum (GreaterThan packet1 packet2) = 
+  (packetVersionSum packet1) + (packetVersionSum packet2)
+contentsVersionSum (LessThan packet1 packet2) = 
+  (packetVersionSum packet1) + (packetVersionSum packet2)
+contentsVersionSum (EqualTo packet1 packet2) = 
+  (packetVersionSum packet1) + (packetVersionSum packet2)
+
+evaluatePacket :: Packet -> Integer
+evaluatePacket (Packet _version contents) = evaluateContents contents
+
+evaluateContents :: PacketContents -> Integer
+evaluateContents (Sum packets) = sum $ map evaluatePacket packets
+evaluateContents (Product packets) = product $ map evaluatePacket packets
+evaluateContents (Minimum packets) = minimum $ map evaluatePacket packets
+evaluateContents (Maximum packets) = maximum $ map evaluatePacket packets
+evaluateContents (Literal n) = n
+evaluateContents (GreaterThan packet1 packet2) = 
+  if (evaluatePacket packet1) > (evaluatePacket packet2) then 1 else 0
+evaluateContents (LessThan packet1 packet2) = 
+  if (evaluatePacket packet1) < (evaluatePacket packet2) then 1 else 0
+evaluateContents (EqualTo packet1 packet2) = 
+  if (evaluatePacket packet1) == (evaluatePacket packet2) then 1 else 0