From 4437cd7086d710333d3667ec59be74a57bdff76e Mon Sep 17 00:00:00 2001 From: Neil Smith Date: Sat, 18 Dec 2021 19:17:34 +0000 Subject: [PATCH] Changed libraries --- advent-of-code21.cabal | 7 +- advent16/Main.hs | 44 +++++----- advent16/MainObsolete.hs | 177 +++++++++++++++++++++++++++++++++++++++ 3 files changed, 202 insertions(+), 26 deletions(-) create mode 100644 advent16/MainObsolete.hs diff --git a/advent-of-code21.cabal b/advent-of-code21.cabal index bb917ae..2532975 100644 --- 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 1a6a78f..d9fc4a6 100644 --- 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 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 -- 2.34.1