https://adventofcode.com/2021/day/16 This is the hardest of the problems I have managed to solve.
Some of the issues were:
- The BITS protocol is not context free. This means that there were overlapping choices to be made – for instance, I could have made Packets consist of version and payload; I could have defined a single type for literal value or list of packets, avoiding the dummy values. Each of these choices has trade-offs. In retrospect, I should have made one choice, written it down and stuck to it.
- It took me a long time to realise that only the whole transmission could be padded. Attoparsec has a function parseWith that could have handled padding of the inner packets, but I did not need it.
- I still do not fully understand when I can return an inner value, or when I have to use ‘let’ to assign it to a new variable.
- I could not get the op function to compile when I had the case statement (now in op’) in the body.
On the good side, Attoparsec can handle the non-context-free aspects (eg the functions packets0 and packets1). Almost every line of the solution can be linked back to the puzzle’s requirements – there is very little visible plumbing.
Apologies for the formatting – I need the premium version of WordPress to get Haskell code highlighting.
{-# Language OverloadedStrings #-}
import qualified Data.Map.Strict as M
import qualified Data.List as L
import qualified Data.Attoparsec.Text as AT
import Data.Text
data Op = Sum | Product | Min | Max | Val | Gr | Le | Equ deriving Show
newtype Packet = P (Int, Op, Int, [Packet]) -- version, operator, value, sub-packets
deriving Show
op'::Int->Op -- can't use case directly inside Parser ?
op' i = case i of
0 -> Sum
1 -> Product
2 -> Min
3 -> Max
5 -> Gr
6 -> Le
7 -> Equ
op::AT.Parser Op
op = do
i<-int 3
return $ op' i
{- n-bit integer -}
int::Int->AT.Parser Int
int n = do
x <-AT.take n
let y = bin2dec x
return y
{- value packet -}
final::AT.Parser Text
final = do
AT.char '0'
f<-AT.take 4
return f
nonFinal::AT.Parser Text
nonFinal = do
AT.char '1'
nf<-AT.take 4
return nf
litval::AT.Parser Int
litval = do
nfs<-AT.many' nonFinal
f<-final
let val = bin2dec $ Data.Text.concat $ nfs ++ [f]
return val
value::AT.Parser Packet
value = do
ver<-int 3
AT.string "100"
i<-litval
let result = P (ver,Val,i,[])
return result
{- operator packet -}
{- packets by length -}
packets0::AT.Parser [Packet]
packets0=do
AT.char '0'
n <- int 15
chunk <- AT.take n
let Right result = AT.parseOnly (AT.many' packet) chunk
return result
{- packets by number -}
packets1::AT.Parser [Packet]
packets1 = do
AT.char '1'
n <- int 11
packets <- AT.count n packet
let result = packets
return result
packets::AT.Parser [Packet]
packets = do
p<-AT.choice [packets0, packets1]
return p
operator::AT.Parser Packet
operator = do
ver<-int 3
o<-op
p<-packets
let result = P (ver,o,0,p) -- 0 is dummy value
return result
packet::AT.Parser Packet
packet = do
p <- AT.choice [value, operator]
return p
{-decode and evaluate hex strings -}
decode::String->Packet
decode s =
let (Right p) = AT.parseOnly packet (pack (hex2bin s)) in p
eval1::Packet->Int
eval1 (P (ver,Val,_,_)) = ver
eval1 (P (ver,_,_,ps)) = ver + (sum (L.map eval1 ps))
eval2::Packet->Int
eval2 (P (_,Val,i,_)) = i
eval2 (P (_,Sum,_,ps)) = sum $ L.map eval2 ps
eval2 (P (_,Product,_,ps)) = product $ L.map eval2 ps
eval2 (P (_,Min,_,ps)) = Prelude.minimum $ L.map eval2 ps
eval2 (P (_,Max,_,ps)) = Prelude.maximum $ L.map eval2 ps
eval2 (P (_,Gr,_,[x,y])) = if ((eval2 x) > (eval2 y)) then 1 else 0
eval2 (P (_,Le,_,[x,y])) = if ((eval2 x) < (eval2 y)) then 1 else 0
eval2 (P (_,Equ,_,[x,y])) = if ((eval2 x) == (eval2 y)) then 1 else 0
tests=[ "C200B40A82", "04005AC33890", "880086C3E88112", "CE00C43D881120", "D8005AC2A8F0", "F600BC2D8F", "9C005AC2F8F0", "9C0141080250320F1802104A08" ]
------------------------------------------
main = do
input <- readFile "advent16input.txt"
print $ (eval2.decode) input
-- print $ L.map (eval2.decode) tests -- [3,54,7,9,1,0,0,1]
------------------------------------------
{- conversions -}
bin2dec::Text->Int
bin2dec s = let powers = iterate (*2) 1
s' = L.reverse $ unpack s
z = L.zip powers s'
z' = L.filter (\(_,x)->x=='1') z
in sum $ L.map fst z'
hex = M.fromList [('0',"0000"),('1',"0001"),('2',"0010"),('3',"0011"),('4',"0100"),('5',"0101"),('6',"0110"),('7',"0111"),('8',"1000"),('9',"1001"),('A',"1010"),('B',"1011"),('C',"1100"),('D',"1101"),('E',"1110"),('F',"1111")]
hex2bin::String->String
hex2bin s = L.concatMap (hex M.!) s