advent16/MainObsolete.hs

   1 -- Don't use this version as the BitString library doesn't support the currrent version of _base_
   2
   3 import Data.Word
   4 import Data.Bits
   5 import Data.Char
   6 import Data.List
   7 import Data.Int
   8
   9 import Control.Monad.State.Lazy
  10
  11 import qualified Data.ByteString as BYS
  12 import qualified Data.BitString.BigEndian as BS
  13 -- import Data.Binary.Strict.Get
  14
  15 type ParseState = BS.BitString
  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 -> BS.BitString
  47 bitify = BS.bitString . BYS.pack . hexPack . map (fromIntegral . digitToInt)
  48 -- byteify = BYS.pack . hexPack . map (fromIntegral . digitToInt)
  49
  50 hexPack :: [Word8] -> [Word8]
  51 hexPack [] = []
  52 hexPack (x:[]) = hexPack [x, 0]
  53 hexPack (x:y:xs) = ((x `shift` 4) .|. y) : hexPack xs
  54
  55 wordify :: BS.BitString -> Integer
  56 wordify bs = foldl' addBit 0 $ BS.to01List bs
  57   where addBit w b = (w * 2) + (fromIntegral b)
  58
  59
  60 getBool :: State ParseState Bool
  61 getBool =
  62   do  bs <- get
  63       let value = head $ BS.toList $ BS.take 1 bs
  64       put (BS.drop 1 bs)
  65       return value
  66
  67 getInt :: Int64 -> State ParseState Integer
  68 getInt n =
  69   do  bs <- get
  70       let bits = BS.take n bs
  71       put (BS.drop n bs)
  72       return (wordify bits)
  73
  74 getBits :: Int64 -> State ParseState BS.BitString
  75 getBits n =
  76   do  bs <- get
  77       let bits = BS.take n bs
  78       put (BS.drop n bs)
  79       return bits
  80
  81 getLiteral :: State ParseState Integer
  82 getLiteral = getLiteralAcc 0
  83
  84 getLiteralAcc :: Integer -> State ParseState Integer
  85 getLiteralAcc acc =
  86   do  continues <- getBool
  87       nybble <- getInt 4
  88       let acc' = acc * 16 + nybble
  89       if continues
  90       then (do getLiteralAcc acc')
  91       else (return acc')
  92
  93 -- getLiteralPacket :: State ParseState (Integer, Integer, Integer)
  94 -- getLiteralPacket =
  95 --   do  version <- getInt 3
  96 --       pType <- getInt 3
  97 --       val <- getLiteral
  98 --       return (version, pType, val)
  99
 100
 101 getPacket :: State ParseState Packet
 102 getPacket =
 103   do version <- getInt 3
 104      pType <- getInt 3
 105      payload <- case pType of
 106         4 -> do val <- getLiteral
 107                 return $ Literal val
 108         _ -> do contents <- getOperatorContents
 109                 return $ mkOperator pType contents
 110      return $ Packet version payload
 111
 112 mkOperator :: Integer -> [Packet] -> PacketContents
 113 mkOperator pType contents = case pType of
 114   0 -> Sum contents
 115   1 -> Product contents
 116   2 -> Minimum contents
 117   3 -> Maximum contents
 118   5 -> GreaterThan (contents!!0) (contents!!1)
 119   6 -> LessThan (contents!!0) (contents!!1)
 120   7 -> EqualTo (contents!!0) (contents!!1)
 121
 122
 123 getOperatorContents :: State ParseState [Packet]
 124 getOperatorContents =
 125   do isNumPackets <- getBool
 126      if isNumPackets
 127      then do numPackets <- getInt 11
 128              getPacketsByCount numPackets
 129      else do numBits <- getInt 15
 130              subString <- getBits (fromIntegral numBits)
 131              return $ getPacketsByLength subString
 132
 133 getPacketsByLength :: BS.BitString -> [Packet]
 134 getPacketsByLength bits
 135   | BS.null bits = []
 136   | otherwise = p : (getPacketsByLength remaining)
 137   where (p, remaining) = runState getPacket bits
 138
 139 getPacketsByCount :: Integer -> State ParseState [Packet]
 140 getPacketsByCount 0 = return []
 141 getPacketsByCount n =
 142   do p <- getPacket
 143      ps <- getPacketsByCount (n - 1)
 144      return (p : ps)
 145
 146 packetVersionSum :: Packet -> Integer
 147 packetVersionSum (Packet version contents) =
 148   version + (contentsVersionSum contents)
 149
 150 contentsVersionSum :: PacketContents -> Integer
 151 contentsVersionSum (Sum packets) = sum $ map packetVersionSum packets
 152 contentsVersionSum (Product packets) = sum $ map packetVersionSum packets
 153 contentsVersionSum (Minimum packets) = sum $ map packetVersionSum packets
 154 contentsVersionSum (Maximum packets) = sum $ map packetVersionSum packets
 155 contentsVersionSum (Literal _) = 0
 156 contentsVersionSum (GreaterThan packet1 packet2) =
 157   (packetVersionSum packet1) + (packetVersionSum packet2)
 158 contentsVersionSum (LessThan packet1 packet2) =
 159   (packetVersionSum packet1) + (packetVersionSum packet2)
 160 contentsVersionSum (EqualTo packet1 packet2) =
 161   (packetVersionSum packet1) + (packetVersionSum packet2)
 162
 163 evaluatePacket :: Packet -> Integer
 164 evaluatePacket (Packet _version contents) = evaluateContents contents
 165
 166 evaluateContents :: PacketContents -> Integer
 167 evaluateContents (Sum packets) = sum $ map evaluatePacket packets
 168 evaluateContents (Product packets) = product $ map evaluatePacket packets
 169 evaluateContents (Minimum packets) = minimum $ map evaluatePacket packets
 170 evaluateContents (Maximum packets) = maximum $ map evaluatePacket packets
 171 evaluateContents (Literal n) = n
 172 evaluateContents (GreaterThan packet1 packet2) =
 173   if (evaluatePacket packet1) > (evaluatePacket packet2) then 1 else 0
 174 evaluateContents (LessThan packet1 packet2) =
 175   if (evaluatePacket packet1) < (evaluatePacket packet2) then 1 else 0
 176 evaluateContents (EqualTo packet1 packet2) =
 177   if (evaluatePacket packet1) == (evaluatePacket packet2) then 1 else 0