Advent of Code 2021 Day 16

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