advent16/Main.hs

   1 -- Writeup at https://work.njae.me.uk/2021/12/16/advent-of-code-2021-day-14/
   2
   3 import Data.Word
   4 import Data.Bits
   5 import Data.Char
   6 import Data.Int
   7
   8 import Control.Monad.State.Lazy
   9
  10 import qualified Data.ByteString as BYS
  11 import qualified Data.Bitstream as BS
  12
  13 type Transmission = BS.Bitstream BS.Right
  14
  15 type ParseTrans = State Transmission
  16
  17 data Packet = Packet Integer PacketContents
  18   deriving (Show, Eq)
  19
  20 data PacketContents
  21   = Literal Integer
  22   -- | Operator [Packet]
  23   | Sum [Packet]
  24   | Product [Packet]
  25   | Minimum [Packet]
  26   | Maximum [Packet]
  27   | GreaterThan Packet Packet
  28   | LessThan Packet Packet
  29   | EqualTo Packet Packet
  30   deriving (Show, Eq)
  31
  32 main :: IO ()
  33 main =
  34   do  text <- readFile "data/advent16.txt"
  35       let packetStream = bitify text
  36       let (packet, _remaining) = runState getPacket packetStream
  37       print $ part1 packet
  38       print $ part2 packet
  39
  40 part1 :: Packet -> Integer
  41 part1 = packetVersionSum
  42
  43 part2 :: Packet -> Integer
  44 part2 = evaluatePacket
  45
  46 bitify :: String -> Transmission
  47 bitify = BS.fromByteString . BYS.pack . hexPack . map (fromIntegral . digitToInt)
  48
  49 hexPack :: [Word8] -> [Word8]
  50 hexPack [] = []
  51 hexPack (x:[]) = hexPack [x, 0]
  52 hexPack (x:y:xs) = ((x `shift` 4) .|. y) : hexPack xs
  53
  54 getBool :: ParseTrans Bool
  55 getBool =
  56   do  bs <- get
  57       let value = head $ BS.unpack $ BS.take 1 bs
  58       put (BS.drop 1 bs)
  59       return value
  60
  61 getInt :: Int64 -> ParseTrans Integer
  62 getInt n =
  63   do  bs <- get
  64       let value = BS.toBits $ BS.take n bs
  65       put (BS.drop n bs)
  66       return value
  67
  68 getBits :: Int64 -> ParseTrans Transmission
  69 getBits n =
  70   do  bs <- get
  71       let bits = BS.take n bs
  72       put (BS.drop n bs)
  73       return bits
  74
  75 getLiteral :: ParseTrans Integer
  76 getLiteral = getLiteralAcc 0
  77
  78 getLiteralAcc :: Integer -> ParseTrans Integer
  79 getLiteralAcc acc =
  80   do  continues <- getBool
  81       nybble <- getInt 4
  82       let acc' = acc * 16 + nybble
  83       if continues
  84       then (do getLiteralAcc acc')
  85       else (return acc')
  86
  87 -- getLiteralPacket :: ParseTrans (Integer, Integer, Integer)
  88 -- getLiteralPacket =
  89 --   do  version <- getInt 3
  90 --       pType <- getInt 3
  91 --       val <- getLiteral
  92 --       return (version, pType, val)
  93
  94
  95 getPacket :: ParseTrans Packet
  96 getPacket =
  97   do version <- getInt 3
  98      pType <- getInt 3
  99      payload <- case pType of
 100         4 -> do val <- getLiteral
 101                 return $ Literal val
 102         _ -> do contents <- getOperatorContents
 103                 return $ mkOperator pType contents
 104      return $ Packet version payload
 105
 106 mkOperator :: Integer -> [Packet] -> PacketContents
 107 mkOperator pType contents = case pType of
 108   0 -> Sum contents
 109   1 -> Product contents
 110   2 -> Minimum contents
 111   3 -> Maximum contents
 112   5 -> GreaterThan (contents!!0) (contents!!1)
 113   6 -> LessThan (contents!!0) (contents!!1)
 114   7 -> EqualTo (contents!!0) (contents!!1)
 115
 116
 117 getOperatorContents :: ParseTrans [Packet]
 118 getOperatorContents =
 119   do isNumPackets <- getBool
 120      if isNumPackets
 121      then do numPackets <- getInt 11
 122              getPacketsByCount numPackets
 123      else do numBits <- getInt 15
 124              subString <- getBits (fromIntegral numBits)
 125              return $ getPacketsByLength subString
 126
 127 getPacketsByLength :: Transmission -> [Packet]
 128 getPacketsByLength bits
 129   | BS.null bits = []
 130   | otherwise = p : (getPacketsByLength remaining)
 131   where (p, remaining) = runState getPacket bits
 132
 133 getPacketsByCount :: Integer -> ParseTrans [Packet]
 134 getPacketsByCount 0 = return []
 135 getPacketsByCount n =
 136   do p <- getPacket
 137      ps <- getPacketsByCount (n - 1)
 138      return (p : ps)
 139
 140 packetVersionSum :: Packet -> Integer
 141 packetVersionSum (Packet version contents) =
 142   version + (contentsVersionSum contents)
 143
 144 contentsVersionSum :: PacketContents -> Integer
 145 contentsVersionSum (Sum packets) = sum $ map packetVersionSum packets
 146 contentsVersionSum (Product packets) = sum $ map packetVersionSum packets
 147 contentsVersionSum (Minimum packets) = sum $ map packetVersionSum packets
 148 contentsVersionSum (Maximum packets) = sum $ map packetVersionSum packets
 149 contentsVersionSum (Literal _) = 0
 150 contentsVersionSum (GreaterThan packet1 packet2) =
 151   (packetVersionSum packet1) + (packetVersionSum packet2)
 152 contentsVersionSum (LessThan packet1 packet2) =
 153   (packetVersionSum packet1) + (packetVersionSum packet2)
 154 contentsVersionSum (EqualTo packet1 packet2) =
 155   (packetVersionSum packet1) + (packetVersionSum packet2)
 156
 157 evaluatePacket :: Packet -> Integer
 158 evaluatePacket (Packet _version contents) = evaluateContents contents
 159
 160 evaluateContents :: PacketContents -> Integer
 161 evaluateContents (Sum packets) = sum $ map evaluatePacket packets
 162 evaluateContents (Product packets) = product $ map evaluatePacket packets
 163 evaluateContents (Minimum packets) = minimum $ map evaluatePacket packets
 164 evaluateContents (Maximum packets) = maximum $ map evaluatePacket packets
 165 evaluateContents (Literal n) = n
 166 evaluateContents (GreaterThan packet1 packet2) =
 167   if (evaluatePacket packet1) > (evaluatePacket packet2) then 1 else 0
 168 evaluateContents (LessThan packet1 packet2) =
 169   if (evaluatePacket packet1) < (evaluatePacket packet2) then 1 else 0
 170 evaluateContents (EqualTo packet1 packet2) =
 171   if (evaluatePacket packet1) == (evaluatePacket packet2) then 1 else 0